diff --git a/.editorconfig b/.editorconfig new file mode 100644 index 0000000..ececb87 --- /dev/null +++ b/.editorconfig @@ -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 diff --git a/.gitignore b/.gitignore index 33afe2c..2b749db 100644 --- a/.gitignore +++ b/.gitignore @@ -211,3 +211,6 @@ FakesAssemblies/ # Codex .codex + +# Nix +result diff --git a/Example.Tests/Calculator.fs b/Example.Tests/Calculator.fs deleted file mode 100644 index cfcce3b..0000000 --- a/Example.Tests/Calculator.fs +++ /dev/null @@ -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) diff --git a/Example.Tests/CalculatorTests.fs b/Example.Tests/CalculatorTests.fs deleted file mode 100644 index 40f9b66..0000000 --- a/Example.Tests/CalculatorTests.fs +++ /dev/null @@ -1,22 +0,0 @@ -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.Tests/MutationCaseAttribute.fs b/Example.Tests/MutationCaseAttribute.fs deleted file mode 100644 index 12e6475..0000000 --- a/Example.Tests/MutationCaseAttribute.fs +++ /dev/null @@ -1,13 +0,0 @@ -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 new file mode 100644 index 0000000..6f0c515 --- /dev/null +++ b/Example/Calculator.fs @@ -0,0 +1,4 @@ +namespace Example + +module Calculator = + let addOne value = value + 1 diff --git a/Example/CalculatorTests.fs b/Example/CalculatorTests.fs new file mode 100644 index 0000000..9029f0e --- /dev/null +++ b/Example/CalculatorTests.fs @@ -0,0 +1,21 @@ +namespace Example + +open Example +open Mutannot +open Xunit + +type CalculatorTests() = + [] + [] + member _.AddOne_increments() = Assert.Equal(42, Calculator.addOne 41) diff --git a/Example.Tests/Example.Tests.fsproj b/Example/Example.fsproj similarity index 100% rename from Example.Tests/Example.Tests.fsproj rename to Example/Example.fsproj diff --git a/Example/MutationCaseAttribute.fs b/Example/MutationCaseAttribute.fs new file mode 100644 index 0000000..f1175e4 --- /dev/null +++ b/Example/MutationCaseAttribute.fs @@ -0,0 +1,9 @@ +namespace Mutannot + +open System + +[] +type MutationCaseAttribute(patch: string) = + inherit Attribute() + + member _.Patch = patch diff --git a/Mutannot/Mutannot.fsproj b/Mutannot/Mutannot.fsproj index cd3d012..396d322 100644 --- a/Mutannot/Mutannot.fsproj +++ b/Mutannot/Mutannot.fsproj @@ -11,6 +11,8 @@ + + diff --git a/Mutannot/Program.fs b/Mutannot/Program.fs index 9baab14..118570e 100644 --- a/Mutannot/Program.fs +++ b/Mutannot/Program.fs @@ -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 [--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 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.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.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 - "" - 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 = + | [] 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" [] 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(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 diff --git a/Mutannot/deps.json b/Mutannot/deps.json new file mode 100644 index 0000000..8d83a9c --- /dev/null +++ b/Mutannot/deps.json @@ -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=" + } +] diff --git a/Mutannot/deps.nix b/Mutannot/deps.nix deleted file mode 100644 index 60de7f1..0000000 --- a/Mutannot/deps.nix +++ /dev/null @@ -1,8 +0,0 @@ -{ fetchNuGet }: -[ - (fetchNuGet { - pname = "FSharp.Core"; - version = "10.1.201"; - sha256 = "sha256-NzxdRJgL+5RQpUm8Y6Mc0w7sakxqThv6qHpP+u0x5x0="; - }) -] diff --git a/flake.lock b/flake.lock index 6908e25..8244c7c 100644 --- a/flake.lock +++ b/flake.lock @@ -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", diff --git a/flake.nix b/flake.nix index 16f31af..f72685d 100644 --- a/flake.nix +++ b/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 + ]; + }; + } + ); } diff --git a/skills/maintain-mutations/SKILL.md b/skills/maintain-mutations/SKILL.md deleted file mode 100644 index 0563e7a..0000000 --- a/skills/maintain-mutations/SKILL.md +++ /dev/null @@ -1,18 +0,0 @@ ---- -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 deleted file mode 100644 index 97bc2ed..0000000 --- a/skills/write-mutations/SKILL.md +++ /dev/null @@ -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 -[] -[] -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 <...>`.