diff --git a/.editorconfig b/.editorconfig deleted file mode 100644 index ececb87..0000000 --- a/.editorconfig +++ /dev/null @@ -1,14 +0,0 @@ -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 diff --git a/.gitignore b/.gitignore index 2b749db..33afe2c 100644 --- a/.gitignore +++ b/.gitignore @@ -211,6 +211,3 @@ FakesAssemblies/ # Codex .codex - -# Nix -result diff --git a/Example.Tests/Calculator.fs b/Example.Tests/Calculator.fs new file mode 100644 index 0000000..cfcce3b --- /dev/null +++ b/Example.Tests/Calculator.fs @@ -0,0 +1,10 @@ +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) diff --git a/Example.Tests/CalculatorTests.fs b/Example.Tests/CalculatorTests.fs new file mode 100644 index 0000000..40f9b66 --- /dev/null +++ b/Example.Tests/CalculatorTests.fs @@ -0,0 +1,22 @@ +namespace Example.Tests + +open Example +open Mutannot +open Xunit + +type CalculatorTests() = + [] + [] + member _.AddOne_increments() = + Assert.Equal(42, Calculator.addOne 41) + + [] + [] + member _.AbsoluteDifference_preserves_order() = + Assert.Equal(7, Calculator.absoluteDifference 10 3) + + [] + [ 0", "year % 100 = 0")>] + member _.LeapYear_handles_centuries() = + Assert.True(Calculator.isLeapYear 2000) + Assert.False(Calculator.isLeapYear 1900) diff --git a/Example/Example.fsproj b/Example.Tests/Example.Tests.fsproj similarity index 100% rename from Example/Example.fsproj rename to Example.Tests/Example.Tests.fsproj diff --git a/Example.Tests/MutationCaseAttribute.fs b/Example.Tests/MutationCaseAttribute.fs new file mode 100644 index 0000000..12e6475 --- /dev/null +++ b/Example.Tests/MutationCaseAttribute.fs @@ -0,0 +1,13 @@ +namespace Mutannot + +open System + +[] +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 diff --git a/Example/Calculator.fs b/Example/Calculator.fs deleted file mode 100644 index 6f0c515..0000000 --- a/Example/Calculator.fs +++ /dev/null @@ -1,4 +0,0 @@ -namespace Example - -module Calculator = - let addOne value = value + 1 diff --git a/Example/CalculatorTests.fs b/Example/CalculatorTests.fs deleted file mode 100644 index 9029f0e..0000000 --- a/Example/CalculatorTests.fs +++ /dev/null @@ -1,21 +0,0 @@ -namespace Example - -open Example -open Mutannot -open Xunit - -type CalculatorTests() = - [] - [] - member _.AddOne_increments() = Assert.Equal(42, Calculator.addOne 41) diff --git a/Example/MutationCaseAttribute.fs b/Example/MutationCaseAttribute.fs deleted file mode 100644 index f1175e4..0000000 --- a/Example/MutationCaseAttribute.fs +++ /dev/null @@ -1,9 +0,0 @@ -namespace Mutannot - -open System - -[] -type MutationCaseAttribute(patch: string) = - inherit Attribute() - - member _.Patch = patch diff --git a/Mutannot/Mutannot.fsproj b/Mutannot/Mutannot.fsproj index 396d322..cd3d012 100644 --- a/Mutannot/Mutannot.fsproj +++ b/Mutannot/Mutannot.fsproj @@ -11,8 +11,6 @@ - - diff --git a/Mutannot/Program.fs b/Mutannot/Program.fs index 118570e..9baab14 100644 --- a/Mutannot/Program.fs +++ b/Mutannot/Program.fs @@ -1,195 +1,579 @@ open System +open System.Collections.Generic +open System.Diagnostics open System.IO open System.Reflection -open System.Runtime.InteropServices -open Fli -open Argu -type MutationCase = { TestName: string; Patch: string } +exception UserError of string -let ensureCleanWorkingDirectory () = - let gitState = - cli { - Exec "git" - Arguments [ "status"; "--porcelain" ] - } - |> Command.execute - |> Output.throwIfErrored +type MutationCase = + { Id: string + File: string + Line: int + Find: string + Replace: string + TestName: string + DeclaringType: string } - if gitState.Text <> None then - eprintfn "Uncommitted changes. Refusing to run." - exit 2 +type MutationOutcome = + | Killed + | Survived + | BuildFailed -let applyPatch patch = - cli { - Exec "git" - Arguments [ "apply"; "-" ] - Input patch - } - |> Command.execute - |> Output.throwIfErrored - |> ignore +type Command = + | Validate + | List + | Show of string + | Run of string list -let restore () = - cli { - Exec "git" - Arguments [ "restore"; "--staged"; "--worktree"; "." ] - } - |> Command.execute - |> Output.throwIfErrored - |> ignore +type Options = + { Configuration: string + ProjectPath: string + BuildArgs: string list + NoBuild: bool + Command: Command } -let ensureBuilt projectPath = - cli { - Exec "dotnet" - Arguments [ "build"; projectPath ] - Output(new StreamWriter(Console.OpenStandardOutput())) - } - |> Command.execute - |> Output.throwIfErrored - |> ignore +type ProjectInfo = + { RelativeProjectPath: string + AbsoluteProjectPath: string } -let runTest projectPath testName = - cli { - Exec "dotnet" - Arguments [ "test"; projectPath; "--filter"; $"FullyQualifiedName={testName}" ] - Output(new StreamWriter(Console.OpenStandardOutput())) - } - |> Command.execute - |> Output.toExitCode +let fail message = + raise (UserError message) -let getAssemblyPath projectPath = - cli { - Exec "dotnet" - Arguments [ "msbuild"; projectPath; "--getProperty:TargetPath" ] - } - |> Command.execute - |> Output.toText +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 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 + 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 [--configuration Debug|Release] [--build-arg ...] [--no-build] [--validate | --list | --show | --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) 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) 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 assemblyDir = Path.GetDirectoryName assemblyPath - let pathAssemblyResolver = - [ yield assemblyPath - yield! Directory.EnumerateFiles(assemblyDir, "*.dll") - yield! Directory.EnumerateFiles(assemblyDir, "*.exe") - yield! Directory.GetFiles(RuntimeEnvironment.GetRuntimeDirectory(), "*.dll") ] - |> PathAssemblyResolver + 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." - new MetadataLoadContext(pathAssemblyResolver, typeof.Assembly.GetName().Name) + let localAssemblies = + seq { + yield assemblyPath + yield! Directory.EnumerateFiles(assemblyDir, "*.dll") + yield! Directory.EnumerateFiles(assemblyDir, "*.exe") + } -let unindentPatch (s: string) = - let lines = s.Split([| "\r\n"; "\n" |], StringSplitOptions.None) + Seq.append runtimeAssemblies localAssemblies + |> Seq.distinct + |> Seq.toArray - let indexOfFirstNonEmptyLine = - lines |> Array.findIndex (not << String.IsNullOrWhiteSpace) +let createMetadataLoadContext (assemblyPath: string) = + let resolver = PathAssemblyResolver(metadataLoadContextPaths assemblyPath) + let coreAssemblyName = typeof.Assembly.GetName().Name - let identantionOfFirstNonEmptyLine = - lines[indexOfFirstNonEmptyLine] |> Seq.takeWhile Char.IsWhiteSpace |> Seq.length + new MetadataLoadContext(resolver, coreAssemblyName) - lines[indexOfFirstNonEmptyLine..] - |> Seq.map (fun line -> line.Substring(min identantionOfFirstNonEmptyLine line.Length)) - |> String.concat Environment.NewLine +let mutationCases options project assemblyPath = + ensureBuilt options project assemblyPath -let getMutationCases projectPath = - ensureBuilt projectPath + use mlc = createMetadataLoadContext assemblyPath + let asm = mlc.LoadFromAssemblyPath assemblyPath - let assemblyPath = getAssemblyPath projectPath + asm.GetTypes() + |> Array.collect (fun t -> + let declaringType = + match t.FullName with + | null -> t.Name + | name -> name - use metadataLoadContext = getMetadataLoadContext assemblyPath + 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 - let assemblyTypes = - assemblyPath |> metadataLoadContext.LoadFromAssemblyPath |> _.GetTypes() + if args.Count <> 5 then + fail $"Unexpected MutationCaseAttribute shape on {declaringType}.{m.Name}" - let assemblyMethods = - assemblyTypes - |> Seq.collect _.GetMethods(BindingFlags.Public ||| BindingFlags.Instance) + 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) - assemblyMethods - |> Seq.collect (fun m -> - m.GetCustomAttributesData() - |> Seq.choose (fun attr -> - match attr.AttributeType.FullName with - | "Mutannot.MutationCaseAttribute" -> +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 + "" + 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 -> Some - { TestName = $"{m.DeclaringType.FullName}.{m.Name}" - Patch = attr.ConstructorArguments[0].Value :?> string |> unindentPatch } - | _ -> None)) - |> Seq.toList + (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) -type Arguments = - | [] ProjectPath of ProjectPath: string - | Filter of SearchString: string - | ValidateOnly +let printValidationErrors errors = + eprintfn "Validation failed for %d mutation(s):" (errors |> List.length) - 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" + 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 [] let main argv = - let parsedArguments = - ArgumentParser.Create(programName = "mutannot") - |> _.ParseCommandLine(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 projectPath = parsedArguments.GetResult ProjectPath - let validateOnly = parsedArguments.Contains ValidateOnly - let maybeFilter = parsedArguments.TryGetResult Filter + if Array.isEmpty mutations then + fail "No mutation cases were discovered in the test assembly." - ensureCleanWorkingDirectory () + match options.Command with + | Validate -> + let validationErrors = mutations |> Array.toList |> collectValidationErrors repoRoot - AppDomain.CurrentDomain.ProcessExit.Add(fun _ -> restore ()) + 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) - let filteredMutations = - getMutationCases projectPath - |> Seq.filter _.Patch.Contains(maybeFilter |> Option.defaultValue "") - |> Seq.indexed + 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) - for index, mutationCase in filteredMutations do - Console.ForegroundColor <- ConsoleColor.Green - printf $"MUTATION {index + 1}\n" + let validationErrors = collectValidationErrors repoRoot requested - Console.ForegroundColor <- ConsoleColor.Magenta - printf "Test:\n" - Console.ResetColor() - printf "%s\n\n" mutationCase.TestName + if not validationErrors.IsEmpty then + printValidationErrors validationErrors + 1 + else - Console.ForegroundColor <- ConsoleColor.Magenta - printf "Patch:\n" - Console.ResetColor() - printf "%s\n" mutationCase.Patch + let tempRoot = Path.Combine(Path.GetTempPath(), $"fscheck-mutants.{Guid.NewGuid():N}") + let worktreePath = Path.Combine(tempRoot, "worktree") + let patchPath = Path.Combine(tempRoot, "current.patch") - applyPatch mutationCase.Patch + try + createWorktree patchPath worktreePath - if not validateOnly then - Console.ForegroundColor <- ConsoleColor.Magenta - printf "Output:\n" - Console.ResetColor() + let outcomes = + requested |> List.map (runMutation options project worktreePath) - 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" + let survivors = outcomes |> List.filter ((=) Survived) |> List.length + let buildFailures = outcomes |> List.filter ((=) BuildFailed) |> List.length - restore () - - Console.ForegroundColor <- ConsoleColor.Green - - if validateOnly then - printf "Success: All mutantions valid\n" - else - printf "Success: All mutants killed\n" - - Console.ResetColor() - - 0 + 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 diff --git a/Mutannot/deps.json b/Mutannot/deps.json deleted file mode 100644 index 8d83a9c..0000000 --- a/Mutannot/deps.json +++ /dev/null @@ -1,27 +0,0 @@ -[ - { - "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=" - } -] diff --git a/Mutannot/deps.nix b/Mutannot/deps.nix new file mode 100644 index 0000000..60de7f1 --- /dev/null +++ b/Mutannot/deps.nix @@ -0,0 +1,8 @@ +{ fetchNuGet }: +[ + (fetchNuGet { + pname = "FSharp.Core"; + version = "10.1.201"; + sha256 = "sha256-NzxdRJgL+5RQpUm8Y6Mc0w7sakxqThv6qHpP+u0x5x0="; + }) +] diff --git a/flake.lock b/flake.lock index 8244c7c..6908e25 100644 --- a/flake.lock +++ b/flake.lock @@ -1,47 +1,5 @@ { "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, @@ -60,25 +18,8 @@ }, "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", diff --git a/flake.nix b/flake.nix index f72685d..16f31af 100644 --- a/flake.nix +++ b/flake.nix @@ -1,50 +1,57 @@ { 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 { - 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; + formatter = forEachSystem (_system: pkgs: pkgs.nixfmt-rfc-style); - meta = { - mainProgram = "mutannot"; + 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"; + }; }; - }; + in + { + default = mutannot; + mutannot = mutannot; + } + ); - devShells.default = pkgs.mkShell { - packages = [ - pkgs.git - pkgs.dotnet-sdk_10 - git-temp-commit.packages.${system}.default - ]; - }; - } - ); + devShells = forEachSystem ( + _system: pkgs: { + default = pkgs.mkShell { + packages = [ + pkgs.git + pkgs.dotnet-sdk_10 + ]; + }; + } + ); + }; } diff --git a/skills/maintain-mutations/SKILL.md b/skills/maintain-mutations/SKILL.md new file mode 100644 index 0000000..0563e7a --- /dev/null +++ b/skills/maintain-mutations/SKILL.md @@ -0,0 +1,18 @@ +--- +name: Maintain mutations +description: Trigger when asked to maintain mutations +--- + +Start with: + +```sh +mutannot --validate +``` + +Fix every reported error. Re-run `mutannot --validate` until it succeeds with no errors. + +If you change mutations, you must run the changed mutations with: + +```sh +mutannot --run <...> +``` diff --git a/skills/write-mutations/SKILL.md b/skills/write-mutations/SKILL.md new file mode 100644 index 0000000..97bc2ed --- /dev/null +++ b/skills/write-mutations/SKILL.md @@ -0,0 +1,25 @@ +--- +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 +[] +[] +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 --run <...>`.