From 3bc0c4e9e8cb8f70818c7b041bdacb211829a570 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Tue, 12 May 2026 06:36:50 +0200 Subject: [PATCH 01/23] Empty Program.fs --- Mutannot/Program.fs | 579 +------------------------------------------- 1 file changed, 1 insertion(+), 578 deletions(-) diff --git a/Mutannot/Program.fs b/Mutannot/Program.fs index 9baab14..5b77edb 100644 --- a/Mutannot/Program.fs +++ b/Mutannot/Program.fs @@ -1,579 +1,2 @@ -open System -open System.Collections.Generic -open System.Diagnostics -open System.IO -open System.Reflection - -exception UserError of string - -type MutationCase = - { Id: string - File: string - Line: int - Find: string - Replace: string - TestName: string - DeclaringType: string } - -type MutationOutcome = - | Killed - | Survived - | BuildFailed - -type Command = - | Validate - | List - | Show of string - | Run of string list - -type Options = - { Configuration: string - ProjectPath: string - BuildArgs: string list - NoBuild: bool - Command: Command } - -type ProjectInfo = - { RelativeProjectPath: string - AbsoluteProjectPath: string } - -let fail message = - raise (UserError message) - -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 - - 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 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 localAssemblies = - seq { - yield assemblyPath - yield! Directory.EnumerateFiles(assemblyDir, "*.dll") - yield! Directory.EnumerateFiles(assemblyDir, "*.exe") - } - - Seq.append runtimeAssemblies localAssemblies - |> Seq.distinct - |> Seq.toArray - -let createMetadataLoadContext (assemblyPath: string) = - let resolver = PathAssemblyResolver(metadataLoadContextPaths assemblyPath) - let coreAssemblyName = typeof.Assembly.GetName().Name - - new MetadataLoadContext(resolver, coreAssemblyName) - -let mutationCases options project assemblyPath = - ensureBuilt options project assemblyPath - - use mlc = createMetadataLoadContext assemblyPath - let asm = mlc.LoadFromAssemblyPath assemblyPath - - asm.GetTypes() - |> Array.collect (fun t -> - let declaringType = - match t.FullName with - | null -> t.Name - | name -> name - - 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 - - if args.Count <> 5 then - fail $"Unexpected MutationCaseAttribute shape on {declaringType}.{m.Name}" - - 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 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 - (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) - -let printValidationErrors errors = - eprintfn "Validation failed for %d mutation(s):" (errors |> List.length) - - 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 = - 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 - - if Array.isEmpty mutations then - fail "No mutation cases were discovered in the test assembly." - - match options.Command with - | Validate -> - let validationErrors = mutations |> Array.toList |> collectValidationErrors repoRoot - - 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) - - 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 validationErrors = collectValidationErrors repoRoot requested - - if not validationErrors.IsEmpty then - printValidationErrors validationErrors - 1 - else - - let tempRoot = Path.Combine(Path.GetTempPath(), $"fscheck-mutants.{Guid.NewGuid():N}") - let worktreePath = Path.Combine(tempRoot, "worktree") - let patchPath = Path.Combine(tempRoot, "current.patch") - - try - createWorktree patchPath worktreePath - - let outcomes = - requested |> List.map (runMutation options project worktreePath) - - let survivors = outcomes |> List.filter ((=) Survived) |> List.length - let buildFailures = outcomes |> List.filter ((=) BuildFailed) |> List.length - - 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 +let main argv = 0 -- 2.51.2 From 6728ffeee871df5e7b4433463c3f751621b59ef1 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Tue, 12 May 2026 06:37:08 +0200 Subject: [PATCH 02/23] Refuse to run if git repo is dirty --- Mutannot/Mutannot.fsproj | 1 + Mutannot/Program.fs | 17 ++++++++++++++++- 2 files changed, 17 insertions(+), 1 deletion(-) diff --git a/Mutannot/Mutannot.fsproj b/Mutannot/Mutannot.fsproj index cd3d012..7c6381b 100644 --- a/Mutannot/Mutannot.fsproj +++ b/Mutannot/Mutannot.fsproj @@ -11,6 +11,7 @@ + diff --git a/Mutannot/Program.fs b/Mutannot/Program.fs index 5b77edb..e7195fc 100644 --- a/Mutannot/Program.fs +++ b/Mutannot/Program.fs @@ -1,2 +1,17 @@ +open Fli + [] -let main argv = 0 +let main argv = + let gitState = + cli { + Exec "git" + Arguments [ "status"; "--porcelain" ] + } + |> Command.execute + |> Output.throwIfErrored + + if gitState.Text <> None then + eprintfn "Uncommitted changes. Refusing to run." + exit 1 + + 0 -- 2.51.2 From ccb456d5b0dd5e135394be6213e9c4587341e81d Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Tue, 12 May 2026 06:37:31 +0200 Subject: [PATCH 03/23] Add .editorconfig --- .editorconfig | 14 ++++++++++++++ 1 file changed, 14 insertions(+) create mode 100644 .editorconfig 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 -- 2.51.2 From 442fe5d5d8742219b2a32be2622a20d5fed79d16 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Tue, 12 May 2026 06:54:47 +0200 Subject: [PATCH 04/23] Use flake-utils in flake.nix --- flake.lock | 34 ++++++++++++++++++++++++ flake.nix | 78 ++++++++++++++++++++++-------------------------------- 2 files changed, 66 insertions(+), 46 deletions(-) diff --git a/flake.lock b/flake.lock index 6908e25..20db77f 100644 --- a/flake.lock +++ b/flake.lock @@ -1,5 +1,23 @@ { "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" + } + }, "nixpkgs": { "locked": { "lastModified": 1776877367, @@ -18,8 +36,24 @@ }, "root": { "inputs": { + "flake-utils": "flake-utils", "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..6add518 100644 --- a/flake.nix +++ b/flake.nix @@ -1,57 +1,43 @@ { inputs = { nixpkgs.url = "github:NixOS/nixpkgs/nixos-unstable"; + flake-utils.url = "github:numtide/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, + }: + 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.nix; + 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 + ]; + }; + } + ); } -- 2.51.2 From c2e5a01e26c8ba4640e1f79bad2873e1e22d5ab3 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Tue, 12 May 2026 06:57:20 +0200 Subject: [PATCH 05/23] Add git-temp-commit to devshell --- flake.lock | 25 +++++++++++++++++++++++++ flake.nix | 7 +++++++ 2 files changed, 32 insertions(+) diff --git a/flake.lock b/flake.lock index 20db77f..8244c7c 100644 --- a/flake.lock +++ b/flake.lock @@ -18,6 +18,30 @@ "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, @@ -37,6 +61,7 @@ "root": { "inputs": { "flake-utils": "flake-utils", + "git-temp-commit": "git-temp-commit", "nixpkgs": "nixpkgs" } }, diff --git a/flake.nix b/flake.nix index 6add518..f3fe06f 100644 --- a/flake.nix +++ b/flake.nix @@ -2,6 +2,11 @@ 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 = @@ -9,6 +14,7 @@ self, nixpkgs, flake-utils, + git-temp-commit, }: flake-utils.lib.eachDefaultSystem ( system: @@ -36,6 +42,7 @@ packages = [ pkgs.git pkgs.dotnet-sdk_10 + git-temp-commit.packages.${system}.default ]; }; } -- 2.51.2 From b4292969673878fad392fc6ae1543fa82b017117 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Tue, 12 May 2026 07:01:45 +0200 Subject: [PATCH 06/23] Add usage message --- Mutannot/Program.fs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/Mutannot/Program.fs b/Mutannot/Program.fs index e7195fc..1de7c20 100644 --- a/Mutannot/Program.fs +++ b/Mutannot/Program.fs @@ -2,6 +2,10 @@ open Fli [] let main argv = + if argv.Length <> 1 then + eprintfn "Usage: mutannot " + exit 1 + let gitState = cli { Exec "git" @@ -12,6 +16,6 @@ let main argv = if gitState.Text <> None then eprintfn "Uncommitted changes. Refusing to run." - exit 1 + exit 2 0 -- 2.51.2 From 05deb1f08945bc29b1ca78a2205128f6ea93462e Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Tue, 12 May 2026 07:05:45 +0200 Subject: [PATCH 07/23] Build the project --- Mutannot/Program.fs | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/Mutannot/Program.fs b/Mutannot/Program.fs index 1de7c20..98784fb 100644 --- a/Mutannot/Program.fs +++ b/Mutannot/Program.fs @@ -1,3 +1,5 @@ +open System +open System.IO open Fli [] @@ -18,4 +20,13 @@ let main argv = eprintfn "Uncommitted changes. Refusing to run." exit 2 + cli { + Exec "dotnet" + Arguments [ "build"; argv[0] ] + Output(new StreamWriter(Console.OpenStandardOutput())) + } + |> Command.execute + |> Output.throwIfErrored + |> ignore + 0 -- 2.51.2 From 10ddbef963a51f6ed86555f2cb79c49256f3e218 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Tue, 12 May 2026 07:58:33 +0200 Subject: [PATCH 08/23] Scan assembly for mutations --- Mutannot/Program.fs | 74 ++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 66 insertions(+), 8 deletions(-) diff --git a/Mutannot/Program.fs b/Mutannot/Program.fs index 98784fb..5c3a1ac 100644 --- a/Mutannot/Program.fs +++ b/Mutannot/Program.fs @@ -1,13 +1,77 @@ open System open System.IO +open System.Reflection +open System.Runtime.InteropServices open Fli +type MutationCase = { TestName: string; Id: string } + +let ensureBuilt projectPath = + cli { + Exec "dotnet" + Arguments [ "build"; projectPath ] + Output(new StreamWriter(Console.OpenStandardOutput())) + } + |> Command.execute + |> Output.throwIfErrored + |> ignore + +let getAssemblyPath projectPath = + cli { + Exec "dotnet" + Arguments [ "msbuild"; projectPath; "--getProperty:TargetPath" ] + } + |> Command.execute + |> Output.toText + +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 pathAssemblyResolver = + [ yield assemblyPath + yield! Directory.EnumerateFiles(assemblyDir, "*.dll") + yield! Directory.EnumerateFiles(assemblyDir, "*.exe") + yield! Directory.GetFiles(RuntimeEnvironment.GetRuntimeDirectory(), "*.dll") ] + |> PathAssemblyResolver + + new MetadataLoadContext(pathAssemblyResolver, typeof.Assembly.GetName().Name) + +let getMutationCases projectPath = + ensureBuilt projectPath + + let assemblyPath = getAssemblyPath projectPath + + use metadataLoadContext = getMetadataLoadContext assemblyPath + + let assemblyTypes = + assemblyPath |> metadataLoadContext.LoadFromAssemblyPath |> _.GetTypes() + + let assemblyMethods = + assemblyTypes + |> Seq.collect _.GetMethods(BindingFlags.Public ||| BindingFlags.Instance) + + assemblyMethods + |> Seq.collect (fun m -> + m.GetCustomAttributesData() + |> Seq.choose (fun attr -> + match attr.AttributeType.FullName with + | "Mutannot.MutationCaseAttribute" -> + Some + { TestName = $"{m.DeclaringType.FullName}.{m.Name}" + Id = attr.ConstructorArguments[0].Value :?> string } + | _ -> None)) + |> Seq.toList + [] let main argv = if argv.Length <> 1 then eprintfn "Usage: mutannot " exit 1 + let projectPath = argv[0] + let gitState = cli { Exec "git" @@ -20,13 +84,7 @@ let main argv = eprintfn "Uncommitted changes. Refusing to run." exit 2 - cli { - Exec "dotnet" - Arguments [ "build"; argv[0] ] - Output(new StreamWriter(Console.OpenStandardOutput())) - } - |> Command.execute - |> Output.throwIfErrored - |> ignore + for mutationCase in getMutationCases projectPath do + printfn "%s" <| mutationCase.ToString() 0 -- 2.51.2 From 2dc2c288fb41e984c1e7f25d48615e32816c3681 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Tue, 12 May 2026 08:07:43 +0200 Subject: [PATCH 09/23] Make mutations patch-based --- Example.Tests/CalculatorTests.fs | 29 +++++++++++++++----------- Example.Tests/MutationCaseAttribute.fs | 8 ++----- Mutannot/Program.fs | 4 ++-- 3 files changed, 21 insertions(+), 20 deletions(-) diff --git a/Example.Tests/CalculatorTests.fs b/Example.Tests/CalculatorTests.fs index 40f9b66..0a96e10 100644 --- a/Example.Tests/CalculatorTests.fs +++ b/Example.Tests/CalculatorTests.fs @@ -6,17 +6,22 @@ open Xunit type CalculatorTests() = [] - [] - member _.AddOne_increments() = - Assert.Equal(42, Calculator.addOne 41) + [] - [] - member _.AbsoluteDifference_preserves_order() = - Assert.Equal(7, Calculator.absoluteDifference 10 3) + module Calculator = + - let addOne value = value + 1 + + let addOne value = value - 1 - [] - [ 0", "year % 100 = 0")>] - member _.LeapYear_handles_centuries() = - Assert.True(Calculator.isLeapYear 2000) - Assert.False(Calculator.isLeapYear 1900) + let absoluteDifference left right = + if left >= right then left - right else right - left + + member _.AddOne_increments() = + Assert.Equal(42, Calculator.addOne 41) + """)>] + member _.AddOne_increments() = Assert.Equal(42, Calculator.addOne 41) diff --git a/Example.Tests/MutationCaseAttribute.fs b/Example.Tests/MutationCaseAttribute.fs index 12e6475..f1175e4 100644 --- a/Example.Tests/MutationCaseAttribute.fs +++ b/Example.Tests/MutationCaseAttribute.fs @@ -3,11 +3,7 @@ namespace Mutannot open System [] -type MutationCaseAttribute(id: string, file: string, line: int, find: string, replace: string) = +type MutationCaseAttribute(patch: string) = inherit Attribute() - member _.Id = id - member _.File = file - member _.Line = line - member _.Find = find - member _.Replace = replace + member _.Patch = patch diff --git a/Mutannot/Program.fs b/Mutannot/Program.fs index 5c3a1ac..6cd78aa 100644 --- a/Mutannot/Program.fs +++ b/Mutannot/Program.fs @@ -4,7 +4,7 @@ open System.Reflection open System.Runtime.InteropServices open Fli -type MutationCase = { TestName: string; Id: string } +type MutationCase = { TestName: string; Patch: string } let ensureBuilt projectPath = cli { @@ -60,7 +60,7 @@ let getMutationCases projectPath = | "Mutannot.MutationCaseAttribute" -> Some { TestName = $"{m.DeclaringType.FullName}.{m.Name}" - Id = attr.ConstructorArguments[0].Value :?> string } + Patch = attr.ConstructorArguments[0].Value :?> string } | _ -> None)) |> Seq.toList -- 2.51.2 From c6996d5bbfd406ec6f792e69ec807d26ef55a154 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Tue, 12 May 2026 08:08:58 +0200 Subject: [PATCH 10/23] Move ensureCleanWorkingDirectory to own function --- Mutannot/Program.fs | 27 +++++++++++++++------------ 1 file changed, 15 insertions(+), 12 deletions(-) diff --git a/Mutannot/Program.fs b/Mutannot/Program.fs index 6cd78aa..5c3f6be 100644 --- a/Mutannot/Program.fs +++ b/Mutannot/Program.fs @@ -6,6 +6,19 @@ open Fli type MutationCase = { TestName: string; Patch: string } +let ensureCleanWorkingDirectory () = + let gitState = + cli { + Exec "git" + Arguments [ "status"; "--porcelain" ] + } + |> Command.execute + |> Output.throwIfErrored + + if gitState.Text <> None then + eprintfn "Uncommitted changes. Refusing to run." + exit 2 + let ensureBuilt projectPath = cli { Exec "dotnet" @@ -70,20 +83,10 @@ let main argv = eprintfn "Usage: mutannot " exit 1 + ensureCleanWorkingDirectory () + let projectPath = argv[0] - let gitState = - cli { - Exec "git" - Arguments [ "status"; "--porcelain" ] - } - |> Command.execute - |> Output.throwIfErrored - - if gitState.Text <> None then - eprintfn "Uncommitted changes. Refusing to run." - exit 2 - for mutationCase in getMutationCases projectPath do printfn "%s" <| mutationCase.ToString() -- 2.51.2 From c93f87d2823ee795bc9a755c093949bf64790f77 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Tue, 12 May 2026 08:32:11 +0200 Subject: [PATCH 11/23] Apply the mutations --- Mutannot/Program.fs | 40 ++++++++++++++++++++++++++++++++++++++-- 1 file changed, 38 insertions(+), 2 deletions(-) diff --git a/Mutannot/Program.fs b/Mutannot/Program.fs index 5c3f6be..d3d9f06 100644 --- a/Mutannot/Program.fs +++ b/Mutannot/Program.fs @@ -19,6 +19,25 @@ let ensureCleanWorkingDirectory () = eprintfn "Uncommitted changes. Refusing to run." exit 2 +let applyPatch patch = + cli { + Exec "git" + Arguments [ "apply"; "-" ] + Input patch + } + |> Command.execute + |> Output.throwIfErrored + |> ignore + +let restore () = + cli { + Exec "git" + Arguments [ "restore"; "--staged"; "--worktree"; "." ] + } + |> Command.execute + |> Output.throwIfErrored + |> ignore + let ensureBuilt projectPath = cli { Exec "dotnet" @@ -51,6 +70,19 @@ let getMetadataLoadContext (assemblyPath: string) = new MetadataLoadContext(pathAssemblyResolver, typeof.Assembly.GetName().Name) +let unindented (s: string) = + let lines = s.Split([| "\r\n"; "\n" |], StringSplitOptions.None) + + let indexOfFirstNonEmptyLine = + lines |> Array.findIndex (not << String.IsNullOrWhiteSpace) + + let identantionOfFirstNonEmptyLine = + lines[indexOfFirstNonEmptyLine] |> Seq.takeWhile Char.IsWhiteSpace |> Seq.length + + lines[indexOfFirstNonEmptyLine..] + |> Seq.map (fun line -> line.Substring(min identantionOfFirstNonEmptyLine line.Length)) + |> String.concat Environment.NewLine + let getMutationCases projectPath = ensureBuilt projectPath @@ -73,7 +105,7 @@ let getMutationCases projectPath = | "Mutannot.MutationCaseAttribute" -> Some { TestName = $"{m.DeclaringType.FullName}.{m.Name}" - Patch = attr.ConstructorArguments[0].Value :?> string } + Patch = attr.ConstructorArguments[0].Value :?> string |> unindented } | _ -> None)) |> Seq.toList @@ -85,9 +117,13 @@ let main argv = ensureCleanWorkingDirectory () + AppDomain.CurrentDomain.ProcessExit.Add(fun _ -> restore ()) + let projectPath = argv[0] for mutationCase in getMutationCases projectPath do - printfn "%s" <| mutationCase.ToString() + printfn "MUTATION\n\n%s" <| mutationCase.Patch + applyPatch mutationCase.Patch + restore () 0 -- 2.51.2 From bd7f0e70e1673ccec890bfa86c928c9af007601e Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Tue, 12 May 2026 08:36:28 +0200 Subject: [PATCH 12/23] Run the test after mutating --- Mutannot/Program.fs | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/Mutannot/Program.fs b/Mutannot/Program.fs index d3d9f06..13666be 100644 --- a/Mutannot/Program.fs +++ b/Mutannot/Program.fs @@ -48,6 +48,15 @@ let ensureBuilt projectPath = |> Output.throwIfErrored |> ignore +let runTest projectPath testName = + cli { + Exec "dotnet" + Arguments [ "test"; projectPath; "--filter"; $"FullyQualifiedName={testName}" ] + Output(new StreamWriter(Console.OpenStandardOutput())) + } + |> Command.execute + |> ignore + let getAssemblyPath projectPath = cli { Exec "dotnet" @@ -124,6 +133,7 @@ let main argv = for mutationCase in getMutationCases projectPath do printfn "MUTATION\n\n%s" <| mutationCase.Patch applyPatch mutationCase.Patch + runTest projectPath mutationCase.TestName restore () 0 -- 2.51.2 From 627e7f76a5ab50b15ca7b75f35d34b1212fc7699 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Tue, 12 May 2026 08:41:29 +0200 Subject: [PATCH 13/23] Remove skills --- skills/maintain-mutations/SKILL.md | 18 ------------------ skills/write-mutations/SKILL.md | 25 ------------------------- 2 files changed, 43 deletions(-) delete mode 100644 skills/maintain-mutations/SKILL.md delete mode 100644 skills/write-mutations/SKILL.md 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 <...>`. -- 2.51.2 From 5a521e7bfca4f62ec32b378c893887f8168f9fc2 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Tue, 12 May 2026 08:45:31 +0200 Subject: [PATCH 14/23] Actually check if the mutant was killed --- Mutannot/Program.fs | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/Mutannot/Program.fs b/Mutannot/Program.fs index 13666be..41dcf33 100644 --- a/Mutannot/Program.fs +++ b/Mutannot/Program.fs @@ -55,7 +55,7 @@ let runTest projectPath testName = Output(new StreamWriter(Console.OpenStandardOutput())) } |> Command.execute - |> ignore + |> Output.toExitCode let getAssemblyPath projectPath = cli { @@ -133,7 +133,13 @@ let main argv = for mutationCase in getMutationCases projectPath do printfn "MUTATION\n\n%s" <| mutationCase.Patch applyPatch mutationCase.Patch - runTest projectPath mutationCase.TestName + + match runTest projectPath mutationCase.TestName with + | 0 -> + eprintfn "Expected tested to fail, but it succeeded" + exit 3 + | _ -> printfn "Mutant killed\n" + restore () 0 -- 2.51.2 From 63d0219e9e1db601c1d6f006a09528ab5bcdb494 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Tue, 12 May 2026 16:02:33 +0200 Subject: [PATCH 15/23] unindented -> unindentPatch --- Mutannot/Program.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Mutannot/Program.fs b/Mutannot/Program.fs index 41dcf33..872fc25 100644 --- a/Mutannot/Program.fs +++ b/Mutannot/Program.fs @@ -79,7 +79,7 @@ let getMetadataLoadContext (assemblyPath: string) = new MetadataLoadContext(pathAssemblyResolver, typeof.Assembly.GetName().Name) -let unindented (s: string) = +let unindentPatch (s: string) = let lines = s.Split([| "\r\n"; "\n" |], StringSplitOptions.None) let indexOfFirstNonEmptyLine = @@ -114,7 +114,7 @@ let getMutationCases projectPath = | "Mutannot.MutationCaseAttribute" -> Some { TestName = $"{m.DeclaringType.FullName}.{m.Name}" - Patch = attr.ConstructorArguments[0].Value :?> string |> unindented } + Patch = attr.ConstructorArguments[0].Value :?> string |> unindentPatch } | _ -> None)) |> Seq.toList -- 2.51.2 From ae246d3f36373fd534e576f5f02ce8065f3b6f2a Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Tue, 12 May 2026 16:14:35 +0200 Subject: [PATCH 16/23] Improve console output a lot --- Mutannot/Program.fs | 33 ++++++++++++++++++++++++++++----- 1 file changed, 28 insertions(+), 5 deletions(-) diff --git a/Mutannot/Program.fs b/Mutannot/Program.fs index 872fc25..15ba0f2 100644 --- a/Mutannot/Program.fs +++ b/Mutannot/Program.fs @@ -121,7 +121,7 @@ let getMutationCases projectPath = [] let main argv = if argv.Length <> 1 then - eprintfn "Usage: mutannot " + eprintf "Usage: mutannot \n" exit 1 ensureCleanWorkingDirectory () @@ -130,16 +130,39 @@ let main argv = let projectPath = argv[0] - for mutationCase in getMutationCases projectPath do - printfn "MUTATION\n\n%s" <| mutationCase.Patch + for index, mutationCase in getMutationCases projectPath |> Seq.indexed do + Console.ForegroundColor <- ConsoleColor.Green + printf $"MUTATION {index + 1}\n" + + Console.ForegroundColor <- ConsoleColor.Magenta + printf "Test:\n" + Console.ResetColor() + printf "%s\n\n" mutationCase.TestName + + Console.ForegroundColor <- ConsoleColor.Magenta + printf "Patch:\n" + Console.ResetColor() + printf "%s\n" mutationCase.Patch + + Console.ForegroundColor <- ConsoleColor.Magenta + printf "Output:\n" + Console.ResetColor() applyPatch mutationCase.Patch match runTest projectPath mutationCase.TestName with | 0 -> - eprintfn "Expected tested to fail, but it succeeded" + Console.ForegroundColor <- ConsoleColor.Red + eprintf "ERROR: Expected tested to fail, but it succeeded\n" + Console.ResetColor() exit 3 - | _ -> printfn "Mutant killed\n" + | _ -> + Console.ForegroundColor <- ConsoleColor.Green + printf "✓ Mutant killed\n\n" restore () + Console.ForegroundColor <- ConsoleColor.Green + printf "Success: All mutants killed\n" + Console.ResetColor() + 0 -- 2.51.2 From 294b2f85a962bcecc31c140aa17f280d7bef4088 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Tue, 12 May 2026 16:24:19 +0200 Subject: [PATCH 17/23] Add Argu for argument parsing --- Mutannot/Mutannot.fsproj | 1 + Mutannot/Program.fs | 19 ++++++++++++++----- 2 files changed, 15 insertions(+), 5 deletions(-) diff --git a/Mutannot/Mutannot.fsproj b/Mutannot/Mutannot.fsproj index 7c6381b..396d322 100644 --- a/Mutannot/Mutannot.fsproj +++ b/Mutannot/Mutannot.fsproj @@ -11,6 +11,7 @@ + diff --git a/Mutannot/Program.fs b/Mutannot/Program.fs index 15ba0f2..0153b3f 100644 --- a/Mutannot/Program.fs +++ b/Mutannot/Program.fs @@ -3,6 +3,7 @@ open System.IO open System.Reflection open System.Runtime.InteropServices open Fli +open Argu type MutationCase = { TestName: string; Patch: string } @@ -118,18 +119,26 @@ let getMutationCases projectPath = | _ -> None)) |> Seq.toList +type Arguments = + | [] ProjectPath of ProjectPath: string + + interface IArgParserTemplate with + member s.Usage = + match s with + | ProjectPath _ -> "path/to/project.csproj|fsproj" + [] let main argv = - if argv.Length <> 1 then - eprintf "Usage: mutannot \n" - exit 1 + let parsedArguments = + ArgumentParser.Create(programName = "mutannot") + |> _.ParseCommandLine(argv) + + let projectPath = parsedArguments.GetResult ProjectPath ensureCleanWorkingDirectory () AppDomain.CurrentDomain.ProcessExit.Add(fun _ -> restore ()) - let projectPath = argv[0] - for index, mutationCase in getMutationCases projectPath |> Seq.indexed do Console.ForegroundColor <- ConsoleColor.Green printf $"MUTATION {index + 1}\n" -- 2.51.2 From 500b3f0d8ce74c0d4f61c573f67fcf2ad89a7b96 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Tue, 12 May 2026 16:30:23 +0200 Subject: [PATCH 18/23] Introduce --validateonly --- Mutannot/Program.fs | 34 ++++++++++++++++++++++------------ 1 file changed, 22 insertions(+), 12 deletions(-) diff --git a/Mutannot/Program.fs b/Mutannot/Program.fs index 0153b3f..e77c630 100644 --- a/Mutannot/Program.fs +++ b/Mutannot/Program.fs @@ -121,11 +121,13 @@ let getMutationCases projectPath = type Arguments = | [] ProjectPath of ProjectPath: string + | ValidateOnly interface IArgParserTemplate with member s.Usage = match s with | ProjectPath _ -> "path/to/project.csproj|fsproj" + | ValidateOnly -> "check if the patches apply, but don't run the mutations" [] let main argv = @@ -134,6 +136,7 @@ let main argv = |> _.ParseCommandLine(argv) let projectPath = parsedArguments.GetResult ProjectPath + let validateOnly = parsedArguments.Contains ValidateOnly ensureCleanWorkingDirectory () @@ -153,25 +156,32 @@ let main argv = Console.ResetColor() printf "%s\n" mutationCase.Patch - Console.ForegroundColor <- ConsoleColor.Magenta - printf "Output:\n" - Console.ResetColor() applyPatch mutationCase.Patch - match runTest projectPath mutationCase.TestName with - | 0 -> - Console.ForegroundColor <- ConsoleColor.Red - eprintf "ERROR: Expected tested to fail, but it succeeded\n" + if not validateOnly then + Console.ForegroundColor <- ConsoleColor.Magenta + printf "Output:\n" Console.ResetColor() - exit 3 - | _ -> - Console.ForegroundColor <- ConsoleColor.Green - printf "✓ Mutant killed\n\n" + + 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" restore () Console.ForegroundColor <- ConsoleColor.Green - printf "Success: All mutants killed\n" + + if validateOnly then + printf "Success: All mutantions valid\n" + else + printf "Success: All mutants killed\n" + Console.ResetColor() 0 -- 2.51.2 From 9ff53f18035b14ba208dfcf1ef0f6cb3532d730b Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Tue, 12 May 2026 16:31:05 +0200 Subject: [PATCH 19/23] Remove unnecessary functions in example --- Example.Tests/Calculator.fs | 8 +------- Example.Tests/CalculatorTests.fs | 10 ++-------- 2 files changed, 3 insertions(+), 15 deletions(-) diff --git a/Example.Tests/Calculator.fs b/Example.Tests/Calculator.fs index cfcce3b..030e391 100644 --- a/Example.Tests/Calculator.fs +++ b/Example.Tests/Calculator.fs @@ -1,10 +1,4 @@ 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) + let addOne value = value - 1 diff --git a/Example.Tests/CalculatorTests.fs b/Example.Tests/CalculatorTests.fs index 0a96e10..1555082 100644 --- a/Example.Tests/CalculatorTests.fs +++ b/Example.Tests/CalculatorTests.fs @@ -8,20 +8,14 @@ type CalculatorTests() = [] [= right then left - right else right - left - - member _.AddOne_increments() = - Assert.Equal(42, Calculator.addOne 41) """)>] member _.AddOne_increments() = Assert.Equal(42, Calculator.addOne 41) -- 2.51.2 From de5843a783c26a60e62f0a0ad10d5b82252b034c Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Tue, 12 May 2026 16:34:08 +0200 Subject: [PATCH 20/23] Simplify Example --- {Example.Tests => Example}/Calculator.fs | 2 +- {Example.Tests => Example}/CalculatorTests.fs | 8 ++++---- .../Example.Tests.fsproj => Example/Example.fsproj | 0 {Example.Tests => Example}/MutationCaseAttribute.fs | 0 4 files changed, 5 insertions(+), 5 deletions(-) rename {Example.Tests => Example}/Calculator.fs (54%) rename {Example.Tests => Example}/CalculatorTests.fs (67%) rename Example.Tests/Example.Tests.fsproj => Example/Example.fsproj (100%) rename {Example.Tests => Example}/MutationCaseAttribute.fs (100%) diff --git a/Example.Tests/Calculator.fs b/Example/Calculator.fs similarity index 54% rename from Example.Tests/Calculator.fs rename to Example/Calculator.fs index 030e391..6f0c515 100644 --- a/Example.Tests/Calculator.fs +++ b/Example/Calculator.fs @@ -1,4 +1,4 @@ namespace Example module Calculator = - let addOne value = value - 1 + let addOne value = value + 1 diff --git a/Example.Tests/CalculatorTests.fs b/Example/CalculatorTests.fs similarity index 67% rename from Example.Tests/CalculatorTests.fs rename to Example/CalculatorTests.fs index 1555082..9029f0e 100644 --- a/Example.Tests/CalculatorTests.fs +++ b/Example/CalculatorTests.fs @@ -1,4 +1,4 @@ -namespace Example.Tests +namespace Example open Example open Mutannot @@ -7,10 +7,10 @@ open Xunit type CalculatorTests() = [] [ Date: Tue, 12 May 2026 16:38:47 +0200 Subject: [PATCH 21/23] Introduce --filter --- Mutannot/Program.fs | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/Mutannot/Program.fs b/Mutannot/Program.fs index e77c630..118570e 100644 --- a/Mutannot/Program.fs +++ b/Mutannot/Program.fs @@ -121,12 +121,14 @@ let getMutationCases projectPath = type Arguments = | [] ProjectPath of ProjectPath: string + | Filter of SearchString: string | ValidateOnly 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" [] @@ -137,12 +139,18 @@ let main argv = let projectPath = parsedArguments.GetResult ProjectPath let validateOnly = parsedArguments.Contains ValidateOnly + let maybeFilter = parsedArguments.TryGetResult Filter ensureCleanWorkingDirectory () AppDomain.CurrentDomain.ProcessExit.Add(fun _ -> restore ()) - for index, mutationCase in getMutationCases projectPath |> Seq.indexed do + let filteredMutations = + getMutationCases projectPath + |> Seq.filter _.Patch.Contains(maybeFilter |> Option.defaultValue "") + |> Seq.indexed + + for index, mutationCase in filteredMutations do Console.ForegroundColor <- ConsoleColor.Green printf $"MUTATION {index + 1}\n" -- 2.51.2 From cf8f914df01f7dbc5aed346bb10a7d3365f727a1 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Tue, 12 May 2026 16:44:42 +0200 Subject: [PATCH 22/23] Update deps.json --- Mutannot/deps.json | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) create mode 100644 Mutannot/deps.json 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=" + } +] -- 2.51.2 From c13b257083911b08c0c593c6f79bc73b88641361 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Tue, 12 May 2026 16:47:24 +0200 Subject: [PATCH 23/23] nix stuff --- .gitignore | 3 +++ Mutannot/deps.nix | 8 -------- flake.nix | 2 +- 3 files changed, 4 insertions(+), 9 deletions(-) delete mode 100644 Mutannot/deps.nix 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/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.nix b/flake.nix index f3fe06f..f72685d 100644 --- a/flake.nix +++ b/flake.nix @@ -27,7 +27,7 @@ version = "0.1.0"; src = ./Mutannot; projectFile = "Mutannot.fsproj"; - nugetDeps = ./Mutannot/deps.nix; + nugetDeps = ./Mutannot/deps.json; executables = [ "mutannot" ]; dotnet-sdk = pkgs.dotnet-sdk_10; dotnet-runtime = pkgs.dotnet-sdk_10; -- 2.51.2