Args (#82)

WoofWare.NUnitTestRunner/Program.fs

@@ -16,26 +16,97 @@ type SetBaseDir (testDll : FileInfo) =
         member _.Dispose () =
             AppContext.SetData ("APP_CONTEXT_BASE_DIRECTORY", oldBaseDir)
 
+[<RequireQualifiedAccess>]
+type LogLevel =
+    | Nothing
+    | Verbose
+
+[<AutoOpen>]
+module Patterns =
+    let (|Key|_|) (start : string) (s : string) : string option =
+        if s.StartsWith (start + "=", StringComparison.Ordinal) then
+            s.Substring (start.Length + 1) |> Some
+        else
+            None
+
+type Args =
+    {
+        Dll : FileInfo
+        Trx : FileInfo option
+        Filter : Filter option
+        Logging : LogLevel
+        LevelOfParallelism : int option
+        Timeout : TimeSpan option
+    }
+
+    static member Parse (args : string list) : Args =
+        match args with
+        | [] -> failwith "The first arg must be a positional arg, the DLL to test."
+        | dll :: args ->
+
+        let rec go
+            (trx : FileInfo option)
+            (filter : Filter option)
+            (logging : LogLevel option)
+            (par : int option)
+            (timeout : TimeSpan option)
+            (args : string list)
+            =
+            match args with
+            | [] ->
+                {
+                    Dll = FileInfo dll
+                    Trx = trx
+                    Filter = filter
+                    Logging = logging |> Option.defaultValue LogLevel.Nothing
+                    LevelOfParallelism = par
+                    Timeout = timeout
+                }
+            | Key "--filter" filterStr :: rest
+            | "--filter" :: filterStr :: rest ->
+                match filter with
+                | Some _ -> failwith "Two conflicting filters; you can only specify --filter once"
+                | None -> go trx (Some (Filter.parse filterStr)) logging par timeout rest
+            | Key "--trx" trxStr :: rest
+            | "--trx" :: trxStr :: rest ->
+                match trx with
+                | Some _ -> failwith "Two conflicting TRX outputs; you can only specify --trx once"
+                | None -> go (Some (FileInfo trxStr)) filter logging par timeout rest
+            | Key "--verbose" verboseStr :: rest
+            | "--verbose" :: verboseStr :: rest ->
+                match logging with
+                | Some _ -> failwith "Two conflicting --verbose outputs; you can only specify --verbose once"
+                | None ->
+                    let verbose =
+                        if Boolean.Parse verboseStr then
+                            LogLevel.Verbose
+                        else
+                            LogLevel.Nothing
+
+                    go trx filter (Some verbose) par timeout rest
+            | Key "--parallelism" parStr :: rest
+            | "--parallelism" :: parStr :: rest ->
+                match par with
+                | Some _ -> failwith "Two conflicting --parallelism outputs; you can only specify --parallelism once"
+                | None -> go trx filter logging (Some (Int32.Parse parStr)) timeout rest
+            | Key "--timeout-seconds" timeoutStr :: rest
+            | "--timeout-seconds" :: timeoutStr :: rest ->
+                match timeout with
+                | Some _ ->
+                    failwith "Two conflicting --timeout-seconds outputs; you can only specify --timeout-seconds once"
+                | None -> go trx filter logging par (Some (TimeSpan.FromSeconds (Int32.Parse timeoutStr |> float))) rest
+            | k :: _rest -> failwith $"Unrecognised arg %s{k}"
+
+        go None None None None None args
 
 module Program =
     let main argv =
         let startTime = DateTimeOffset.Now
 
-        let testDll, filter, trxPath =
-            match argv |> List.ofSeq with
-            | [ dll ] -> FileInfo dll, None, None
-            | [ dll ; "--trx" ; trxPath ] -> FileInfo dll, None, Some (FileInfo trxPath)
-            | [ dll ; "--filter" ; filter ] -> FileInfo dll, Some (Filter.parse filter), None
-            | [ dll ; "--trx" ; trxPath ; "--filter" ; filter ] ->
-                FileInfo dll, Some (Filter.parse filter), Some (FileInfo trxPath)
-            | [ dll ; "--filter" ; filter ; "--trx" ; trxPath ] ->
-                FileInfo dll, Some (Filter.parse filter), Some (FileInfo trxPath)
-            | _ ->
-                failwith
-                    "provide exactly one arg, a test DLL; then optionally `--filter <filter>` and/or `--trx <output-filename>`."
+        let args = argv |> List.ofArray |> Args.Parse
 
         let filter =
-            match filter with
+            match args.Filter with
             | Some filter -> Filter.shouldRun filter
             | None -> fun _ _ -> true
 
@@ -46,12 +117,20 @@ module Program =
 
         let progress = Progress.spectre stderr
 
-        use _ = new SetBaseDir (testDll)
+        let runtime = DotnetRuntime.locate args.Dll
+
+        match args.Logging with
+        | LogLevel.Nothing -> ()
+        | LogLevel.Verbose ->
+            for d in runtime do
+                stderr.WriteLine $".NET runtime directory: %s{d.FullName}"
+
+        use _ = new SetBaseDir (args.Dll)
 
         use contexts = TestContexts.Empty ()
 
-        let ctx = LoadContext (testDll, DotnetRuntime.locate testDll, contexts)
-        let assy = ctx.LoadFromAssemblyPath testDll.FullName
+        let ctx = LoadContext (args.Dll, runtime, contexts)
+        let assy = ctx.LoadFromAssemblyPath args.Dll.FullName
 
         let levelOfParallelism, par =
             ((None, None), assy.CustomAttributes)
@@ -92,6 +171,20 @@ module Program =
                 | _ -> levelPar, par
             )
 
+        let levelOfParallelism =
+            match args.LevelOfParallelism, levelOfParallelism with
+            | None, None -> None
+            | Some taken, Some ignored ->
+                match args.Logging with
+                | LogLevel.Nothing -> ()
+                | LogLevel.Verbose ->
+                    stderr.WriteLine
+                        $"Taking parallelism %i{taken} from command line, ignoring value %i{ignored} from assembly"
+
+                Some taken
+            | Some x, None
+            | None, Some x -> Some x
+
         let testFixtures = assy.ExportedTypes |> Seq.map TestFixture.parse |> Seq.toList
 
         use par = new ParallelQueue (levelOfParallelism, par)
@@ -103,7 +196,12 @@ module Program =
             |> List.map (TestFixture.run contexts par progress filter)
             |> Task.WhenAll
 
-        if not (results.Wait (TimeSpan.FromHours 2.0)) then
+        let timeout =
+            match args.Timeout with
+            | None -> TimeSpan.FromHours 2.0
+            | Some t -> t
+
+        if not (results.Wait timeout) then
             failwith "Tests failed to terminate within two hours"
 
         let results = results.Result |> Seq.concat |> List.ofSeq
@@ -336,7 +434,7 @@ module Program =
                 ResultsSummary = resultSummary
             }
 
-        match trxPath with
+        match args.Trx with
         | Some trxPath ->
             let contents = TrxReport.toXml report |> fun d -> d.OuterXml
             trxPath.Directory.Create ()