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

Make it possible to pass in the project path

Browse source
This commit is contained in:
Sven van Heugten 2026-04-27 23:10:17 +02:00
parent b05c2dc0a2
commit 07cdb478a2
No known key found for this signature in database
GPG key ID: D612F88666F4F660
1 changed files with 77 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

95
verify-coverage-mutants.fsx
View file

@ -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 <id> | --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 <path/to/project.fsproj>] [--configuration Debug|Release] [--no-build] [--list | --show <id> | --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 <path/to/project.fsproj>."
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