Support .NET versions different than Mutannots

This commit is contained in:
Sven van Heugten 2026-05-12 06:20:26 +02:00
parent 5b7150d297
commit 79a4a9a40f
No known key found for this signature in database
GPG key ID: D612F88666F4F660
2 changed files with 65 additions and 29 deletions

View file

@ -9,4 +9,8 @@
<ItemGroup>
<Compile Include="Program.fs" />
</ItemGroup>
<ItemGroup>
<PackageReference Include="System.Reflection.MetadataLoadContext" Version="9.0.1" />
</ItemGroup>
</Project>

View file

@ -1,4 +1,5 @@
open System
open System.Collections.Generic
open System.Diagnostics
open System.IO
open System.Reflection
@ -197,48 +198,79 @@ let ensureBuilt options project assemblyPath =
if not (File.Exists assemblyPath) then
fail $"Compiled test assembly not found at {assemblyPath}."
let installAssemblyResolver (assemblyPath: string) =
let requireConstructorArgumentString (args: IList<CustomAttributeTypedArgument>) index name =
match args[index].Value with
| :? string as value when not (isNull value) -> value
| null -> fail $"MutationCaseAttribute constructor argument '{name}' must not be null."
| value ->
fail
$"MutationCaseAttribute constructor argument '{name}' had unexpected type '{value.GetType().FullName}'."
let requireConstructorArgumentInt32 (args: IList<CustomAttributeTypedArgument>) index name =
match args[index].Value with
| :? int as value -> value
| null -> fail $"MutationCaseAttribute constructor argument '{name}' must not be null."
| value ->
fail
$"MutationCaseAttribute constructor argument '{name}' had unexpected type '{value.GetType().FullName}'."
let metadataLoadContextPaths (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)
let runtimeAssemblies =
match AppContext.GetData "TRUSTED_PLATFORM_ASSEMBLIES" with
| :? string as value when not (String.IsNullOrWhiteSpace value) ->
value.Split(Path.PathSeparator, StringSplitOptions.RemoveEmptyEntries)
| _ -> fail "Unable to discover trusted platform assemblies for MetadataLoadContext."
if File.Exists candidate then
Assembly.LoadFrom candidate
else
null)
)
let localAssemblies =
seq {
yield assemblyPath
yield! Directory.EnumerateFiles(assemblyDir, "*.dll")
yield! Directory.EnumerateFiles(assemblyDir, "*.exe")
}
Seq.append runtimeAssemblies localAssemblies
|> Seq.distinct
|> Seq.toArray
let createMetadataLoadContext (assemblyPath: string) =
let resolver = PathAssemblyResolver(metadataLoadContextPaths assemblyPath)
let coreAssemblyName = typeof<obj>.Assembly.GetName().Name
new MetadataLoadContext(resolver, coreAssemblyName)
let mutationCases options project assemblyPath =
ensureBuilt options project assemblyPath
installAssemblyResolver assemblyPath
let asm = Assembly.LoadFrom assemblyPath
use mlc = createMetadataLoadContext assemblyPath
let asm = mlc.LoadFromAssemblyPath assemblyPath
asm.GetTypes()
|> Array.collect (fun t ->
t.GetMethods(BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Static ||| BindingFlags.Instance)
|> Array.collect (fun m ->
m.GetCustomAttributesData()
|> 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
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
t.GetMethods(BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Static ||| BindingFlags.Instance)
|> Array.collect (fun m ->
m.GetCustomAttributesData()
|> Seq.choose (fun attr ->
if attr.AttributeType.FullName <> "Mutannot.MutationCaseAttribute" then
None
else
let args = attr.ConstructorArguments
if args.Count <> 5 then
fail $"Unexpected MutationCaseAttribute shape on {declaringType}.{m.Name}"
Some
{ Id = requireConstructorArgumentString args 0 "id"
File = requireConstructorArgumentString args 1 "file"
Line = requireConstructorArgumentInt32 args 2 "line"
Find = requireConstructorArgumentString args 3 "find"
Replace = requireConstructorArgumentString args 4 "replace"
TestName = m.Name
DeclaringType = declaringType })
|> Seq.toArray))