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

@@ -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 <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" :: 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<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 = 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
+
+[<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."
+
+        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

Mutannot/deps.nix

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

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