Package

Mutannot/Mutannot.fsproj

@@ -0,0 +1,12 @@
+<Project Sdk="Microsoft.NET.Sdk">
+  <PropertyGroup>
+    <OutputType>Exe</OutputType>
+    <TargetFramework>net10.0</TargetFramework>
+    <AssemblyName>mutannot</AssemblyName>
+    <ImplicitUsings>false</ImplicitUsings>
+  </PropertyGroup>
+
+  <ItemGroup>
+    <Compile Include="Program.fs" />
+  </ItemGroup>
+</Project>

Mutannot/Program.fs

@@ -1,8 +1,9 @@
-#!/usr/bin/env -S dotnet fsi
 open System
+open System.Diagnostics
 open System.IO
 open System.Reflection
-open System.Diagnostics
+
+exception UserError of string
 
 type MutationCase =
     { Id: string
@@ -35,9 +36,7 @@ type ProjectInfo =
       AbsoluteProjectPath: string }
 
 let fail message =
-    eprintfn "%s" message
+    raise (UserError message)
-    Environment.Exit 1
-    Unchecked.defaultof<_>
 
 let runProcess (workingDirectory: string) (exe: string) (args: string list) =
     let psi = ProcessStartInfo()
@@ -46,12 +45,16 @@ let runProcess (workingDirectory: string) (exe: string) (args: string list) =
     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
 
@@ -62,98 +65,151 @@ let captureProcess (workingDirectory: string) (exe: string) (args: string list)
     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" ]
+    let exitCode, stdout, stderr =
-    if exitCode <> 0 then fail 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.fsx <path/to/project.fsproj> [--configuration Debug|Release] [--build-arg <value> ...] [--no-build] [--list | --show <id> | --run [id...]]"
+        fail "Usage: mutannot <path/to/project.fsproj> [--configuration Debug|Release] [--build-arg <value> ...] [--no-build] [--list | --show <id> | --run [id...]]"
 
     let rec loop configuration projectPath buildArgs noBuild remaining =
         match remaining with
-        | [] -> { Configuration = configuration; ProjectPath = projectPath; BuildArgs = List.rev buildArgs; NoBuild = noBuild; Command = Run [] }
+        | [] ->
+            { Configuration = 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 }
+        | "--list" :: tail when tail.IsEmpty ->
-        | "--show" :: id :: tail when tail.IsEmpty -> { Configuration = configuration; ProjectPath = projectPath; BuildArgs = List.rev buildArgs; NoBuild = noBuild; Command = Show id }
+            { Configuration = configuration
-        | "--run" :: tail -> { Configuration = configuration; ProjectPath = projectPath; BuildArgs = List.rev buildArgs; NoBuild = noBuild; Command = Run tail }
+              ProjectPath = projectPath
-        | value :: tail when not (value.StartsWith "--") -> { Configuration = configuration; ProjectPath = projectPath; BuildArgs = List.rev buildArgs; NoBuild = noBuild; Command = Run (value :: tail) }
+              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 options = parseArgs (fsi.CommandLineArgs |> Array.skip 1 |> Array.toList)
-
 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
+        if Path.IsPathRooted projectPath then
-        else Path.GetFullPath(Path.Combine(Environment.CurrentDirectory, projectPath))
+            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 project =
+let targetPathForProject (workingDirectory: string) (projectPath: string) (configuration: string) =
-    loadProjectInfo options.ProjectPath
-
-let targetPathForProject (workingDirectory: string) (projectPath: string) =
     let exitCode, stdout, stderr =
-        captureProcess workingDirectory "dotnet" [ "msbuild"; projectPath; "--getProperty:TargetPath"; $"-property:Configuration={options.Configuration}" ]
+        captureProcess
-    if exitCode <> 0 then fail stderr
+            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 assemblyPath = targetPathForProject repoRoot project.AbsoluteProjectPath
+let buildArgs configuration extraArgs projectPath =
+    [ "build"; projectPath; "--configuration"; configuration; "--nologo" ] @ extraArgs
 
-let buildArgs projectPath =
+let ensureBuilt options project assemblyPath =
-    [ "build"; projectPath; "--configuration"; options.Configuration; "--nologo" ]
-    @ options.BuildArgs
-
-let ensureBuilt () =
     if not options.NoBuild then
-        let exitCode = runProcess repoRoot "dotnet" (buildArgs project.RelativeProjectPath)
+        let exitCode = runProcess repoRoot "dotnet" (buildArgs options.Configuration options.BuildArgs project.RelativeProjectPath)
-        if exitCode <> 0 then fail "dotnet build failed."
+
+        if exitCode <> 0 then
+            fail "dotnet build failed."
+
     if not (File.Exists assemblyPath) then
         fail $"Compiled test assembly not found at {assemblyPath}."
 
-let installAssemblyResolver () =
+let installAssemblyResolver (assemblyPath: string) =
     let assemblyDir = Path.GetDirectoryName assemblyPath
-    AppDomain.CurrentDomain.add_AssemblyResolve(ResolveEventHandler(fun _ args ->
+
+    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 () =
+            if File.Exists candidate then
-    ensureBuilt ()
+                Assembly.LoadFrom candidate
-    installAssemblyResolver ()
+            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)
@@ -162,14 +218,22 @@ let mutationCases () =
             |> 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
+
+                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<string> args[0].Value
                   File = unbox<string> args[1].Value
                   Line = unbox<int> args[2].Value
                   Find = unbox<string> args[3].Value
                   Replace = unbox<string> args[4].Value
                   TestName = m.Name
-                  DeclaringType = t.FullName })
+                  DeclaringType = declaringType })
             |> Seq.toArray))
     |> Array.sortBy (fun mutation -> mutation.Id)
 
@@ -197,6 +261,7 @@ let lineSpan (filePath: string) (text: string) (lineNumber: int) =
         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
 
@@ -220,66 +285,81 @@ let printMutation mutation =
     printfn "find: %s" mutation.Find
     printfn "replace: %s" mutation.Replace
 
-let tempRoot = Path.Combine(Path.GetTempPath(), $"fscheck-mutants.{Guid.NewGuid():N}")
-let worktreePath = Path.Combine(tempRoot, "worktree")
-let patchPath = Path.Combine(tempRoot, "current.patch")
-
 let splitNullSeparated (text: string) =
-    text.Split('\000', StringSplitOptions.RemoveEmptyEntries)
+    text.Split('\000', StringSplitOptions.RemoveEmptyEntries) |> Array.toList
-    |> 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" ]
+    let exitCode, stdout, stderr =
-    if exitCode <> 0 then fail stderr
+        captureProcess repoRoot "git" [ "ls-files"; "--others"; "--exclude-standard"; "-z" ]
+
+    if exitCode <> 0 then
+        fail stderr
+
     splitNullSeparated stdout
 
-let copyFileIntoWorktree (relativePath: string) =
+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 () =
+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 () =
+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
+
+    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()
 
+    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 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
+
+        if exitCode4 <> 0 then
+            fail stderr4
 
     for relativePath in untrackedFiles do
-        copyFileIntoWorktree relativePath
+        copyFileIntoWorktree repoRoot worktreePath relativePath
 
 let fullyQualifiedTestName mutation =
     let declaringType = mutation.DeclaringType.Replace('+', '.')
     $"{declaringType}.{mutation.TestName}"
 
-let testFilter mutation = $"FullyQualifiedName={fullyQualifiedTestName mutation}"
+let testFilter mutation =
+    $"FullyQualifiedName={fullyQualifiedTestName mutation}"
 
-let runMutation (mutation: MutationCase) =
+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}"
 
@@ -288,8 +368,9 @@ let runMutation (mutation: MutationCase) =
     File.WriteAllText(targetFile, mutatedText)
 
     printfn "==> %s: %s" mutation.Id mutation.TestName
+
     let buildExitCode =
-        runProcess worktreePath "dotnet" (buildArgs project.RelativeProjectPath)
+        runProcess worktreePath "dotnet" (buildArgs options.Configuration options.BuildArgs project.RelativeProjectPath)
 
     let outcome =
         if buildExitCode <> 0 then
@@ -297,7 +378,17 @@ let runMutation (mutation: MutationCase) =
             BuildFailed
         else
             let testExitCode =
-                runProcess worktreePath "dotnet" [ "test"; project.RelativeProjectPath; "--configuration"; options.Configuration; "--filter"; testFilter mutation; "--no-build"; "--nologo" ]
+                runProcess
+                    worktreePath
+                    "dotnet"
+                    [ "test"
+                      project.RelativeProjectPath
+                      "--configuration"
+                      options.Configuration
+                      "--filter"
+                      testFilter mutation
+                      "--no-build"
+                      "--nologo" ]
 
             if testExitCode = 0 then
                 printfn "SURVIVED  %s" mutation.Id
@@ -309,7 +400,13 @@ let runMutation (mutation: MutationCase) =
     File.WriteAllText(targetFile, originalText)
     outcome
 
-let mutations = mutationCases ()
+[<EntryPoint>]
+let main argv =
+    try
+        let options = parseArgs (argv |> Array.toList)
+        let project = loadProjectInfo options.ProjectPath
+        let assemblyPath = targetPathForProject repoRoot project.AbsoluteProjectPath options.Configuration
+        let mutations = mutationCases options project assemblyPath
 
         if Array.isEmpty mutations then
             fail "No mutation cases were discovered in the test assembly."
@@ -319,25 +416,39 @@ match options.Command with
             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 ()
+                createWorktree patchPath worktreePath
+
                 let outcomes =
-            requested
+                    requested |> List.map (runMutation options project worktreePath)
-            |> List.map runMutation
+
                 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 ()
+                cleanup tempRoot worktreePath
+    with
+    | UserError message ->
+        eprintfn "%s" message
+        1

Mutannot/deps.nix

@@ -0,0 +1,8 @@
+{ fetchNuGet }:
+[
+  (fetchNuGet {
+    pname = "FSharp.Core";
+    version = "10.1.201";
+    sha256 = "sha256-NzxdRJgL+5RQpUm8Y6Mc0w7sakxqThv6qHpP+u0x5x0=";
+  })
+]

README.md

@@ -2,6 +2,6 @@
 
 This allows you to annotate Xunit test cases with a mutation that should cause the test to fail.
 
-`mutannot.fsx` will apply each mutation and verify that the test actually fails.
+`mutannot` will apply each mutation and verify that the test actually fails.
 
 Current state: LLM-generated prototype

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
+}

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
+            ];
+          };
+        }
+      );
+    };
+}