From 07cdb478a22f7863706a5e485e89da7e01c56691 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Mon, 27 Apr 2026 23:10:17 +0200 Subject: [PATCH 1/6] Make it possible to pass in the project path --- verify-coverage-mutants.fsx | 95 ++++++++++++++++++++++++++++++------- 1 file changed, 77 insertions(+), 18 deletions(-) diff --git a/verify-coverage-mutants.fsx b/verify-coverage-mutants.fsx index ed5f988..67e0c90 100644 --- a/verify-coverage-mutants.fsx +++ b/verify-coverage-mutants.fsx @@ -2,6 +2,7 @@ open System open System.IO open System.Reflection open System.Diagnostics +open System.Xml.Linq type MutationCase = { Id: string @@ -24,13 +25,16 @@ type Command = type Options = { Configuration: string + ProjectPath: string option NoBuild: bool Command: Command } -let projectPath = "Example.Tests" -let targetFramework = "net10.0" -let projectDirectory = "example-tests" -let testProjectPath = Path.Combine(projectDirectory, "Example.Tests", "Example.Tests.fsproj") +type ProjectInfo = + { RelativeProjectPath: string + AbsoluteProjectPath: string + ProjectDirectory: string + AssemblyName: string + TargetFramework: string } let fail message = eprintfn "%s" message @@ -80,26 +84,81 @@ let makeRelativePath (path: string) = if Path.IsPathRooted path then Path.GetRelativePath(repoRoot, path) else path let parseArgs (args: string list) = - let rec loop configuration noBuild remaining = + let rec loop configuration projectPath noBuild remaining = match remaining with - | [] -> { Configuration = configuration; NoBuild = noBuild; Command = Run [] } - | "--configuration" :: value :: tail -> loop value noBuild tail - | "--no-build" :: tail -> loop configuration true tail - | "--list" :: tail when tail.IsEmpty -> { Configuration = configuration; NoBuild = noBuild; Command = List } - | "--show" :: id :: tail when tail.IsEmpty -> { Configuration = configuration; NoBuild = noBuild; Command = Show id } - | "--run" :: tail -> { Configuration = configuration; NoBuild = noBuild; Command = Run tail } - | value :: tail when not (value.StartsWith "--") -> { Configuration = configuration; NoBuild = noBuild; Command = Run (value :: tail) } - | _ -> fail "Usage: dotnet fsi verify-coverage-mutants.fsx [--configuration Debug|Release] [--no-build] [--list | --show | --run [id...]]" - loop "Debug" false args + | [] -> { Configuration = configuration; ProjectPath = projectPath; NoBuild = noBuild; Command = Run [] } + | "--configuration" :: value :: tail -> loop value projectPath noBuild tail + | "--project" :: value :: tail -> loop configuration (Some value) noBuild tail + | "--no-build" :: tail -> loop configuration projectPath true tail + | "--list" :: tail when tail.IsEmpty -> { Configuration = configuration; ProjectPath = projectPath; NoBuild = noBuild; Command = List } + | "--show" :: id :: tail when tail.IsEmpty -> { Configuration = configuration; ProjectPath = projectPath; NoBuild = noBuild; Command = Show id } + | "--run" :: tail -> { Configuration = configuration; ProjectPath = projectPath; NoBuild = noBuild; Command = Run tail } + | value :: tail when not (value.StartsWith "--") -> { Configuration = configuration; ProjectPath = projectPath; NoBuild = noBuild; Command = Run (value :: tail) } + | _ -> fail "Usage: dotnet fsi verify-coverage-mutants.fsx [--project ] [--configuration Debug|Release] [--no-build] [--list | --show | --run [id...]]" + loop "Debug" None false args 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 not (File.Exists absoluteProjectPath) then + fail $"Project file not found: {absoluteProjectPath}" + + let relativeProjectPath = ensureWithinRepo absoluteProjectPath + let projectDirectory = Path.GetDirectoryName relativeProjectPath + let document = XDocument.Load absoluteProjectPath + + let tryGetProperty name = + document.Descendants() + |> Seq.tryPick (fun element -> + if element.Name.LocalName = name then + let value = element.Value.Trim() + if String.IsNullOrWhiteSpace value then None else Some value + else + None) + + let targetFramework = + match tryGetProperty "TargetFramework" with + | Some value -> value + | None -> + match tryGetProperty "TargetFrameworks" with + | Some value -> + value.Split(';', StringSplitOptions.RemoveEmptyEntries) + |> Array.tryHead + |> Option.map _.Trim() + |> Option.defaultWith (fun () -> fail $"Could not determine TargetFramework from {relativeProjectPath}") + | None -> fail $"Could not determine TargetFramework from {relativeProjectPath}" + + let assemblyName = + tryGetProperty "AssemblyName" + |> Option.defaultValue (Path.GetFileNameWithoutExtension absoluteProjectPath) + + { RelativeProjectPath = relativeProjectPath + AbsoluteProjectPath = absoluteProjectPath + ProjectDirectory = projectDirectory + AssemblyName = assemblyName + TargetFramework = targetFramework } + +let project = + match options.ProjectPath with + | Some projectPath -> loadProjectInfo projectPath + | None -> fail "Missing required --project ." + let assemblyPath = - Path.Combine(repoRoot, projectDirectory, "Example.Tests", "bin", options.Configuration, targetFramework, "Example.Tests.dll") + Path.Combine(repoRoot, project.ProjectDirectory, "bin", options.Configuration, project.TargetFramework, project.AssemblyName + ".dll") let ensureBuilt () = if not options.NoBuild then - let exitCode = runProcess repoRoot "dotnet" [ "build"; testProjectPath; "--configuration"; options.Configuration; "--nologo" ] + let exitCode = runProcess repoRoot "dotnet" [ "build"; project.RelativeProjectPath; "--configuration"; options.Configuration; "--nologo" ] if exitCode <> 0 then fail "dotnet build failed." if not (File.Exists assemblyPath) then fail $"Compiled test assembly not found at {assemblyPath}." @@ -209,7 +268,7 @@ let runMutation (mutation: MutationCase) = printfn "==> %s: %s" mutation.Id mutation.TestName let buildExitCode = - runProcess worktreePath "dotnet" [ "build"; testProjectPath; "--configuration"; options.Configuration; "--nologo" ] + runProcess worktreePath "dotnet" [ "build"; project.RelativeProjectPath; "--configuration"; options.Configuration; "--nologo" ] let outcome = if buildExitCode <> 0 then @@ -217,7 +276,7 @@ let runMutation (mutation: MutationCase) = BuildFailed else let testExitCode = - runProcess worktreePath "dotnet" [ "test"; testProjectPath; "--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 From 28ae18b48004a7ed707e84e4cee3af2f86e1a894 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Mon, 27 Apr 2026 23:11:09 +0200 Subject: [PATCH 2/6] Move up Example.Tests a level --- .../Example.Tests => Example.Tests}/Calculator.fs | 0 .../Example.Tests => Example.Tests}/CalculatorTests.fs | 6 +++--- .../Example.Tests => Example.Tests}/Example.Tests.fsproj | 0 .../MutationCaseAttribute.fs | 0 4 files changed, 3 insertions(+), 3 deletions(-) rename {example-tests/Example.Tests => Example.Tests}/Calculator.fs (100%) rename {example-tests/Example.Tests => Example.Tests}/CalculatorTests.fs (55%) rename {example-tests/Example.Tests => Example.Tests}/Example.Tests.fsproj (100%) rename {example-tests/Example.Tests => Example.Tests}/MutationCaseAttribute.fs (100%) diff --git a/example-tests/Example.Tests/Calculator.fs b/Example.Tests/Calculator.fs similarity index 100% rename from example-tests/Example.Tests/Calculator.fs rename to Example.Tests/Calculator.fs diff --git a/example-tests/Example.Tests/CalculatorTests.fs b/Example.Tests/CalculatorTests.fs similarity index 55% rename from example-tests/Example.Tests/CalculatorTests.fs rename to Example.Tests/CalculatorTests.fs index f05ee54..40f9b66 100644 --- a/example-tests/Example.Tests/CalculatorTests.fs +++ b/Example.Tests/CalculatorTests.fs @@ -6,17 +6,17 @@ open Xunit type CalculatorTests() = [] - [] + [] member _.AddOne_increments() = Assert.Equal(42, Calculator.addOne 41) [] - [] + [] member _.AbsoluteDifference_preserves_order() = Assert.Equal(7, Calculator.absoluteDifference 10 3) [] - [ 0", "year % 100 = 0")>] + [ 0", "year % 100 = 0")>] member _.LeapYear_handles_centuries() = Assert.True(Calculator.isLeapYear 2000) Assert.False(Calculator.isLeapYear 1900) diff --git a/example-tests/Example.Tests/Example.Tests.fsproj b/Example.Tests/Example.Tests.fsproj similarity index 100% rename from example-tests/Example.Tests/Example.Tests.fsproj rename to Example.Tests/Example.Tests.fsproj diff --git a/example-tests/Example.Tests/MutationCaseAttribute.fs b/Example.Tests/MutationCaseAttribute.fs similarity index 100% rename from example-tests/Example.Tests/MutationCaseAttribute.fs rename to Example.Tests/MutationCaseAttribute.fs From 678deb8fd9fb5b428b3b96e91b02cf4c803cf1c6 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Mon, 27 Apr 2026 23:15:16 +0200 Subject: [PATCH 3/6] Simplify target path discovery --- verify-coverage-mutants.fsx | 54 +++++++++---------------------------- 1 file changed, 12 insertions(+), 42 deletions(-) diff --git a/verify-coverage-mutants.fsx b/verify-coverage-mutants.fsx index 67e0c90..0d775d0 100644 --- a/verify-coverage-mutants.fsx +++ b/verify-coverage-mutants.fsx @@ -2,7 +2,6 @@ open System open System.IO open System.Reflection open System.Diagnostics -open System.Xml.Linq type MutationCase = { Id: string @@ -31,10 +30,7 @@ type Options = type ProjectInfo = { RelativeProjectPath: string - AbsoluteProjectPath: string - ProjectDirectory: string - AssemblyName: string - TargetFramework: string } + AbsoluteProjectPath: string } let fail message = eprintfn "%s" message @@ -80,9 +76,6 @@ let repoRoot = if exitCode <> 0 then fail stderr stdout.Trim() -let makeRelativePath (path: string) = - if Path.IsPathRooted path then Path.GetRelativePath(repoRoot, path) else path - let parseArgs (args: string list) = let rec loop configuration projectPath noBuild remaining = match remaining with @@ -114,47 +107,24 @@ let loadProjectInfo (projectPath: string) = fail $"Project file not found: {absoluteProjectPath}" let relativeProjectPath = ensureWithinRepo absoluteProjectPath - let projectDirectory = Path.GetDirectoryName relativeProjectPath - let document = XDocument.Load absoluteProjectPath - - let tryGetProperty name = - document.Descendants() - |> Seq.tryPick (fun element -> - if element.Name.LocalName = name then - let value = element.Value.Trim() - if String.IsNullOrWhiteSpace value then None else Some value - else - None) - - let targetFramework = - match tryGetProperty "TargetFramework" with - | Some value -> value - | None -> - match tryGetProperty "TargetFrameworks" with - | Some value -> - value.Split(';', StringSplitOptions.RemoveEmptyEntries) - |> Array.tryHead - |> Option.map _.Trim() - |> Option.defaultWith (fun () -> fail $"Could not determine TargetFramework from {relativeProjectPath}") - | None -> fail $"Could not determine TargetFramework from {relativeProjectPath}" - - let assemblyName = - tryGetProperty "AssemblyName" - |> Option.defaultValue (Path.GetFileNameWithoutExtension absoluteProjectPath) - { RelativeProjectPath = relativeProjectPath - AbsoluteProjectPath = absoluteProjectPath - ProjectDirectory = projectDirectory - AssemblyName = assemblyName - TargetFramework = targetFramework } + AbsoluteProjectPath = absoluteProjectPath } let project = match options.ProjectPath with | Some projectPath -> loadProjectInfo projectPath | None -> fail "Missing required --project ." -let assemblyPath = - Path.Combine(repoRoot, project.ProjectDirectory, "bin", options.Configuration, project.TargetFramework, project.AssemblyName + ".dll") +let targetPathForProject (workingDirectory: string) (projectPath: string) = + let exitCode, stdout, stderr = + captureProcess workingDirectory "dotnet" [ "msbuild"; projectPath; "--getProperty:TargetPath"; $"-property:Configuration={options.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 ensureBuilt () = if not options.NoBuild then From 544e4366f42e01cfce079b39e8db0328d38557bb Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Mon, 27 Apr 2026 23:16:48 +0200 Subject: [PATCH 4/6] Make script executable --- verify-coverage-mutants.fsx | 1 + 1 file changed, 1 insertion(+) mode change 100644 => 100755 verify-coverage-mutants.fsx diff --git a/verify-coverage-mutants.fsx b/verify-coverage-mutants.fsx old mode 100644 new mode 100755 index 0d775d0..b3074ba --- a/verify-coverage-mutants.fsx +++ b/verify-coverage-mutants.fsx @@ -1,3 +1,4 @@ +#!/usr/bin/env -S dotnet fsi open System open System.IO open System.Reflection From ce48b67d131055b9976d5e698229206b674d209f Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Mon, 27 Apr 2026 23:20:12 +0200 Subject: [PATCH 5/6] Add build args --- verify-coverage-mutants.fsx | 32 +++++++++++++++++++------------- 1 file changed, 19 insertions(+), 13 deletions(-) diff --git a/verify-coverage-mutants.fsx b/verify-coverage-mutants.fsx index b3074ba..81e9b3c 100755 --- a/verify-coverage-mutants.fsx +++ b/verify-coverage-mutants.fsx @@ -26,6 +26,7 @@ type Command = type Options = { Configuration: string ProjectPath: string option + BuildArgs: string list NoBuild: bool Command: Command } @@ -78,18 +79,19 @@ let repoRoot = stdout.Trim() let parseArgs (args: string list) = - let rec loop configuration projectPath noBuild remaining = + let rec loop configuration projectPath buildArgs noBuild remaining = match remaining with - | [] -> { Configuration = configuration; ProjectPath = projectPath; NoBuild = noBuild; Command = Run [] } - | "--configuration" :: value :: tail -> loop value projectPath noBuild tail - | "--project" :: value :: tail -> loop configuration (Some value) noBuild tail - | "--no-build" :: tail -> loop configuration projectPath true tail - | "--list" :: tail when tail.IsEmpty -> { Configuration = configuration; ProjectPath = projectPath; NoBuild = noBuild; Command = List } - | "--show" :: id :: tail when tail.IsEmpty -> { Configuration = configuration; ProjectPath = projectPath; NoBuild = noBuild; Command = Show id } - | "--run" :: tail -> { Configuration = configuration; ProjectPath = projectPath; NoBuild = noBuild; Command = Run tail } - | value :: tail when not (value.StartsWith "--") -> { Configuration = configuration; ProjectPath = projectPath; NoBuild = noBuild; Command = Run (value :: tail) } - | _ -> fail "Usage: dotnet fsi verify-coverage-mutants.fsx [--project ] [--configuration Debug|Release] [--no-build] [--list | --show | --run [id...]]" - loop "Debug" None false args + | [] -> { Configuration = configuration; ProjectPath = projectPath; BuildArgs = List.rev buildArgs; NoBuild = noBuild; Command = Run [] } + | "--configuration" :: value :: tail -> loop value projectPath buildArgs noBuild tail + | "--project" :: value :: tail -> loop configuration (Some value) 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) } + | _ -> fail "Usage: dotnet fsi verify-coverage-mutants.fsx [--project ] [--configuration Debug|Release] [--build-arg ...] [--no-build] [--list | --show | --run [id...]]" + loop "Debug" None [] false args let options = parseArgs (fsi.CommandLineArgs |> Array.skip 1 |> Array.toList) @@ -127,9 +129,13 @@ let targetPathForProject (workingDirectory: string) (projectPath: string) = let assemblyPath = targetPathForProject repoRoot project.AbsoluteProjectPath +let buildArgs projectPath = + [ "build"; projectPath; "--configuration"; options.Configuration; "--nologo" ] + @ options.BuildArgs + let ensureBuilt () = if not options.NoBuild then - let exitCode = runProcess repoRoot "dotnet" [ "build"; project.RelativeProjectPath; "--configuration"; options.Configuration; "--nologo" ] + let exitCode = runProcess repoRoot "dotnet" (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}." @@ -239,7 +245,7 @@ let runMutation (mutation: MutationCase) = printfn "==> %s: %s" mutation.Id mutation.TestName let buildExitCode = - runProcess worktreePath "dotnet" [ "build"; project.RelativeProjectPath; "--configuration"; options.Configuration; "--nologo" ] + runProcess worktreePath "dotnet" (buildArgs project.RelativeProjectPath) let outcome = if buildExitCode <> 0 then From 91ab96815460c403bbf4c1a22d2e338b2bcf35e9 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Mon, 27 Apr 2026 23:23:20 +0200 Subject: [PATCH 6/6] Make the project a positional argument --- verify-coverage-mutants.fsx | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/verify-coverage-mutants.fsx b/verify-coverage-mutants.fsx index 81e9b3c..0c68461 100755 --- a/verify-coverage-mutants.fsx +++ b/verify-coverage-mutants.fsx @@ -25,7 +25,7 @@ type Command = type Options = { Configuration: string - ProjectPath: string option + ProjectPath: string BuildArgs: string list NoBuild: bool Command: Command } @@ -79,19 +79,24 @@ let repoRoot = stdout.Trim() let parseArgs (args: string list) = + let usage () = + fail "Usage: verify-coverage-mutants.fsx [--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 - | "--project" :: value :: tail -> loop configuration (Some value) 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) } - | _ -> fail "Usage: dotnet fsi verify-coverage-mutants.fsx [--project ] [--configuration Debug|Release] [--build-arg ...] [--no-build] [--list | --show | --run [id...]]" - loop "Debug" None [] false args + | _ -> 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) @@ -114,9 +119,7 @@ let loadProjectInfo (projectPath: string) = AbsoluteProjectPath = absoluteProjectPath } let project = - match options.ProjectPath with - | Some projectPath -> loadProjectInfo projectPath - | None -> fail "Missing required --project ." + loadProjectInfo options.ProjectPath let targetPathForProject (workingDirectory: string) (projectPath: string) = let exitCode, stdout, stderr =