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.fsx b/Mutannot/Program.fs old mode 100755 new mode 100644 similarity index 56% rename from mutannot.fsx rename to Mutannot/Program.fs index 93c2c13..6f8d0e9 --- a/mutannot.fsx +++ b/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 - 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 [--configuration Debug|Release] [--build-arg ...] [--no-build] [--list | --show | --run [id...]]" + 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 = 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 -> - 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 () + 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) @@ -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 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 = 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,35 +400,55 @@ let runMutation (mutation: MutationCase) = File.WriteAllText(targetFile, originalText) outcome -let mutations = mutationCases () - -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) -| Show id -> - let mutation = findMutation id mutations - printMutation mutation -| Run ids -> - let requested = - match ids with - | [] -> mutations |> Array.toList - | _ -> ids |> List.map (fun id -> findMutation id mutations) - +[] +let main argv = try - createWorktree () - let outcomes = - requested - |> 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." - else - fail $"{survivors} mutant(s) survived. {buildFailures} mutant(s) failed to build." - finally - cleanup () + 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/README.md b/README.md index 85ee564..223b9ed 100644 --- a/README.md +++ b/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 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 + ]; + }; + } + ); + }; +}