svenvanheugten/mutannot
1
0
Fork 0
Code Issues Pull requests 1 Projects Releases Packages Wiki Activity Actions

Package

Browse source
This commit is contained in:
Sven van Heugten 2026-04-28 08:23:17 +02:00
parent c3bd4e1f55
commit 3313656db4
No known key found for this signature in database
GPG key ID: D612F88666F4F660
6 changed files with 309 additions and 94 deletions
Download patch file Download diff file Expand all files Collapse all files

12
Mutannot/Mutannot.fsproj Normal file
View file

@ -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>

241
mutannot.fsx → Mutannot/Program.fs Executable file → Normal file
View file

@ -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
Environment.Exit 1
Unchecked.defaultof<_>
raise (UserError message)
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" ]
if exitCode <> 0 then fail stderr
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.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 }
| "--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) }
| "--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 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
else Path.GetFullPath(Path.Combine(Environment.CurrentDirectory, projectPath))
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 project =
loadProjectInfo options.ProjectPath
let targetPathForProject (workingDirectory: string) (projectPath: string) =
let targetPathForProject (workingDirectory: string) (projectPath: string) (configuration: string) =
let exitCode, stdout, stderr =
captureProcess workingDirectory "dotnet" [ "msbuild"; projectPath; "--getProperty:TargetPath"; $"-property:Configuration={options.Configuration}" ]
if exitCode <> 0 then fail 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 assemblyPath = targetPathForProject repoRoot project.AbsoluteProjectPath
let buildArgs configuration extraArgs projectPath =
[ "build"; projectPath; "--configuration"; configuration; "--nologo" ] @ extraArgs
let buildArgs projectPath =
[ "build"; projectPath; "--configuration"; options.Configuration; "--nologo" ]
@ options.BuildArgs
let ensureBuilt () =
let ensureBuilt options project assemblyPath =
if not options.NoBuild then
let exitCode = runProcess repoRoot "dotnet" (buildArgs project.RelativeProjectPath)
if exitCode <> 0 then fail "dotnet build failed."
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 () =
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 () =
ensureBuilt ()
installAssemblyResolver ()
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)
@ -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)
|> Array.toList
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
let exitCode, stdout, 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
|> List.map runMutation
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 ()
cleanup tempRoot worktreePath
with
| UserError message ->
eprintfn "%s" message
1

8
Mutannot/deps.nix Normal file
View file

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

2
README.md
View file

@ -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

27
flake.lock generated Normal file
View file

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

57
flake.nix Normal file
View file

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