Rewrite #1
17 changed files with 331 additions and 679 deletions
14
.editorconfig
Normal file
14
.editorconfig
Normal file
|
|
@ -0,0 +1,14 @@
|
|||
root = true
|
||||
|
||||
[*]
|
||||
indent_style = space
|
||||
charset = utf-8
|
||||
end_of_line = lf
|
||||
insert_final_newline = true
|
||||
trim_trailing_whitespace = true
|
||||
|
||||
[*.nix]
|
||||
indent_size = 2
|
||||
|
||||
[*.{fs,fsi,fsx}]
|
||||
indent_size = 4
|
||||
3
.gitignore
vendored
3
.gitignore
vendored
|
|
@ -211,3 +211,6 @@ FakesAssemblies/
|
|||
|
||||
# Codex
|
||||
.codex
|
||||
|
||||
# Nix
|
||||
result
|
||||
|
|
|
|||
|
|
@ -1,10 +0,0 @@
|
|||
namespace Example
|
||||
|
||||
module Calculator =
|
||||
let addOne value = value + 1
|
||||
|
||||
let absoluteDifference left right =
|
||||
if left >= right then left - right else right - left
|
||||
|
||||
let isLeapYear year =
|
||||
year % 4 = 0 && (year % 100 <> 0 || year % 400 = 0)
|
||||
|
|
@ -1,22 +0,0 @@
|
|||
namespace Example.Tests
|
||||
|
||||
open Example
|
||||
open Mutannot
|
||||
open Xunit
|
||||
|
||||
type CalculatorTests() =
|
||||
[<Fact>]
|
||||
[<MutationCase("calc-add-one", "Example.Tests/Calculator.fs", 4, "value + 1", "value - 1")>]
|
||||
member _.AddOne_increments() =
|
||||
Assert.Equal(42, Calculator.addOne 41)
|
||||
|
||||
[<Fact>]
|
||||
[<MutationCase("calc-abs-diff-branch", "Example.Tests/Calculator.fs", 7, "left - right", "right - left")>]
|
||||
member _.AbsoluteDifference_preserves_order() =
|
||||
Assert.Equal(7, Calculator.absoluteDifference 10 3)
|
||||
|
||||
[<Fact>]
|
||||
[<MutationCase("calc-leap-year-century", "Example.Tests/Calculator.fs", 10, "year % 100 <> 0", "year % 100 = 0")>]
|
||||
member _.LeapYear_handles_centuries() =
|
||||
Assert.True(Calculator.isLeapYear 2000)
|
||||
Assert.False(Calculator.isLeapYear 1900)
|
||||
|
|
@ -1,13 +0,0 @@
|
|||
namespace Mutannot
|
||||
|
||||
open System
|
||||
|
||||
[<AttributeUsage(AttributeTargets.Method, AllowMultiple = true)>]
|
||||
type MutationCaseAttribute(id: string, file: string, line: int, find: string, replace: string) =
|
||||
inherit Attribute()
|
||||
|
||||
member _.Id = id
|
||||
member _.File = file
|
||||
member _.Line = line
|
||||
member _.Find = find
|
||||
member _.Replace = replace
|
||||
4
Example/Calculator.fs
Normal file
4
Example/Calculator.fs
Normal file
|
|
@ -0,0 +1,4 @@
|
|||
namespace Example
|
||||
|
||||
module Calculator =
|
||||
let addOne value = value + 1
|
||||
21
Example/CalculatorTests.fs
Normal file
21
Example/CalculatorTests.fs
Normal file
|
|
@ -0,0 +1,21 @@
|
|||
namespace Example
|
||||
|
||||
open Example
|
||||
open Mutannot
|
||||
open Xunit
|
||||
|
||||
type CalculatorTests() =
|
||||
[<Fact>]
|
||||
[<MutationCase("""
|
||||
diff --git a/Example/Calculator.fs b/Example/Calculator.fs
|
||||
index 6f0c515..030e391 100644
|
||||
--- a/Example/Calculator.fs
|
||||
+++ b/Example/Calculator.fs
|
||||
@@ -1,4 +1,4 @@
|
||||
namespace Example
|
||||
|
||||
module Calculator =
|
||||
- let addOne value = value + 1
|
||||
+ let addOne value = value - 1
|
||||
""")>]
|
||||
member _.AddOne_increments() = Assert.Equal(42, Calculator.addOne 41)
|
||||
9
Example/MutationCaseAttribute.fs
Normal file
9
Example/MutationCaseAttribute.fs
Normal file
|
|
@ -0,0 +1,9 @@
|
|||
namespace Mutannot
|
||||
|
||||
open System
|
||||
|
||||
[<AttributeUsage(AttributeTargets.Method, AllowMultiple = true)>]
|
||||
type MutationCaseAttribute(patch: string) =
|
||||
inherit Attribute()
|
||||
|
||||
member _.Patch = patch
|
||||
|
|
@ -11,6 +11,8 @@
|
|||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<PackageReference Include="Argu" Version="6.2.5" />
|
||||
<PackageReference Include="Fli" Version="1.1000.0" />
|
||||
<PackageReference Include="System.Reflection.MetadataLoadContext" Version="9.0.1" />
|
||||
</ItemGroup>
|
||||
</Project>
|
||||
|
|
|
|||
|
|
@ -1,579 +1,195 @@
|
|||
open System
|
||||
open System.Collections.Generic
|
||||
open System.Diagnostics
|
||||
open System.IO
|
||||
open System.Reflection
|
||||
open System.Runtime.InteropServices
|
||||
open Fli
|
||||
open Argu
|
||||
|
||||
exception UserError of string
|
||||
type MutationCase = { TestName: string; Patch: string }
|
||||
|
||||
type MutationCase =
|
||||
{ Id: string
|
||||
File: string
|
||||
Line: int
|
||||
Find: string
|
||||
Replace: string
|
||||
TestName: string
|
||||
DeclaringType: string }
|
||||
let ensureCleanWorkingDirectory () =
|
||||
let gitState =
|
||||
cli {
|
||||
Exec "git"
|
||||
Arguments [ "status"; "--porcelain" ]
|
||||
}
|
||||
|> Command.execute
|
||||
|> Output.throwIfErrored
|
||||
|
||||
type MutationOutcome =
|
||||
| Killed
|
||||
| Survived
|
||||
| BuildFailed
|
||||
if gitState.Text <> None then
|
||||
eprintfn "Uncommitted changes. Refusing to run."
|
||||
exit 2
|
||||
|
||||
type Command =
|
||||
| Validate
|
||||
| List
|
||||
| Show of string
|
||||
| Run of string list
|
||||
let applyPatch patch =
|
||||
cli {
|
||||
Exec "git"
|
||||
Arguments [ "apply"; "-" ]
|
||||
Input patch
|
||||
}
|
||||
|> Command.execute
|
||||
|> Output.throwIfErrored
|
||||
|> ignore
|
||||
|
||||
type Options =
|
||||
{ Configuration: string
|
||||
ProjectPath: string
|
||||
BuildArgs: string list
|
||||
NoBuild: bool
|
||||
Command: Command }
|
||||
let restore () =
|
||||
cli {
|
||||
Exec "git"
|
||||
Arguments [ "restore"; "--staged"; "--worktree"; "." ]
|
||||
}
|
||||
|> Command.execute
|
||||
|> Output.throwIfErrored
|
||||
|> ignore
|
||||
|
||||
type ProjectInfo =
|
||||
{ RelativeProjectPath: string
|
||||
AbsoluteProjectPath: string }
|
||||
let ensureBuilt projectPath =
|
||||
cli {
|
||||
Exec "dotnet"
|
||||
Arguments [ "build"; projectPath ]
|
||||
Output(new StreamWriter(Console.OpenStandardOutput()))
|
||||
}
|
||||
|> Command.execute
|
||||
|> Output.throwIfErrored
|
||||
|> ignore
|
||||
|
||||
let fail message =
|
||||
raise (UserError message)
|
||||
let runTest projectPath testName =
|
||||
cli {
|
||||
Exec "dotnet"
|
||||
Arguments [ "test"; projectPath; "--filter"; $"FullyQualifiedName={testName}" ]
|
||||
Output(new StreamWriter(Console.OpenStandardOutput()))
|
||||
}
|
||||
|> Command.execute
|
||||
|> Output.toExitCode
|
||||
|
||||
let runProcess (workingDirectory: string) (exe: string) (args: string list) =
|
||||
let psi = ProcessStartInfo()
|
||||
psi.FileName <- exe
|
||||
psi.WorkingDirectory <- workingDirectory
|
||||
psi.RedirectStandardOutput <- false
|
||||
psi.RedirectStandardError <- false
|
||||
psi.UseShellExecute <- false
|
||||
let getAssemblyPath projectPath =
|
||||
cli {
|
||||
Exec "dotnet"
|
||||
Arguments [ "msbuild"; projectPath; "--getProperty:TargetPath" ]
|
||||
}
|
||||
|> Command.execute
|
||||
|> Output.toText
|
||||
|
||||
for arg in args do
|
||||
psi.ArgumentList.Add arg
|
||||
|
||||
use proc = new Process()
|
||||
proc.StartInfo <- psi
|
||||
|
||||
if not (proc.Start()) then
|
||||
failwithf "Failed to start %s" exe
|
||||
|
||||
proc.WaitForExit()
|
||||
proc.ExitCode
|
||||
|
||||
let captureProcess (workingDirectory: string) (exe: string) (args: string list) =
|
||||
let psi = ProcessStartInfo()
|
||||
psi.FileName <- exe
|
||||
psi.WorkingDirectory <- workingDirectory
|
||||
psi.RedirectStandardOutput <- true
|
||||
psi.RedirectStandardError <- true
|
||||
psi.UseShellExecute <- false
|
||||
|
||||
for arg in args do
|
||||
psi.ArgumentList.Add arg
|
||||
|
||||
use proc = new Process()
|
||||
proc.StartInfo <- psi
|
||||
|
||||
if not (proc.Start()) then
|
||||
failwithf "Failed to start %s" exe
|
||||
|
||||
let stdout = proc.StandardOutput.ReadToEnd()
|
||||
let stderr = proc.StandardError.ReadToEnd()
|
||||
proc.WaitForExit()
|
||||
proc.ExitCode, stdout, stderr
|
||||
|
||||
let repoRoot =
|
||||
let exitCode, stdout, stderr =
|
||||
captureProcess Environment.CurrentDirectory "git" [ "rev-parse"; "--show-toplevel" ]
|
||||
|
||||
if exitCode <> 0 then
|
||||
fail stderr
|
||||
|
||||
stdout.Trim()
|
||||
|
||||
let parseArgs (args: string list) =
|
||||
let usage () =
|
||||
fail "Usage: mutannot <path/to/project.fsproj> [--configuration Debug|Release] [--build-arg <value> ...] [--no-build] [--validate | --list | --show <id> | --run [id...]]"
|
||||
|
||||
let rec loop configuration projectPath buildArgs noBuild remaining =
|
||||
match remaining with
|
||||
| [] ->
|
||||
{ Configuration = configuration
|
||||
ProjectPath = projectPath
|
||||
BuildArgs = List.rev buildArgs
|
||||
NoBuild = noBuild
|
||||
Command = Run [] }
|
||||
| "--configuration" :: value :: tail -> loop value projectPath buildArgs noBuild tail
|
||||
| "--build-arg" :: value :: tail -> loop configuration projectPath (value :: buildArgs) noBuild tail
|
||||
| "--no-build" :: tail -> loop configuration projectPath buildArgs true tail
|
||||
| "--validate" :: tail when tail.IsEmpty ->
|
||||
{ Configuration = configuration
|
||||
ProjectPath = projectPath
|
||||
BuildArgs = List.rev buildArgs
|
||||
NoBuild = noBuild
|
||||
Command = Validate }
|
||||
| "--list" :: tail when tail.IsEmpty ->
|
||||
{ Configuration = configuration
|
||||
ProjectPath = projectPath
|
||||
BuildArgs = List.rev buildArgs
|
||||
NoBuild = noBuild
|
||||
Command = List }
|
||||
| "--show" :: id :: tail when tail.IsEmpty ->
|
||||
{ Configuration = configuration
|
||||
ProjectPath = projectPath
|
||||
BuildArgs = List.rev buildArgs
|
||||
NoBuild = noBuild
|
||||
Command = Show id }
|
||||
| "--run" :: tail ->
|
||||
{ Configuration = configuration
|
||||
ProjectPath = projectPath
|
||||
BuildArgs = List.rev buildArgs
|
||||
NoBuild = noBuild
|
||||
Command = Run tail }
|
||||
| value :: tail when not (value.StartsWith "--") ->
|
||||
{ Configuration = configuration
|
||||
ProjectPath = projectPath
|
||||
BuildArgs = List.rev buildArgs
|
||||
NoBuild = noBuild
|
||||
Command = Run (value :: tail) }
|
||||
| _ -> usage ()
|
||||
|
||||
match args with
|
||||
| projectPath :: tail when not (projectPath.StartsWith "--") -> loop "Debug" projectPath [] false tail
|
||||
| _ -> usage ()
|
||||
|
||||
let ensureWithinRepo (path: string) =
|
||||
let relativePath = Path.GetRelativePath(repoRoot, path)
|
||||
|
||||
if relativePath = ".." || relativePath.StartsWith($"..{Path.DirectorySeparatorChar}") then
|
||||
fail $"Project path must be inside the repository: {path}"
|
||||
|
||||
relativePath
|
||||
|
||||
let loadProjectInfo (projectPath: string) =
|
||||
let absoluteProjectPath =
|
||||
if Path.IsPathRooted projectPath then
|
||||
projectPath
|
||||
else
|
||||
Path.GetFullPath(Path.Combine(Environment.CurrentDirectory, projectPath))
|
||||
|
||||
if not (File.Exists absoluteProjectPath) then
|
||||
fail $"Project file not found: {absoluteProjectPath}"
|
||||
|
||||
let relativeProjectPath = ensureWithinRepo absoluteProjectPath
|
||||
|
||||
{ RelativeProjectPath = relativeProjectPath
|
||||
AbsoluteProjectPath = absoluteProjectPath }
|
||||
|
||||
let targetPathForProject (workingDirectory: string) (projectPath: string) (configuration: string) =
|
||||
let exitCode, stdout, stderr =
|
||||
captureProcess
|
||||
workingDirectory
|
||||
"dotnet"
|
||||
[ "msbuild"
|
||||
projectPath
|
||||
"--getProperty:TargetPath"
|
||||
$"-property:Configuration={configuration}" ]
|
||||
|
||||
if exitCode <> 0 then
|
||||
fail stderr
|
||||
|
||||
let targetPath = stdout.Trim()
|
||||
|
||||
if String.IsNullOrWhiteSpace targetPath then
|
||||
fail $"MSBuild did not return a TargetPath for {projectPath}."
|
||||
|
||||
targetPath
|
||||
|
||||
let buildArgs configuration extraArgs projectPath =
|
||||
[ "build"; projectPath; "--configuration"; configuration; "--nologo" ] @ extraArgs
|
||||
|
||||
let ensureBuilt options project assemblyPath =
|
||||
if not options.NoBuild then
|
||||
let exitCode = runProcess repoRoot "dotnet" (buildArgs options.Configuration options.BuildArgs project.RelativeProjectPath)
|
||||
|
||||
if exitCode <> 0 then
|
||||
fail "dotnet build failed."
|
||||
|
||||
if not (File.Exists assemblyPath) then
|
||||
fail $"Compiled test assembly not found at {assemblyPath}."
|
||||
|
||||
let requireConstructorArgumentString (args: IList<CustomAttributeTypedArgument>) index name =
|
||||
match args[index].Value with
|
||||
| :? string as value when not (isNull value) -> value
|
||||
| null -> fail $"MutationCaseAttribute constructor argument '{name}' must not be null."
|
||||
| value ->
|
||||
fail
|
||||
$"MutationCaseAttribute constructor argument '{name}' had unexpected type '{value.GetType().FullName}'."
|
||||
|
||||
let requireConstructorArgumentInt32 (args: IList<CustomAttributeTypedArgument>) index name =
|
||||
match args[index].Value with
|
||||
| :? int as value -> value
|
||||
| null -> fail $"MutationCaseAttribute constructor argument '{name}' must not be null."
|
||||
| value ->
|
||||
fail
|
||||
$"MutationCaseAttribute constructor argument '{name}' had unexpected type '{value.GetType().FullName}'."
|
||||
|
||||
let metadataLoadContextPaths (assemblyPath: string) =
|
||||
let getMetadataLoadContext (assemblyPath: string) =
|
||||
// This allows us to inspect assemblies regardless of the platform that they were built for
|
||||
// https://learn.microsoft.com/en-us/dotnet/standard/assembly/inspect-contents-using-metadataloadcontext
|
||||
let assemblyDir = Path.GetDirectoryName assemblyPath
|
||||
|
||||
let runtimeAssemblies =
|
||||
match AppContext.GetData "TRUSTED_PLATFORM_ASSEMBLIES" with
|
||||
| :? string as value when not (String.IsNullOrWhiteSpace value) ->
|
||||
value.Split(Path.PathSeparator, StringSplitOptions.RemoveEmptyEntries)
|
||||
| _ -> fail "Unable to discover trusted platform assemblies for MetadataLoadContext."
|
||||
let pathAssemblyResolver =
|
||||
[ yield assemblyPath
|
||||
yield! Directory.EnumerateFiles(assemblyDir, "*.dll")
|
||||
yield! Directory.EnumerateFiles(assemblyDir, "*.exe")
|
||||
yield! Directory.GetFiles(RuntimeEnvironment.GetRuntimeDirectory(), "*.dll") ]
|
||||
|> PathAssemblyResolver
|
||||
|
||||
let localAssemblies =
|
||||
seq {
|
||||
yield assemblyPath
|
||||
yield! Directory.EnumerateFiles(assemblyDir, "*.dll")
|
||||
yield! Directory.EnumerateFiles(assemblyDir, "*.exe")
|
||||
}
|
||||
new MetadataLoadContext(pathAssemblyResolver, typeof<obj>.Assembly.GetName().Name)
|
||||
|
||||
Seq.append runtimeAssemblies localAssemblies
|
||||
|> Seq.distinct
|
||||
|> Seq.toArray
|
||||
let unindentPatch (s: string) =
|
||||
let lines = s.Split([| "\r\n"; "\n" |], StringSplitOptions.None)
|
||||
|
||||
let createMetadataLoadContext (assemblyPath: string) =
|
||||
let resolver = PathAssemblyResolver(metadataLoadContextPaths assemblyPath)
|
||||
let coreAssemblyName = typeof<obj>.Assembly.GetName().Name
|
||||
let indexOfFirstNonEmptyLine =
|
||||
lines |> Array.findIndex (not << String.IsNullOrWhiteSpace)
|
||||
|
||||
new MetadataLoadContext(resolver, coreAssemblyName)
|
||||
let identantionOfFirstNonEmptyLine =
|
||||
lines[indexOfFirstNonEmptyLine] |> Seq.takeWhile Char.IsWhiteSpace |> Seq.length
|
||||
|
||||
let mutationCases options project assemblyPath =
|
||||
ensureBuilt options project assemblyPath
|
||||
lines[indexOfFirstNonEmptyLine..]
|
||||
|> Seq.map (fun line -> line.Substring(min identantionOfFirstNonEmptyLine line.Length))
|
||||
|> String.concat Environment.NewLine
|
||||
|
||||
use mlc = createMetadataLoadContext assemblyPath
|
||||
let asm = mlc.LoadFromAssemblyPath assemblyPath
|
||||
let getMutationCases projectPath =
|
||||
ensureBuilt projectPath
|
||||
|
||||
asm.GetTypes()
|
||||
|> Array.collect (fun t ->
|
||||
let declaringType =
|
||||
match t.FullName with
|
||||
| null -> t.Name
|
||||
| name -> name
|
||||
let assemblyPath = getAssemblyPath projectPath
|
||||
|
||||
t.GetMethods(BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Static ||| BindingFlags.Instance)
|
||||
|> Array.collect (fun m ->
|
||||
m.GetCustomAttributesData()
|
||||
|> Seq.choose (fun attr ->
|
||||
if attr.AttributeType.FullName <> "Mutannot.MutationCaseAttribute" then
|
||||
None
|
||||
else
|
||||
let args = attr.ConstructorArguments
|
||||
use metadataLoadContext = getMetadataLoadContext assemblyPath
|
||||
|
||||
if args.Count <> 5 then
|
||||
fail $"Unexpected MutationCaseAttribute shape on {declaringType}.{m.Name}"
|
||||
let assemblyTypes =
|
||||
assemblyPath |> metadataLoadContext.LoadFromAssemblyPath |> _.GetTypes()
|
||||
|
||||
Some
|
||||
{ Id = requireConstructorArgumentString args 0 "id"
|
||||
File = requireConstructorArgumentString args 1 "file"
|
||||
Line = requireConstructorArgumentInt32 args 2 "line"
|
||||
Find = requireConstructorArgumentString args 3 "find"
|
||||
Replace = requireConstructorArgumentString args 4 "replace"
|
||||
TestName = m.Name
|
||||
DeclaringType = declaringType })
|
||||
|> Seq.toArray))
|
||||
|> Array.sortBy (fun mutation -> mutation.Id)
|
||||
let assemblyMethods =
|
||||
assemblyTypes
|
||||
|> Seq.collect _.GetMethods(BindingFlags.Public ||| BindingFlags.Instance)
|
||||
|
||||
let findMutation id mutations =
|
||||
mutations
|
||||
|> Array.tryFind (fun mutation -> mutation.Id = id)
|
||||
|> Option.defaultWith (fun () -> fail $"Unknown mutation id: {id}")
|
||||
|
||||
let lineSpan (filePath: string) (text: string) (lineNumber: int) =
|
||||
if lineNumber < 1 then
|
||||
fail $"Line number must be positive: {lineNumber}"
|
||||
|
||||
let mutable currentLine = 1
|
||||
let mutable lineStart = 0
|
||||
let mutable index = 0
|
||||
|
||||
while index < text.Length && currentLine < lineNumber do
|
||||
if text[index] = '\n' then
|
||||
currentLine <- currentLine + 1
|
||||
lineStart <- index + 1
|
||||
|
||||
index <- index + 1
|
||||
|
||||
if currentLine <> lineNumber then
|
||||
fail $"Line {lineNumber} does not exist in {filePath}"
|
||||
|
||||
let mutable lineEnd = lineStart
|
||||
|
||||
while lineEnd < text.Length && text[lineEnd] <> '\n' && text[lineEnd] <> '\r' do
|
||||
lineEnd <- lineEnd + 1
|
||||
|
||||
lineStart, lineEnd
|
||||
|
||||
let replaceOccurrenceOnLine (mutation: MutationCase) (text: string) =
|
||||
let lineStart, lineEnd = lineSpan mutation.File text mutation.Line
|
||||
let lineText = text.Substring(lineStart, lineEnd - lineStart)
|
||||
let lineOffset = lineText.IndexOf(mutation.Find, StringComparison.Ordinal)
|
||||
|
||||
if lineOffset < 0 then
|
||||
fail $"Line {mutation.Line} in {mutation.File} does not contain '{mutation.Find}'."
|
||||
|
||||
let absoluteOffset = lineStart + lineOffset
|
||||
text.Remove(absoluteOffset, mutation.Find.Length).Insert(absoluteOffset, mutation.Replace)
|
||||
|
||||
let countOccurrencesOnLine (needle: string) (lineText: string) =
|
||||
if String.IsNullOrEmpty needle then
|
||||
0
|
||||
else
|
||||
let mutable count = 0
|
||||
let mutable startIndex = 0
|
||||
let mutable keepSearching = true
|
||||
|
||||
while keepSearching do
|
||||
let index = lineText.IndexOf(needle, startIndex, StringComparison.Ordinal)
|
||||
|
||||
if index < 0 then
|
||||
keepSearching <- false
|
||||
else
|
||||
count <- count + 1
|
||||
startIndex <- index + needle.Length
|
||||
|
||||
count
|
||||
|
||||
let trimLineForDisplay (lineText: string) =
|
||||
let trimmed = lineText.Trim()
|
||||
|
||||
if String.IsNullOrEmpty trimmed then
|
||||
"<empty line>"
|
||||
else
|
||||
trimmed
|
||||
|
||||
let staleMutationMessage (mutation: MutationCase) (detail: string) =
|
||||
$"Mutation '{mutation.Id}' is stale: the recorded target at {mutation.File}:{mutation.Line} no longer matches the current source. {detail} Re-locate the intended mutation and update its file/line/find metadata."
|
||||
|
||||
let validateMutation (repoRoot: string) (mutation: MutationCase) =
|
||||
let targetFile = Path.Combine(repoRoot, mutation.File.Replace('/', Path.DirectorySeparatorChar))
|
||||
|
||||
if String.IsNullOrEmpty mutation.Find then
|
||||
Some(staleMutationMessage mutation "The recorded find text is empty.")
|
||||
elif not (File.Exists targetFile) then
|
||||
Some(staleMutationMessage mutation $"The target file '{mutation.File}' no longer exists.")
|
||||
else
|
||||
let originalText = File.ReadAllText targetFile
|
||||
|
||||
try
|
||||
let lineStart, lineEnd = lineSpan mutation.File originalText mutation.Line
|
||||
let lineText = originalText.Substring(lineStart, lineEnd - lineStart)
|
||||
let occurrenceCount = countOccurrencesOnLine mutation.Find lineText
|
||||
|
||||
match occurrenceCount with
|
||||
| 0 ->
|
||||
assemblyMethods
|
||||
|> Seq.collect (fun m ->
|
||||
m.GetCustomAttributesData()
|
||||
|> Seq.choose (fun attr ->
|
||||
match attr.AttributeType.FullName with
|
||||
| "Mutannot.MutationCaseAttribute" ->
|
||||
Some
|
||||
(staleMutationMessage
|
||||
mutation
|
||||
$"Expected to find '{mutation.Find}' on that line, but it has changed to '{trimLineForDisplay lineText}'.")
|
||||
| 1 -> None
|
||||
| count ->
|
||||
Some
|
||||
(staleMutationMessage
|
||||
mutation
|
||||
$"The text '{mutation.Find}' now appears {count} times on that line, so the recorded target is no longer unique. Current line: '{trimLineForDisplay lineText}'.")
|
||||
with
|
||||
| UserError message -> Some(staleMutationMessage mutation message)
|
||||
{ TestName = $"{m.DeclaringType.FullName}.{m.Name}"
|
||||
Patch = attr.ConstructorArguments[0].Value :?> string |> unindentPatch }
|
||||
| _ -> None))
|
||||
|> Seq.toList
|
||||
|
||||
let printValidationErrors errors =
|
||||
eprintfn "Validation failed for %d mutation(s):" (errors |> List.length)
|
||||
type Arguments =
|
||||
| [<MainCommand; ExactlyOnce>] ProjectPath of ProjectPath: string
|
||||
| Filter of SearchString: string
|
||||
| ValidateOnly
|
||||
|
||||
for mutation, message in errors do
|
||||
eprintfn "[%s] %s:%d %s" mutation.Id mutation.File mutation.Line message
|
||||
|
||||
let collectValidationErrors repoRoot mutations =
|
||||
mutations
|
||||
|> List.choose (fun mutation -> validateMutation repoRoot mutation |> Option.map (fun message -> mutation, message))
|
||||
|
||||
let printMutation mutation =
|
||||
printfn "id: %s" mutation.Id
|
||||
printfn "test: %s.%s" mutation.DeclaringType mutation.TestName
|
||||
printfn "file: %s:%d" mutation.File mutation.Line
|
||||
printfn "find: %s" mutation.Find
|
||||
printfn "replace: %s" mutation.Replace
|
||||
|
||||
let splitNullSeparated (text: string) =
|
||||
text.Split('\000', StringSplitOptions.RemoveEmptyEntries) |> Array.toList
|
||||
|
||||
let repoRelativePath (path: string) =
|
||||
path.Replace('/', Path.DirectorySeparatorChar)
|
||||
|
||||
let listUntrackedFiles () =
|
||||
let exitCode, stdout, stderr =
|
||||
captureProcess repoRoot "git" [ "ls-files"; "--others"; "--exclude-standard"; "-z" ]
|
||||
|
||||
if exitCode <> 0 then
|
||||
fail stderr
|
||||
|
||||
splitNullSeparated stdout
|
||||
|
||||
let copyFileIntoWorktree (repoRoot: string) (worktreePath: string) (relativePath: string) =
|
||||
let sourcePath = Path.Combine(repoRoot, repoRelativePath relativePath)
|
||||
let destinationPath = Path.Combine(worktreePath, repoRelativePath relativePath)
|
||||
let destinationDir = Path.GetDirectoryName destinationPath
|
||||
|
||||
if not (String.IsNullOrEmpty destinationDir) then
|
||||
Directory.CreateDirectory(destinationDir) |> ignore
|
||||
|
||||
File.Copy(sourcePath, destinationPath, true)
|
||||
|
||||
let cleanup (tempRoot: string) (worktreePath: string) =
|
||||
if Directory.Exists worktreePath then
|
||||
let _ = captureProcess repoRoot "git" [ "worktree"; "remove"; "--force"; worktreePath ]
|
||||
()
|
||||
|
||||
if Directory.Exists tempRoot then
|
||||
Directory.Delete(tempRoot, true)
|
||||
|
||||
let createWorktree (patchPath: string) (worktreePath: string) =
|
||||
let tempRoot = Path.GetDirectoryName patchPath
|
||||
Directory.CreateDirectory(tempRoot) |> ignore
|
||||
|
||||
let untrackedFiles = listUntrackedFiles ()
|
||||
let exitCode, diffText, stderr = captureProcess repoRoot "git" [ "diff"; "--binary"; "HEAD" ]
|
||||
|
||||
if exitCode <> 0 then
|
||||
fail stderr
|
||||
|
||||
File.WriteAllText(patchPath, diffText)
|
||||
|
||||
let exitCode2, stdout2, stderr2 = captureProcess repoRoot "git" [ "rev-parse"; "HEAD" ]
|
||||
|
||||
if exitCode2 <> 0 then
|
||||
fail stderr2
|
||||
|
||||
let baseRev = stdout2.Trim()
|
||||
let exitCode3, _, stderr3 = captureProcess repoRoot "git" [ "worktree"; "add"; "--detach"; worktreePath; baseRev ]
|
||||
|
||||
if exitCode3 <> 0 then
|
||||
fail stderr3
|
||||
|
||||
if FileInfo(patchPath).Length > 0L then
|
||||
let exitCode4, _, stderr4 = captureProcess worktreePath "git" [ "apply"; patchPath ]
|
||||
|
||||
if exitCode4 <> 0 then
|
||||
fail stderr4
|
||||
|
||||
for relativePath in untrackedFiles do
|
||||
copyFileIntoWorktree repoRoot worktreePath relativePath
|
||||
|
||||
let fullyQualifiedTestName mutation =
|
||||
let declaringType = mutation.DeclaringType.Replace('+', '.')
|
||||
$"{declaringType}.{mutation.TestName}"
|
||||
|
||||
let testFilter mutation =
|
||||
$"FullyQualifiedName={fullyQualifiedTestName mutation}"
|
||||
|
||||
let runMutation options project worktreePath mutation =
|
||||
let targetFile = Path.Combine(worktreePath, mutation.File.Replace('/', Path.DirectorySeparatorChar))
|
||||
|
||||
if not (File.Exists targetFile) then
|
||||
fail $"Target file does not exist in worktree: {targetFile}"
|
||||
|
||||
let originalText = File.ReadAllText targetFile
|
||||
let mutatedText = replaceOccurrenceOnLine mutation originalText
|
||||
File.WriteAllText(targetFile, mutatedText)
|
||||
|
||||
printfn "==> %s: %s" mutation.Id mutation.TestName
|
||||
|
||||
let buildExitCode =
|
||||
runProcess worktreePath "dotnet" (buildArgs options.Configuration options.BuildArgs project.RelativeProjectPath)
|
||||
|
||||
let outcome =
|
||||
if buildExitCode <> 0 then
|
||||
printfn "BUILD FAILED %s" mutation.Id
|
||||
BuildFailed
|
||||
else
|
||||
let testExitCode =
|
||||
runProcess
|
||||
worktreePath
|
||||
"dotnet"
|
||||
[ "test"
|
||||
project.RelativeProjectPath
|
||||
"--configuration"
|
||||
options.Configuration
|
||||
"--filter"
|
||||
testFilter mutation
|
||||
"--no-build"
|
||||
"--nologo" ]
|
||||
|
||||
if testExitCode = 0 then
|
||||
printfn "SURVIVED %s" mutation.Id
|
||||
Survived
|
||||
else
|
||||
printfn "KILLED %s" mutation.Id
|
||||
Killed
|
||||
|
||||
File.WriteAllText(targetFile, originalText)
|
||||
outcome
|
||||
interface IArgParserTemplate with
|
||||
member s.Usage =
|
||||
match s with
|
||||
| ProjectPath _ -> "path/to/project.csproj|fsproj"
|
||||
| Filter _ -> "filter down to mutations that contain the given search string"
|
||||
| ValidateOnly -> "check if the patches apply, but don't run the mutations"
|
||||
|
||||
[<EntryPoint>]
|
||||
let main argv =
|
||||
try
|
||||
let options = parseArgs (argv |> Array.toList)
|
||||
let project = loadProjectInfo options.ProjectPath
|
||||
let assemblyPath = targetPathForProject repoRoot project.AbsoluteProjectPath options.Configuration
|
||||
let mutations = mutationCases options project assemblyPath
|
||||
let parsedArguments =
|
||||
ArgumentParser.Create<Arguments>(programName = "mutannot")
|
||||
|> _.ParseCommandLine(argv)
|
||||
|
||||
if Array.isEmpty mutations then
|
||||
fail "No mutation cases were discovered in the test assembly."
|
||||
let projectPath = parsedArguments.GetResult ProjectPath
|
||||
let validateOnly = parsedArguments.Contains ValidateOnly
|
||||
let maybeFilter = parsedArguments.TryGetResult Filter
|
||||
|
||||
match options.Command with
|
||||
| Validate ->
|
||||
let validationErrors = mutations |> Array.toList |> collectValidationErrors repoRoot
|
||||
ensureCleanWorkingDirectory ()
|
||||
|
||||
if validationErrors.IsEmpty then
|
||||
printfn "Validated %d mutation(s): all still apply syntactically." mutations.Length
|
||||
0
|
||||
else
|
||||
printValidationErrors validationErrors
|
||||
1
|
||||
| List ->
|
||||
mutations
|
||||
|> Array.iter (fun mutation ->
|
||||
printfn "%s\t%s\t%s:%d" mutation.Id mutation.TestName mutation.File mutation.Line)
|
||||
AppDomain.CurrentDomain.ProcessExit.Add(fun _ -> restore ())
|
||||
|
||||
0
|
||||
| Show id ->
|
||||
let mutation = findMutation id mutations
|
||||
printMutation mutation
|
||||
0
|
||||
| Run ids ->
|
||||
let requested =
|
||||
match ids with
|
||||
| [] -> mutations |> Array.toList
|
||||
| _ -> ids |> List.map (fun id -> findMutation id mutations)
|
||||
let filteredMutations =
|
||||
getMutationCases projectPath
|
||||
|> Seq.filter _.Patch.Contains(maybeFilter |> Option.defaultValue "")
|
||||
|> Seq.indexed
|
||||
|
||||
let validationErrors = collectValidationErrors repoRoot requested
|
||||
for index, mutationCase in filteredMutations do
|
||||
Console.ForegroundColor <- ConsoleColor.Green
|
||||
printf $"MUTATION {index + 1}\n"
|
||||
|
||||
if not validationErrors.IsEmpty then
|
||||
printValidationErrors validationErrors
|
||||
1
|
||||
else
|
||||
Console.ForegroundColor <- ConsoleColor.Magenta
|
||||
printf "Test:\n"
|
||||
Console.ResetColor()
|
||||
printf "%s\n\n" mutationCase.TestName
|
||||
|
||||
let tempRoot = Path.Combine(Path.GetTempPath(), $"fscheck-mutants.{Guid.NewGuid():N}")
|
||||
let worktreePath = Path.Combine(tempRoot, "worktree")
|
||||
let patchPath = Path.Combine(tempRoot, "current.patch")
|
||||
Console.ForegroundColor <- ConsoleColor.Magenta
|
||||
printf "Patch:\n"
|
||||
Console.ResetColor()
|
||||
printf "%s\n" mutationCase.Patch
|
||||
|
||||
try
|
||||
createWorktree patchPath worktreePath
|
||||
applyPatch mutationCase.Patch
|
||||
|
||||
let outcomes =
|
||||
requested |> List.map (runMutation options project worktreePath)
|
||||
if not validateOnly then
|
||||
Console.ForegroundColor <- ConsoleColor.Magenta
|
||||
printf "Output:\n"
|
||||
Console.ResetColor()
|
||||
|
||||
let survivors = outcomes |> List.filter ((=) Survived) |> List.length
|
||||
let buildFailures = outcomes |> List.filter ((=) BuildFailed) |> List.length
|
||||
match runTest projectPath mutationCase.TestName with
|
||||
| 0 ->
|
||||
Console.ForegroundColor <- ConsoleColor.Red
|
||||
eprintf "ERROR: Expected tested to fail, but it succeeded\n"
|
||||
Console.ResetColor()
|
||||
exit 3
|
||||
| _ ->
|
||||
Console.ForegroundColor <- ConsoleColor.Green
|
||||
printf "✓ Mutant killed\n\n"
|
||||
|
||||
if survivors = 0 && buildFailures = 0 then
|
||||
printfn "All requested mutants were killed."
|
||||
0
|
||||
else
|
||||
fail $"{survivors} mutant(s) survived. {buildFailures} mutant(s) failed to build."
|
||||
finally
|
||||
cleanup tempRoot worktreePath
|
||||
with
|
||||
| UserError message ->
|
||||
eprintfn "%s" message
|
||||
1
|
||||
restore ()
|
||||
|
||||
Console.ForegroundColor <- ConsoleColor.Green
|
||||
|
||||
if validateOnly then
|
||||
printf "Success: All mutantions valid\n"
|
||||
else
|
||||
printf "Success: All mutants killed\n"
|
||||
|
||||
Console.ResetColor()
|
||||
|
||||
0
|
||||
|
|
|
|||
27
Mutannot/deps.json
Normal file
27
Mutannot/deps.json
Normal file
|
|
@ -0,0 +1,27 @@
|
|||
[
|
||||
{
|
||||
"pname": "Argu",
|
||||
"version": "6.2.5",
|
||||
"hash": "sha256-5HcZcvco4e8+hgLhzlxk7ZmFVLtZL9LVr7LbmXsLmNU="
|
||||
},
|
||||
{
|
||||
"pname": "Fli",
|
||||
"version": "1.1000.0",
|
||||
"hash": "sha256-LKJ2raQJuNfJKOA6Y85tECMnUFuKsmd5fBOG2Sq5OjY="
|
||||
},
|
||||
{
|
||||
"pname": "System.Configuration.ConfigurationManager",
|
||||
"version": "4.4.0",
|
||||
"hash": "sha256-+8wGYllXnIxRzy9dLhZFB88GoPj8ivYXS0KUfcivT8I="
|
||||
},
|
||||
{
|
||||
"pname": "System.Reflection.MetadataLoadContext",
|
||||
"version": "9.0.1",
|
||||
"hash": "sha256-kWm31a0unw/H8SjxaabVYKInR40bTAL9JnGQEVQGTsU="
|
||||
},
|
||||
{
|
||||
"pname": "System.Security.Cryptography.ProtectedData",
|
||||
"version": "4.4.0",
|
||||
"hash": "sha256-Ri53QmFX8I8UH0x4PikQ1ZA07ZSnBUXStd5rBfGWFOE="
|
||||
}
|
||||
]
|
||||
|
|
@ -1,8 +0,0 @@
|
|||
{ fetchNuGet }:
|
||||
[
|
||||
(fetchNuGet {
|
||||
pname = "FSharp.Core";
|
||||
version = "10.1.201";
|
||||
sha256 = "sha256-NzxdRJgL+5RQpUm8Y6Mc0w7sakxqThv6qHpP+u0x5x0=";
|
||||
})
|
||||
]
|
||||
59
flake.lock
generated
59
flake.lock
generated
|
|
@ -1,5 +1,47 @@
|
|||
{
|
||||
"nodes": {
|
||||
"flake-utils": {
|
||||
"inputs": {
|
||||
"systems": "systems"
|
||||
},
|
||||
"locked": {
|
||||
"lastModified": 1731533236,
|
||||
"narHash": "sha256-l0KFg5HjrsfsO/JpG+r7fRrqm12kzFHyUHqHCVpMMbI=",
|
||||
"owner": "numtide",
|
||||
"repo": "flake-utils",
|
||||
"rev": "11707dc2f618dd54ca8739b309ec4fc024de578b",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
"owner": "numtide",
|
||||
"repo": "flake-utils",
|
||||
"type": "github"
|
||||
}
|
||||
},
|
||||
"git-temp-commit": {
|
||||
"inputs": {
|
||||
"flake-utils": [
|
||||
"flake-utils"
|
||||
],
|
||||
"nixpkgs": [
|
||||
"nixpkgs"
|
||||
]
|
||||
},
|
||||
"locked": {
|
||||
"lastModified": 1778481212,
|
||||
"narHash": "sha256-Vy0ufQ51CHkamX+XB8hhgohBHJesKli0jF503NuSY20=",
|
||||
"ref": "main",
|
||||
"rev": "622b553f46920a2f3cc92f26c1f49cabb612de5f",
|
||||
"revCount": 2,
|
||||
"type": "git",
|
||||
"url": "https://codeberg.org/svenvanheugten/git-temp-commit.git"
|
||||
},
|
||||
"original": {
|
||||
"ref": "main",
|
||||
"type": "git",
|
||||
"url": "https://codeberg.org/svenvanheugten/git-temp-commit.git"
|
||||
}
|
||||
},
|
||||
"nixpkgs": {
|
||||
"locked": {
|
||||
"lastModified": 1776877367,
|
||||
|
|
@ -18,8 +60,25 @@
|
|||
},
|
||||
"root": {
|
||||
"inputs": {
|
||||
"flake-utils": "flake-utils",
|
||||
"git-temp-commit": "git-temp-commit",
|
||||
"nixpkgs": "nixpkgs"
|
||||
}
|
||||
},
|
||||
"systems": {
|
||||
"locked": {
|
||||
"lastModified": 1681028828,
|
||||
"narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
|
||||
"owner": "nix-systems",
|
||||
"repo": "default",
|
||||
"rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
"owner": "nix-systems",
|
||||
"repo": "default",
|
||||
"type": "github"
|
||||
}
|
||||
}
|
||||
},
|
||||
"root": "root",
|
||||
|
|
|
|||
85
flake.nix
85
flake.nix
|
|
@ -1,57 +1,50 @@
|
|||
{
|
||||
inputs = {
|
||||
nixpkgs.url = "github:NixOS/nixpkgs/nixos-unstable";
|
||||
flake-utils.url = "github:numtide/flake-utils";
|
||||
git-temp-commit = {
|
||||
url = "git+https://codeberg.org/svenvanheugten/git-temp-commit.git?ref=main";
|
||||
inputs.nixpkgs.follows = "nixpkgs";
|
||||
inputs.flake-utils.follows = "flake-utils";
|
||||
};
|
||||
};
|
||||
|
||||
outputs =
|
||||
{ self, nixpkgs }:
|
||||
let
|
||||
systems = [
|
||||
"x86_64-linux"
|
||||
"aarch64-linux"
|
||||
"x86_64-darwin"
|
||||
"aarch64-darwin"
|
||||
];
|
||||
forEachSystem =
|
||||
f: nixpkgs.lib.genAttrs systems (system: f system (import nixpkgs { inherit system; }));
|
||||
in
|
||||
{
|
||||
formatter = forEachSystem (_system: pkgs: pkgs.nixfmt-rfc-style);
|
||||
self,
|
||||
nixpkgs,
|
||||
flake-utils,
|
||||
git-temp-commit,
|
||||
}:
|
||||
flake-utils.lib.eachDefaultSystem (
|
||||
system:
|
||||
let
|
||||
pkgs = nixpkgs.legacyPackages.${system};
|
||||
in
|
||||
{
|
||||
packages.default = pkgs.buildDotnetModule {
|
||||
pname = "mutannot";
|
||||
version = "0.1.0";
|
||||
src = ./Mutannot;
|
||||
projectFile = "Mutannot.fsproj";
|
||||
nugetDeps = ./Mutannot/deps.json;
|
||||
executables = [ "mutannot" ];
|
||||
dotnet-sdk = pkgs.dotnet-sdk_10;
|
||||
dotnet-runtime = pkgs.dotnet-sdk_10;
|
||||
useDotnetFromEnv = true;
|
||||
|
||||
packages = forEachSystem (
|
||||
_system: pkgs:
|
||||
let
|
||||
mutannot = pkgs.buildDotnetModule {
|
||||
pname = "mutannot";
|
||||
version = "0.1.0";
|
||||
src = ./Mutannot;
|
||||
projectFile = "Mutannot.fsproj";
|
||||
nugetDeps = ./Mutannot/deps.nix;
|
||||
executables = [ "mutannot" ];
|
||||
dotnet-sdk = pkgs.dotnet-sdk_10;
|
||||
dotnet-runtime = pkgs.dotnet-sdk_10;
|
||||
useDotnetFromEnv = true;
|
||||
|
||||
meta = {
|
||||
mainProgram = "mutannot";
|
||||
};
|
||||
meta = {
|
||||
mainProgram = "mutannot";
|
||||
};
|
||||
in
|
||||
{
|
||||
default = mutannot;
|
||||
mutannot = mutannot;
|
||||
}
|
||||
);
|
||||
};
|
||||
|
||||
devShells = forEachSystem (
|
||||
_system: pkgs: {
|
||||
default = pkgs.mkShell {
|
||||
packages = [
|
||||
pkgs.git
|
||||
pkgs.dotnet-sdk_10
|
||||
];
|
||||
};
|
||||
}
|
||||
);
|
||||
};
|
||||
devShells.default = pkgs.mkShell {
|
||||
packages = [
|
||||
pkgs.git
|
||||
pkgs.dotnet-sdk_10
|
||||
git-temp-commit.packages.${system}.default
|
||||
];
|
||||
};
|
||||
}
|
||||
);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,18 +0,0 @@
|
|||
---
|
||||
name: Maintain mutations
|
||||
description: Trigger when asked to maintain mutations
|
||||
---
|
||||
|
||||
Start with:
|
||||
|
||||
```sh
|
||||
mutannot <path/to/test-project.fsproj> --validate
|
||||
```
|
||||
|
||||
Fix every reported error. Re-run `mutannot <path/to/test-project.fsproj> --validate` until it succeeds with no errors.
|
||||
|
||||
If you change mutations, you must run the changed mutations with:
|
||||
|
||||
```sh
|
||||
mutannot <path/to/test-project.fsproj> --run <mutation id 1> <mutation id 2> <...>
|
||||
```
|
||||
|
|
@ -1,25 +0,0 @@
|
|||
---
|
||||
name: Write mutations
|
||||
description: Trigger when asked to write mutations
|
||||
---
|
||||
|
||||
Annotate tests with one or more mutations (`MutationCase`s) that will cause the test to fail.
|
||||
|
||||
Example:
|
||||
|
||||
```fs
|
||||
[<Fact>]
|
||||
[<MutationCase("calc-operator-mixup", "Calculator/Calculator.fs", 4, "value + 1", "value - 1")>]
|
||||
member _.AddOne_increments() =
|
||||
Assert.Equal(42, Calculator.addOne 41)
|
||||
```
|
||||
|
||||
In this example,
|
||||
|
||||
* `calc-operator-mixup` is the mutation name,
|
||||
* `Calculator/Calculator.fs` is the path to the production code (relative to the repository root),
|
||||
* `4` is the number of the line to mutate,
|
||||
* `value + 1` is the string to find, and
|
||||
* `value - 1` is the string to replace it with.
|
||||
|
||||
Verify your work with `mutannot <path/to/test-project.fsproj> --run <mutation id 1> <mutation id 2> <...>`.
|
||||
Loading…
Add table
Add a link
Reference in a new issue