diff --git a/workspace/Program.fs b/workspace/Program.fs index bc3db46..25a9342 100644 --- a/workspace/Program.fs +++ b/workspace/Program.fs @@ -1,16 +1,18 @@ open System -open NUnit.Engine open System.Reflection open System.Xml open System.Globalization +open NUnit.Engine + +type TestResult = Unknown | Passed | Failed + [] let main argv = - let GetAttribute (node: XmlNode) (name: string): string option = match node with | null -> None - | elem -> match node.Attributes.[name] with + | elem -> match elem.Attributes.[name] with | null -> None | a -> Some(a.Value) @@ -27,7 +29,15 @@ let main argv = let escapeLF(s: string): string = s.Replace(Environment.NewLine, "<:LF:>") - let OnTestCase(testCase: XmlNode) = + let GetSuiteResult (testResults: TestResult seq) = + let GetResultScore (result: TestResult): int = + match result with + | Passed -> 0 + | Unknown -> 1 + | Failed -> 2 + if Seq.isEmpty testResults then Unknown else Seq.maxBy GetResultScore testResults + + let OnTestCase(testCase: XmlNode): TestResult = GetDescription testCase |> Option.orElse (GetAttribute testCase "name") @@ -38,77 +48,94 @@ let main argv = |> Option.ofObj |> Option.iter (fun node -> printfn "%s" node.InnerText) - match GetAttribute testCase "result" with - | Some("Passed") -> printfn "\nTest Passed" - | Some("Failed") -> - let label = GetAttribute testCase "label" - let message = Option.ofObj <| testCase.SelectSingleNode "failure/message" - match label with - | Some("Error") -> - message - |> Option.map (fun m -> escapeLF(m.InnerText)) - |> Option.defaultValue "Unknown Error" - |> printfn "\n%s" - - testCase.SelectSingleNode "failure/stack-trace" - |> Option.ofObj - |> Option.iter (fun node -> printfn "\n%s" node.InnerText) - | _ -> - message - |> Option.map (fun msg -> "<:LF:>" + escapeLF msg.InnerText) - |> Option.defaultValue "" - |> printfn "\nTest Failed%s" - | _ -> () + let testCaseResult = + match GetAttribute testCase "result" with + | Some("Passed") -> + printfn "\nTest Passed" + Passed + | Some("Failed") -> + let label = GetAttribute testCase "label" + let message = Option.ofObj <| testCase.SelectSingleNode "failure/message" + match label with + | Some("Error") -> + message + |> Option.map (fun m -> escapeLF(m.InnerText)) + |> Option.defaultValue "Unknown Error" + |> printfn "\n%s" + + testCase.SelectSingleNode "failure/stack-trace" + |> Option.ofObj + |> Option.iter (fun node -> printfn "\n%s" node.InnerText) + | _ -> + message + |> Option.map (fun msg -> "<:LF:>" + escapeLF msg.InnerText) + |> Option.defaultValue "" + |> printfn "\nTest Failed%s" + Failed + | _ -> Unknown WriteCompletedIn testCase + testCaseResult - - let rec OnTestSuiteTestFixture(testFixture: XmlNode) = - + let rec OnTestSuiteTestFixture(testFixture: XmlNode): TestResult = GetDescription testFixture |> Option.orElse (GetAttribute testFixture "name") |> Option.defaultValue "" |> printfn "\n%s" - for child in testFixture.ChildNodes do - match child.Name with - | "test-suite" -> - match GetAttribute child "type" with - | Some("ParameterizedMethod" | "GenericMethod") -> OnTestSuiteTestFixture(child) - | _ -> () - | "test-case" -> OnTestCase(child) - | _ -> () - WriteCompletedIn(testFixture); - - let rec OnTestSuiteTestSuite(testSuite: XmlNode) = + let suiteResult = + testFixture.ChildNodes + |> Seq.cast |> Seq.toList + |> List.map (fun child -> + match child.Name with + | "test-suite" -> + match GetAttribute child "type" with + | Some("ParameterizedMethod" | "GenericMethod") -> OnTestSuiteTestFixture(child) + | _ -> Passed + | "test-case" -> OnTestCase(child) + | _ -> Passed ) + |> GetSuiteResult + WriteCompletedIn(testFixture) + suiteResult + + let rec OnTestSuiteTestSuite(testSuite: XmlNode): TestResult = GetDescription testSuite |> Option.orElse (GetAttribute testSuite "name") |> Option.defaultValue "" |> printfn "\n%s" - for child in testSuite.SelectNodes "test-suite" do - match GetAttribute child "type" with - | Some("TestFixture") -> OnTestSuiteTestFixture(child) - | _ -> OnTestSuiteTestSuite(child) + let suiteResult = + testSuite.SelectNodes "test-suite" + |> Seq.cast |> Seq.toList + |> List.map (fun child -> + match GetAttribute child "type" with + | Some("TestFixture") -> OnTestSuiteTestFixture(child) + | _ -> OnTestSuiteTestSuite(child) ) + |> GetSuiteResult + + WriteCompletedIn(testSuite) - WriteCompletedIn(testSuite); + suiteResult - let OnTestSuiteAssembly(testSuite: XmlNode) = - for child in testSuite.SelectNodes "test-suite" do + let OnTestSuiteAssembly(testSuite: XmlNode): TestResult = + testSuite.SelectNodes "test-suite" + |> Seq.cast |> Seq.toList + |> List.map (fun child -> match GetAttribute child "type" with | Some("TestFixture") -> OnTestSuiteTestFixture(child) - | _ -> OnTestSuiteTestSuite(child) + | _ -> OnTestSuiteTestSuite(child) ) + |> GetSuiteResult + - let reportRun (reportNode: XmlNode) = + let reportRun (reportNode: XmlNode): TestResult = reportNode.SelectSingleNode "test-suite[@type = 'Assembly']" |> Option.ofObj - |> Option.iter OnTestSuiteAssembly + |> Option.map OnTestSuiteAssembly + |> Option.defaultValue Unknown let testpkg = new TestPackage (Assembly.GetExecutingAssembly().Location) let engine = new TestEngine() use runner = engine.GetRunner(testpkg) let reportNode = runner.Run(null, TestFilter.Empty) - // TODO Exit code - reportRun(reportNode) - 0 + if reportRun(reportNode) = Passed then 0 else 1