diff --git a/Mutannot/Mutannot.fsproj b/Mutannot/Mutannot.fsproj
new file mode 100644
index 0000000..3329a09
--- /dev/null
+++ b/Mutannot/Mutannot.fsproj
@@ -0,0 +1,12 @@
+
+
+ Exe
+ net10.0
+ mutannot
+ false
+
+
+
+
+
+
diff --git a/Mutannot/Program.fs b/Mutannot/Program.fs
new file mode 100644
index 0000000..6f8d0e9
--- /dev/null
+++ b/Mutannot/Program.fs
@@ -0,0 +1,454 @@
+open System
+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 =
+ | 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] [--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
+ | "--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 installAssemblyResolver (assemblyPath: string) =
+ let assemblyDir = Path.GetDirectoryName assemblyPath
+
+ AppDomain.CurrentDomain.add_AssemblyResolve (
+ ResolveEventHandler(fun _ args ->
+ let name = AssemblyName(args.Name).Name + ".dll"
+ let candidate = Path.Combine(assemblyDir, name)
+
+ if File.Exists candidate then
+ Assembly.LoadFrom candidate
+ else
+ null)
+ )
+
+let mutationCases options project assemblyPath =
+ ensureBuilt options project assemblyPath
+ installAssemblyResolver assemblyPath
+
+ let asm = Assembly.LoadFrom assemblyPath
+
+ asm.GetTypes()
+ |> Array.collect (fun t ->
+ t.GetMethods(BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Static ||| BindingFlags.Instance)
+ |> Array.collect (fun m ->
+ m.GetCustomAttributesData()
+ |> Seq.filter (fun attr -> attr.AttributeType.FullName = "Mutannot.MutationCaseAttribute")
+ |> Seq.map (fun attr ->
+ let args = attr.ConstructorArguments
+
+ if args.Count <> 5 then
+ failwithf "Unexpected MutationCaseAttribute shape on %s.%s" t.FullName m.Name
+
+ let declaringType =
+ match t.FullName with
+ | null -> t.Name
+ | name -> name
+
+ { Id = unbox args[0].Value
+ File = unbox args[1].Value
+ Line = unbox args[2].Value
+ Find = unbox args[3].Value
+ Replace = unbox args[4].Value
+ 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 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
+ | 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 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
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
new file mode 100644
index 0000000..6908e25
--- /dev/null
+++ b/flake.lock
@@ -0,0 +1,27 @@
+{
+ "nodes": {
+ "nixpkgs": {
+ "locked": {
+ "lastModified": 1776877367,
+ "narHash": "sha256-EHq1/OX139R1RvBzOJ0aMRT3xnWyqtHBRUBuO1gFzjI=",
+ "owner": "NixOS",
+ "repo": "nixpkgs",
+ "rev": "0726a0ecb6d4e08f6adced58726b95db924cef57",
+ "type": "github"
+ },
+ "original": {
+ "owner": "NixOS",
+ "ref": "nixos-unstable",
+ "repo": "nixpkgs",
+ "type": "github"
+ }
+ },
+ "root": {
+ "inputs": {
+ "nixpkgs": "nixpkgs"
+ }
+ }
+ },
+ "root": "root",
+ "version": 7
+}
diff --git a/flake.nix b/flake.nix
new file mode 100644
index 0000000..16f31af
--- /dev/null
+++ b/flake.nix
@@ -0,0 +1,57 @@
+{
+ inputs = {
+ nixpkgs.url = "github:NixOS/nixpkgs/nixos-unstable";
+ };
+
+ 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);
+
+ 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 = forEachSystem (
+ _system: pkgs: {
+ default = pkgs.mkShell {
+ packages = [
+ pkgs.git
+ pkgs.dotnet-sdk_10
+ ];
+ };
+ }
+ );
+ };
+}