Skip to content

Commit

Permalink
Add support for multiple inputs (#18)
Browse files Browse the repository at this point in the history
  • Loading branch information
@safesparrow
safesparrow authored Sep 13, 2022
1 parent b84bea7 commit 10a847b
Show file tree
Hide file tree
Showing 3 changed files with 144 additions and 70 deletions.
186 changes: 122 additions & 64 deletions Generate.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,7 @@ open System.Reflection
open System.Runtime.CompilerServices
open System.Security.Cryptography
open System.Text.RegularExpressions
open System.Threading
open FCSBenchmark.Common.Dtos
open CommandLine
open FCSBenchmark.Generator.FCSCheckouts
Expand Down Expand Up @@ -91,12 +92,16 @@ let private withRedirectedConsole<'a> (f : unit -> 'a) =
Console.SetOut (originalError)
res, (out.ToString (), error.ToString ())

let mutable private msbuildRegistered = false

let registerMSBuild () =
Microsoft.Build.Locator.MSBuildLocator.RegisterDefaults () |> ignore

[<MethodImpl(MethodImplOptions.NoInlining)>]
let private doLoadOptions (toolsPath : ToolsPath) (sln : string) =
// TODO allow customization of build properties
let props = []
let loader = WorkspaceLoader.Create (toolsPath, props)
let _ = Microsoft.Build.Locator.MSBuildLocator.RegisterDefaults ()

let projects, _ =
fun () -> loader.LoadSln (sln, [], BinaryLogGeneration.Off) |> Seq.toList
Expand Down Expand Up @@ -129,6 +134,8 @@ let private loadOptions (sln : string) =
use _ = LogContext.PushProperty ("step", "LoadOptions")
log.Verbose ("Constructing FSharpProjectOptions from {sln}", sln)
let toolsPath = init sln
printfn "236523"
Thread.Sleep (500)
doLoadOptions toolsPath sln

let private generateInputs (case : BenchmarkCase) (codeRoot : string) =
Expand Down Expand Up @@ -274,24 +281,26 @@ type DisposableTempDir() =
member this.Dir = dir

let inputsBaseDir (config : Config) =
Path.Combine(config.BaseDir, "__inputs")
Path.Combine (config.BaseDir, "__inputs")

let md5 (file : string) =
use md5 = MD5.Create()
use stream = File.OpenRead(file)
let bytes = md5.ComputeHash(stream)
BitConverter.ToString(bytes).Replace("-", "").ToLowerInvariant()
use md5 = MD5.Create ()
use stream = File.OpenRead (file)
let bytes = md5.ComputeHash (stream)
BitConverter.ToString(bytes).Replace("-", "").ToLowerInvariant ()

let inputsHashPath (inputsPath : string) =
Path.Combine(Path.GetDirectoryName(inputsPath), Path.GetFileNameWithoutExtension(inputsPath) + ".hash")
Path.Combine (Path.GetDirectoryName (inputsPath), Path.GetFileNameWithoutExtension (inputsPath) + ".hash")

let buildInputsDict (config : Config) =
let dir = inputsBaseDir config
Directory.EnumerateFiles(dir, "*.fcsinputs.json")

Directory.EnumerateFiles (dir, "*.fcsinputs.json")
|> Seq.choose (fun f ->
let hashPath = inputsHashPath f

if File.Exists hashPath then
let hash = File.ReadAllText(hashPath)
let hash = File.ReadAllText (hashPath)
(hash, f) |> Some
else
None
Expand All @@ -303,13 +312,14 @@ let getOrGenerateInputs (config : Config) (casePath : string) (case : BenchmarkC
Directory.CreateDirectory inputsBaseDir |> ignore
let cache = buildInputsDict config
let caseMD5 = md5 casePath
log.Information("Hash: {hash}", caseMD5)
log.Information ("Hash: {hash}", caseMD5)

match cache.TryGetValue caseMD5 with
| true, cachedInputsPath ->
log.Information("Using cached generated inputs in {path}", cachedInputsPath)
log.Information ("Using cached generated inputs in {path}", cachedInputsPath)
cachedInputsPath
| false, _ ->

let inputs = generateInputs case absoluteCodebasePath
let inputsPath = makeInputsPath inputsBaseDir
log.Information ("Serializing inputs as {inputsPath}", inputsPath)
Expand All @@ -318,12 +328,12 @@ let getOrGenerateInputs (config : Config) (casePath : string) (case : BenchmarkC
let hashPath = inputsHashPath inputsPath
log.Information ("Serializing hash {hash} as {hashPath}", caseMD5, hashPath)
Directory.CreateDirectory (Path.GetDirectoryName hashPath) |> ignore
File.WriteAllText(hashPath, caseMD5)
File.WriteAllText (hashPath, caseMD5)
inputsPath

let private prepareAndRun
(config : Config)
(casePath : string, case : BenchmarkCase)
(casePaths : (string * BenchmarkCase) list)
(dryRun : bool)
(cleanup : bool)
(iterations : int)
Expand All @@ -333,13 +343,17 @@ let private prepareAndRun
(gcMode : GCMode)
(versions : NuGetFCSVersion list)
=
let codebase = prepareCodebase config case

let binDir =
Path.GetDirectoryName (Assembly.GetAssembly(typeof<BenchmarkCase>).Location)

let absoluteCodebasePath = toAbsolutePath binDir codebase.Path
let inputsPath = getOrGenerateInputs config casePath case absoluteCodebasePath
let inputs =
casePaths
|> List.map (fun (path, case) ->
let codebase = prepareCodebase config case
let absoluteCodebasePath = toAbsolutePath binDir codebase.Path
let inputsPath = getOrGenerateInputs config path case absoluteCodebasePath
inputsPath, codebase
)

if dryRun = false then
use _ = LogContext.PushProperty ("step", "Run")
Expand Down Expand Up @@ -390,6 +404,9 @@ let private prepareAndRun

o + " " + l

let inputsArgs =
inputs |> List.map fst |> (fun paths -> "--input " + String.Join (" ", paths))

let otelStr = if recordOtelJaeger then "--record-otel-jaeger" else ""
let parallelAnalysisStr = $"--parallel-analysis={parallelAnalysisMode}"
let gcModeStr = $"--gc={gcMode}"
Expand All @@ -398,7 +415,7 @@ let private prepareAndRun
Path.Combine (Environment.CurrentDirectory, "FCSBenchmark.Artifacts")

let args =
$"run -c Release -- --artifacts-path={artifactsPath} --input={inputsPath} --iterations={iterations} --warmups={warmups} {otelStr} {parallelAnalysisStr} {gcModeStr} {versionsArgs}"
$"run -c Release -- --artifacts-path={artifactsPath} {inputsArgs} --iterations={iterations} --warmups={warmups} {otelStr} {parallelAnalysisStr} {gcModeStr} {versionsArgs}"
.Trim ()

let env =
Expand All @@ -423,27 +440,45 @@ let private prepareAndRun
else
log.Information ("Not running the benchmark as requested")

match codebase, cleanup with
| Local _, _ -> ()
| Git _, false -> ()
| Git repo, true ->
log.Information ("Cleaning up checked out git repo {repoPath} as requested", repo.Info.Path)
Directory.Delete repo.Info.Path
if cleanup then
let gitCodebases =
inputs
|> List.map snd
|> List.choose (
function
| Git repo -> Some repo
| _ -> None
)

match gitCodebases with
| [] -> ()
| gitCodebases ->
log.Information ("Cleaning up checked out git repos as requested:")

gitCodebases
|> List.iter (fun codebase ->
let path = codebase.Info.Path
log.Information ($"- {path}")
Directory.Delete path
)

type Args =
{
[<CommandLine.Option('c', "checkouts", Default = ".artifacts", HelpText = "Base directory for git checkouts")>]
CheckoutsDir : string
[<CommandLine.Option("forceFcsBuild",
Default = false,
HelpText = "Force build git-sourced FCS versions even if the binaries already exist")>]
HelpText = "Force-build git-sourced FCS versions even if the binaries already exist")>]
ForceFCSBuild : bool
[<CommandLine.Option('i', SetName = "input", HelpText = "Path to the input file describing the benchmark.")>]
Input : string
[<CommandLine.Option('i',
SetName = "input",
HelpText = "Path to the input file describing the benchmark. Supports multiple values.")>]
Input : string seq
[<CommandLine.Option("sample",
SetName = "input",
HelpText = "Use a predefined sample benchmark with the given name")>]
SampleInput : string
HelpText =
"Use a predefined sample benchmark with the given name. Supports multiple values.")>]
SampleInput : string seq
[<CommandLine.Option("dry-run",
HelpText =
"If set, prepares the benchmark and prints the commandline to run it, then exits")>]
Expand Down Expand Up @@ -518,41 +553,58 @@ let readSampleInput (sampleName : string) =
else
failwith $"Samples directory '{dir}' does not exist"

let prepareCase (args : Args) : string * BenchmarkCase =
let prepareCases (args : Args) : (string * BenchmarkCase) list =
use _ = LogContext.PushProperty ("step", "Read input")

try
let path =
match args.Input |> Option.ofObj, args.SampleInput |> Option.ofObj with
| None, None -> failwith $"No input specified"
| Some input, _ -> input
| None, Some sample -> readSampleInput sample

log.Verbose ("Read and deserialize inputs from {path}", path)
let paths =
let regular = args.Input |> Seq.toList
let samples = args.SampleInput |> Seq.map readSampleInput |> Seq.toList
let paths = samples @ regular

match paths with
| [] -> failwith $"No input specified"
| paths -> paths

let pathsString =
paths
|> List.map (fun path -> $"- {path}")
|> fun l -> String.Join (Environment.NewLine, l)

log.Verbose (
"Read and deserialize inputs from {count} paths: "
+ Environment.NewLine
+ pathsString,
paths.Length
)

path
|> File.ReadAllText
|> JsonConvert.DeserializeObject<BenchmarkCase>
|> fun case ->
let defaultCodebasePrep =
[
{
CodebasePrepStep.Command = "dotnet"
CodebasePrepStep.Args =
$"msbuild /t:Restore /p:RestoreUseStaticGraphEvaluation=true {case.SlnRelative}"
paths
|> List.map (fun path ->
path
|> File.ReadAllText
|> JsonConvert.DeserializeObject<BenchmarkCase>
|> fun case ->
let defaultCodebasePrep =
[
{
CodebasePrepStep.Command = "dotnet"
CodebasePrepStep.Args =
$"msbuild /t:Restore /p:RestoreUseStaticGraphEvaluation=true {case.SlnRelative}"
}
]

let codebasePrep =
match obj.ReferenceEquals (case.CodebasePrep, null) with
| true -> defaultCodebasePrep
| false -> case.CodebasePrep

let case =
{ case with
CodebasePrep = codebasePrep
}
]

let codebasePrep =
match obj.ReferenceEquals (case.CodebasePrep, null) with
| true -> defaultCodebasePrep
| false -> case.CodebasePrep

let case =
{ case with
CodebasePrep = codebasePrep
}
path, case
path, case
)
with e ->
let msg = $"Failed to read inputs file: {e.Message}"
log.Fatal (msg)
Expand Down Expand Up @@ -591,6 +643,8 @@ let prepareFCSVersions (config : Config) (raw : FCSVersionsArgs) =
| versions -> versions

let run (args : Args) : unit =
registerMSBuild ()

log <-
LoggerConfiguration()
.Enrich.FromLogContext()
Expand Down Expand Up @@ -624,13 +678,13 @@ let run (args : Args) : unit =
}

let versions = prepareFCSVersions config rawVersions
let case = prepareCase args
let cases = prepareCases args

use _ = LogContext.PushProperty ("step", "PrepareAndRun")

prepareAndRun
config
case
cases
args.DryRun
args.Cleanup
args.Iterations
Expand All @@ -648,6 +702,10 @@ let run (args : Args) : unit =
[<EntryPoint>]
[<MethodImpl(MethodImplOptions.NoInlining)>]
let main args =
let parseResult = Parser.Default.ParseArguments<Args> args
parseResult.WithParsed (run) |> ignore
if parseResult.Tag = ParserResultType.Parsed then 0 else 1
try
let parseResult = Parser.Default.ParseArguments<Args> args
parseResult.WithParsed (run) |> ignore
if parseResult.Tag = ParserResultType.Parsed then 0 else 1
with ex ->
log.Error (ex, "Failure.")
1
19 changes: 14 additions & 5 deletions Runner/Runner.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -117,7 +117,9 @@ type Benchmark() =

static member InputEnvironmentVariable = "FcsBenchmarkInput"
static member OtelEnvironmentVariable = "FcsBenchmarkRecordOtelJaeger"
static member BenchmarkParallelProjectsAnalysisEnvironmentVariable = "FCS_PARALLEL_PROJECTS_ANALYSIS"

static member BenchmarkParallelProjectsAnalysisEnvironmentVariable =
"FCS_PARALLEL_PROJECTS_ANALYSIS"

member _.SetupTelemetry () =
let useTracing =
Expand Down Expand Up @@ -340,7 +342,7 @@ let private makeConfig (versions : NuGetFCSVersion list) (args : RunnerArgs) : I
let baseJob =
Job.Dry.WithWarmupCount(args.Warmups).WithIterationCount (args.Iterations)

let inputs = args.Input |> Seq.toList
let inputs = args.Input |> Seq.toList |> List.mapi (fun i x -> i, x)

let parallelAnalysisModes =
match args.ParallelAnalysis with
Expand Down Expand Up @@ -373,11 +375,11 @@ let private makeConfig (versions : NuGetFCSVersion list) (args : RunnerArgs) : I

let jobs =
combinations
|> List.mapi (fun i (((input, (versionName, refs)), parallelAnalysisMode), gcMode) ->
|> List.mapi (fun i ((((inputIdx, input), (versionName, refs)), parallelAnalysisMode), gcMode) ->
let useServerGc = gcMode = GCMode.Server

let jobName =
$"fcs={versionName}_parallel={parallelAnalysisMode}_serverGc={useServerGc}"
$"fcs={versionName}_input=#{inputIdx}_parallel={parallelAnalysisMode}_serverGc={useServerGc}"

let job =
baseJob
Expand Down Expand Up @@ -448,4 +450,11 @@ let main args =

match result with
| :? Parsed<RunnerArgs> as parsed -> runStandard parsed.Value
| _ -> failwith "Parse error"
| :? NotParsed<RunnerArgs> as notParsed ->
let errorsString =
notParsed.Errors
|> Seq.map (fun e -> e.ToString ())
|> fun lines -> String.Join (Environment.NewLine, lines)

failwith $"Parse errors: {errorsString}"
| _ -> failwith "Unexpected result type"
9 changes: 8 additions & 1 deletion Utils.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,9 +3,16 @@ module FCSBenchmark.Generator.Utils

open System.Collections.Generic
open System.Diagnostics
open System.Threading
open Serilog.Events

let runProcess name args workingDir (envVariables : (string * string) list) (outputLogLevel : LogEventLevel) =
let runProcess
(name : string)
(args : string)
workingDir
(envVariables : (string * string) list)
(outputLogLevel : LogEventLevel)
=
let info = ProcessStartInfo ()
info.WindowStyle <- ProcessWindowStyle.Hidden
info.Arguments <- args
Expand Down

0 comments on commit 10a847b

Please sign in to comment.