Skip to content

Report error code from a test run #1

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
kazk merged 1 commit into from
Nov 22, 2022
Merged

Report error code from a test run #1

Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
131 changes: 79 additions & 52 deletions workspace/Program.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -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

[<EntryPoint>]
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)

Expand All @@ -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")
Expand All @@ -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 "\n<PASSED::>Test 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<ERROR::>%s"

testCase.SelectSingleNode "failure/stack-trace"
|> Option.ofObj
|> Option.iter (fun node -> printfn "\n<LOG::-Stack Trace>%s" node.InnerText)
| _ ->
message
|> Option.map (fun msg -> "<:LF:>" + escapeLF msg.InnerText)
|> Option.defaultValue ""
|> printfn "\n<FAILED::>Test Failed%s"
| _ -> ()
let testCaseResult =
match GetAttribute testCase "result" with
| Some("Passed") ->
printfn "\n<PASSED::>Test 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<ERROR::>%s"

testCase.SelectSingleNode "failure/stack-trace"
|> Option.ofObj
|> Option.iter (fun node -> printfn "\n<LOG::-Stack Trace>%s" node.InnerText)
| _ ->
message
|> Option.map (fun msg -> "<:LF:>" + escapeLF msg.InnerText)
|> Option.defaultValue ""
|> printfn "\n<FAILED::>Test 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<DESCRIBE::>%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<XmlNode> |> 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<DESCRIBE::>%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<XmlElement> |> 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<XmlElement> |> 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