From 07cdb478a22f7863706a5e485e89da7e01c56691 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Mon, 27 Apr 2026 23:10:17 +0200 Subject: [PATCH] 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