diff --git a/bin/update-from-templates b/bin/update-from-templates index abf01e6..085e414 100755 --- a/bin/update-from-templates +++ b/bin/update-from-templates @@ -18,7 +18,7 @@ vendor_hash=$(hash_dir templates/vendor) toolchain_hash=$(md5sum templates/lean-toolchain | cut -d' ' -f1) num_updated=0 -for exercise_dir in exercises/practice/*; do +for exercise_dir in exercises/{practice,concept}/*; do [[ -d "${exercise_dir}" ]] || continue # Update lean-toolchain diff --git a/exercises/practice/acronym/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/acronym/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/acronym/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/acronym/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/acronym/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/acronym/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/acronym/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/acronym/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/acronym/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/acronym/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/affine-cipher/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/affine-cipher/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/affine-cipher/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/affine-cipher/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/affine-cipher/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/affine-cipher/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/affine-cipher/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/affine-cipher/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/affine-cipher/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/affine-cipher/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/all-your-base/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/all-your-base/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/all-your-base/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/all-your-base/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/all-your-base/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/all-your-base/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/all-your-base/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/all-your-base/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/all-your-base/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/all-your-base/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/allergies/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/allergies/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/allergies/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/allergies/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/allergies/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/allergies/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/allergies/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/allergies/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/allergies/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/allergies/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/alphametics/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/alphametics/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/alphametics/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/alphametics/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/alphametics/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/alphametics/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/alphametics/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/alphametics/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/alphametics/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/alphametics/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/anagram/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/anagram/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/anagram/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/anagram/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/anagram/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/anagram/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/anagram/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/anagram/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/anagram/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/anagram/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/armstrong-numbers/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/armstrong-numbers/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/armstrong-numbers/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/armstrong-numbers/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/armstrong-numbers/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/armstrong-numbers/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/armstrong-numbers/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/armstrong-numbers/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/armstrong-numbers/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/armstrong-numbers/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/assemble/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/assemble/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/assemble/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/assemble/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/assemble/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/assemble/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/assemble/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/assemble/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/assemble/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/assemble/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/atbash-cipher/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/atbash-cipher/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/atbash-cipher/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/atbash-cipher/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/atbash-cipher/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/atbash-cipher/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/atbash-cipher/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/atbash-cipher/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/atbash-cipher/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/atbash-cipher/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/bank-account/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/bank-account/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/bank-account/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/bank-account/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/bank-account/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/bank-account/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/bank-account/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/bank-account/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/bank-account/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/bank-account/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/binary-search-tree/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/binary-search-tree/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/binary-search-tree/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/binary-search-tree/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/binary-search-tree/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/binary-search-tree/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/binary-search-tree/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/binary-search-tree/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/binary-search-tree/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/binary-search-tree/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/binary-search/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/binary-search/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/binary-search/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/binary-search/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/binary-search/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/binary-search/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/binary-search/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/binary-search/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/binary-search/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/binary-search/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/bob/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/bob/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/bob/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/bob/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/bob/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/bob/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/bob/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/bob/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/bob/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/bob/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/book-store/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/book-store/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/book-store/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/book-store/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/book-store/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/book-store/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/book-store/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/book-store/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/book-store/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/book-store/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/camicia/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/camicia/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/camicia/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/camicia/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/camicia/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/camicia/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/camicia/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/camicia/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/camicia/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/camicia/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/change/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/change/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/change/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/change/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/change/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/change/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/change/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/change/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/change/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/change/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/clock/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/clock/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/clock/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/clock/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/clock/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/clock/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/clock/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/clock/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/clock/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/clock/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/collatz-conjecture/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/collatz-conjecture/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/collatz-conjecture/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/collatz-conjecture/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/collatz-conjecture/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/collatz-conjecture/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/collatz-conjecture/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/collatz-conjecture/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/collatz-conjecture/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/collatz-conjecture/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/complex-numbers/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/complex-numbers/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/complex-numbers/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/complex-numbers/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/complex-numbers/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/complex-numbers/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/complex-numbers/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/complex-numbers/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/complex-numbers/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/complex-numbers/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/connect/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/connect/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/connect/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/connect/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/connect/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/connect/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/connect/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/connect/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/connect/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/connect/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/crypto-square/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/crypto-square/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/crypto-square/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/crypto-square/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/crypto-square/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/crypto-square/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/crypto-square/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/crypto-square/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/crypto-square/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/crypto-square/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/custom-set/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/custom-set/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/custom-set/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/custom-set/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/custom-set/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/custom-set/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/custom-set/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/custom-set/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/custom-set/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/custom-set/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/darts/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/darts/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/darts/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/darts/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/darts/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/darts/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/darts/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/darts/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/darts/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/darts/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/diamond/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/diamond/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/diamond/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/diamond/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/diamond/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/diamond/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/diamond/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/diamond/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/diamond/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/diamond/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/difference-of-squares/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/difference-of-squares/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/difference-of-squares/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/difference-of-squares/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/difference-of-squares/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/difference-of-squares/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/difference-of-squares/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/difference-of-squares/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/difference-of-squares/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/difference-of-squares/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/dnd-character/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/dnd-character/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/dnd-character/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/dnd-character/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/dnd-character/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/dnd-character/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/dnd-character/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/dnd-character/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/dnd-character/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/dnd-character/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/dominoes/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/dominoes/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/dominoes/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/dominoes/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/dominoes/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/dominoes/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/dominoes/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/dominoes/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/dominoes/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/dominoes/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/dot-dsl/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/dot-dsl/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/dot-dsl/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/dot-dsl/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/dot-dsl/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/dot-dsl/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/dot-dsl/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/dot-dsl/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/dot-dsl/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/dot-dsl/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/eliuds-eggs/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/eliuds-eggs/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/eliuds-eggs/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/eliuds-eggs/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/eliuds-eggs/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/eliuds-eggs/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/eliuds-eggs/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/eliuds-eggs/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/eliuds-eggs/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/eliuds-eggs/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/etl/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/etl/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/etl/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/etl/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/etl/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/etl/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/etl/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/etl/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/etl/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/etl/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/flatten-array/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/flatten-array/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/flatten-array/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/flatten-array/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/flatten-array/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/flatten-array/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/flatten-array/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/flatten-array/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/flatten-array/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/flatten-array/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/forth/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/forth/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/forth/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/forth/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/forth/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/forth/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/forth/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/forth/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/forth/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/forth/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/game-of-life/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/game-of-life/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/game-of-life/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/game-of-life/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/game-of-life/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/game-of-life/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/game-of-life/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/game-of-life/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/game-of-life/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/game-of-life/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/gigasecond/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/gigasecond/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/gigasecond/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/gigasecond/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/gigasecond/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/gigasecond/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/gigasecond/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/gigasecond/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/gigasecond/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/gigasecond/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/grains/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/grains/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/grains/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/grains/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/grains/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/grains/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/grains/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/grains/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/grains/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/grains/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/grep/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/grep/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/grep/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/grep/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/grep/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/grep/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/grep/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/grep/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/grep/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/grep/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/hamming/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/hamming/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/hamming/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/hamming/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/hamming/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/hamming/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/hamming/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/hamming/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/hamming/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/hamming/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/hangman/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/hangman/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/hangman/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/hangman/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/hangman/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/hangman/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/hangman/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/hangman/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/hangman/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/hangman/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/hello-world/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/hello-world/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/hello-world/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/hello-world/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/hello-world/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/hello-world/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/hello-world/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/hello-world/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/hello-world/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/hello-world/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/high-scores/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/high-scores/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/high-scores/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/high-scores/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/high-scores/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/high-scores/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/high-scores/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/high-scores/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/high-scores/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/high-scores/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/house/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/house/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/house/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/house/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/house/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/house/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/house/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/house/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/house/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/house/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/isbn-verifier/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/isbn-verifier/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/isbn-verifier/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/isbn-verifier/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/isbn-verifier/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/isbn-verifier/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/isbn-verifier/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/isbn-verifier/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/isbn-verifier/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/isbn-verifier/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/isogram/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/isogram/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/isogram/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/isogram/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/isogram/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/isogram/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/isogram/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/isogram/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/isogram/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/isogram/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/kindergarten-garden/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/kindergarten-garden/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/kindergarten-garden/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/kindergarten-garden/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/kindergarten-garden/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/kindergarten-garden/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/kindergarten-garden/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/kindergarten-garden/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/kindergarten-garden/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/kindergarten-garden/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/knapsack/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/knapsack/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/knapsack/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/knapsack/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/knapsack/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/knapsack/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/knapsack/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/knapsack/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/knapsack/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/knapsack/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/largest-series-product/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/largest-series-product/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/largest-series-product/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/largest-series-product/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/largest-series-product/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/largest-series-product/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/largest-series-product/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/largest-series-product/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/largest-series-product/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/largest-series-product/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/leap/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/leap/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/leap/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/leap/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/leap/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/leap/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/leap/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/leap/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/leap/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/leap/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/line-up/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/line-up/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/line-up/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/line-up/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/line-up/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/line-up/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/line-up/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/line-up/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/line-up/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/line-up/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/linked-list/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/linked-list/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/linked-list/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/linked-list/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/linked-list/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/linked-list/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/linked-list/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/linked-list/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/linked-list/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/linked-list/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/luhn/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/luhn/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/luhn/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/luhn/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/luhn/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/luhn/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/luhn/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/luhn/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/luhn/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/luhn/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/matching-brackets/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/matching-brackets/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/matching-brackets/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/matching-brackets/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/matching-brackets/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/matching-brackets/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/matching-brackets/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/matching-brackets/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/matching-brackets/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/matching-brackets/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/matrix/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/matrix/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/matrix/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/matrix/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/matrix/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/matrix/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/matrix/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/matrix/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/matrix/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/matrix/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/meetup/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/meetup/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/meetup/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/meetup/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/meetup/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/meetup/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/meetup/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/meetup/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/meetup/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/meetup/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/nth-prime/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/nth-prime/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/nth-prime/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/nth-prime/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/nth-prime/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/nth-prime/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/nth-prime/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/nth-prime/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/nth-prime/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/nth-prime/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/nucleotide-count/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/nucleotide-count/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/nucleotide-count/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/nucleotide-count/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/nucleotide-count/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/nucleotide-count/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/nucleotide-count/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/nucleotide-count/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/nucleotide-count/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/nucleotide-count/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/palindrome-products/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/palindrome-products/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/palindrome-products/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/palindrome-products/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/palindrome-products/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/palindrome-products/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/palindrome-products/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/palindrome-products/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/palindrome-products/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/palindrome-products/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/pangram/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/pangram/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/pangram/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/pangram/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/pangram/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/pangram/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/pangram/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/pangram/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/pangram/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/pangram/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/parallel-letter-frequency/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/parallel-letter-frequency/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/parallel-letter-frequency/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/parallel-letter-frequency/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/parallel-letter-frequency/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/parallel-letter-frequency/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/parallel-letter-frequency/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/parallel-letter-frequency/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/parallel-letter-frequency/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/parallel-letter-frequency/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/pascals-triangle/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/pascals-triangle/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/pascals-triangle/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/pascals-triangle/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/pascals-triangle/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/pascals-triangle/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/pascals-triangle/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/pascals-triangle/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/pascals-triangle/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/pascals-triangle/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/perfect-numbers/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/perfect-numbers/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/perfect-numbers/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/perfect-numbers/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/perfect-numbers/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/perfect-numbers/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/perfect-numbers/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/perfect-numbers/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/perfect-numbers/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/perfect-numbers/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/phone-number/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/phone-number/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/phone-number/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/phone-number/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/phone-number/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/phone-number/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/phone-number/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/phone-number/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/phone-number/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/phone-number/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/prime-factors/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/prime-factors/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/prime-factors/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/prime-factors/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/prime-factors/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/prime-factors/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/prime-factors/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/prime-factors/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/prime-factors/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/prime-factors/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/protein-translation/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/protein-translation/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/protein-translation/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/protein-translation/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/protein-translation/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/protein-translation/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/protein-translation/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/protein-translation/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/protein-translation/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/protein-translation/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/pythagorean-triplet/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/pythagorean-triplet/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/pythagorean-triplet/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/pythagorean-triplet/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/pythagorean-triplet/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/pythagorean-triplet/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/pythagorean-triplet/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/pythagorean-triplet/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/pythagorean-triplet/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/pythagorean-triplet/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/queen-attack/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/queen-attack/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/queen-attack/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/queen-attack/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/queen-attack/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/queen-attack/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/queen-attack/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/queen-attack/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/queen-attack/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/queen-attack/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/rail-fence-cipher/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/rail-fence-cipher/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/rail-fence-cipher/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/rail-fence-cipher/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/rail-fence-cipher/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/rail-fence-cipher/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/rail-fence-cipher/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/rail-fence-cipher/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/rail-fence-cipher/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/rail-fence-cipher/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/raindrops/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/raindrops/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/raindrops/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/raindrops/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/raindrops/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/raindrops/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/raindrops/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/raindrops/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/raindrops/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/raindrops/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/rational-numbers/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/rational-numbers/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/rational-numbers/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/rational-numbers/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/rational-numbers/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/rational-numbers/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/rational-numbers/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/rational-numbers/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/rational-numbers/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/rational-numbers/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/rectangles/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/rectangles/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/rectangles/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/rectangles/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/rectangles/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/rectangles/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/rectangles/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/rectangles/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/rectangles/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/rectangles/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/relative-distance/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/relative-distance/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/relative-distance/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/relative-distance/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/relative-distance/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/relative-distance/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/relative-distance/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/relative-distance/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/relative-distance/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/relative-distance/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/resistor-color-duo/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/resistor-color-duo/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/resistor-color-duo/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/resistor-color-duo/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/resistor-color-duo/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/resistor-color-duo/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/resistor-color-duo/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/resistor-color-duo/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/resistor-color-duo/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/resistor-color-duo/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/resistor-color-trio/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/resistor-color-trio/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/resistor-color-trio/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/resistor-color-trio/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/resistor-color-trio/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/resistor-color-trio/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/resistor-color-trio/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/resistor-color-trio/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/resistor-color-trio/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/resistor-color-trio/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/resistor-color/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/resistor-color/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/resistor-color/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/resistor-color/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/resistor-color/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/resistor-color/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/resistor-color/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/resistor-color/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/resistor-color/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/resistor-color/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/reverse-list/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/reverse-list/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/reverse-list/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/reverse-list/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/reverse-list/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/reverse-list/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/reverse-list/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/reverse-list/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/reverse-list/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/reverse-list/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/reverse-string/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/reverse-string/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/reverse-string/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/reverse-string/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/reverse-string/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/reverse-string/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/reverse-string/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/reverse-string/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/reverse-string/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/reverse-string/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/rna-transcription/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/rna-transcription/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/rna-transcription/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/rna-transcription/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/rna-transcription/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/rna-transcription/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/rna-transcription/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/rna-transcription/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/rna-transcription/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/rna-transcription/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/roman-numerals/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/roman-numerals/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/roman-numerals/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/roman-numerals/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/roman-numerals/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/roman-numerals/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/roman-numerals/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/roman-numerals/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/roman-numerals/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/roman-numerals/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/rotational-cipher/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/rotational-cipher/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/rotational-cipher/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/rotational-cipher/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/rotational-cipher/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/rotational-cipher/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/rotational-cipher/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/rotational-cipher/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/rotational-cipher/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/rotational-cipher/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/run-length-encoding/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/run-length-encoding/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/run-length-encoding/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/run-length-encoding/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/run-length-encoding/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/run-length-encoding/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/run-length-encoding/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/run-length-encoding/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/run-length-encoding/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/run-length-encoding/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/satellite/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/satellite/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/satellite/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/satellite/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/satellite/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/satellite/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/satellite/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/satellite/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/satellite/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/satellite/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/say/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/say/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/say/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/say/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/say/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/say/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/say/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/say/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/say/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/say/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/scrabble-score/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/scrabble-score/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/scrabble-score/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/scrabble-score/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/scrabble-score/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/scrabble-score/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/scrabble-score/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/scrabble-score/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/scrabble-score/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/scrabble-score/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/secret-handshake/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/secret-handshake/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/secret-handshake/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/secret-handshake/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/secret-handshake/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/secret-handshake/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/secret-handshake/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/secret-handshake/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/secret-handshake/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/secret-handshake/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/series/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/series/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/series/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/series/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/series/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/series/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/series/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/series/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/series/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/series/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/sgf-parsing/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/sgf-parsing/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/sgf-parsing/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/sgf-parsing/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/sgf-parsing/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/sgf-parsing/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/sgf-parsing/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/sgf-parsing/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/sgf-parsing/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/sgf-parsing/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/space-age/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/space-age/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/space-age/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/space-age/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/space-age/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/space-age/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/space-age/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/space-age/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/space-age/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/space-age/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/square-root/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/square-root/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/square-root/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/square-root/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/square-root/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/square-root/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/square-root/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/square-root/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/square-root/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/square-root/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/strain/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/strain/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/strain/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/strain/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/strain/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/strain/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/strain/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/strain/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/strain/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/strain/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/sublist/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/sublist/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/sublist/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/sublist/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/sublist/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/sublist/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/sublist/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/sublist/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/sublist/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/sublist/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/sum-of-multiples/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/sum-of-multiples/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/sum-of-multiples/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/sum-of-multiples/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/sum-of-multiples/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/sum-of-multiples/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/sum-of-multiples/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/sum-of-multiples/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/sum-of-multiples/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/sum-of-multiples/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/transpose/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/transpose/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/transpose/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/transpose/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/transpose/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/transpose/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/transpose/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/transpose/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/transpose/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/transpose/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/triangle/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/triangle/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/triangle/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/triangle/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/triangle/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/triangle/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/triangle/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/triangle/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/triangle/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/triangle/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/twelve-days/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/twelve-days/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/twelve-days/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/twelve-days/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/twelve-days/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/twelve-days/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/twelve-days/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/twelve-days/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/twelve-days/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/twelve-days/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/two-bucket/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/two-bucket/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/two-bucket/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/two-bucket/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/two-bucket/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/two-bucket/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/two-bucket/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/two-bucket/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/two-bucket/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/two-bucket/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/two-fer/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/two-fer/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/two-fer/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/two-fer/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/two-fer/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/two-fer/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/two-fer/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/two-fer/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/two-fer/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/two-fer/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/variable-length-quantity/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/variable-length-quantity/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/variable-length-quantity/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/variable-length-quantity/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/variable-length-quantity/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/variable-length-quantity/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/variable-length-quantity/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/variable-length-quantity/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/variable-length-quantity/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/variable-length-quantity/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/word-count/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/word-count/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/word-count/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/word-count/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/word-count/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/word-count/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/word-count/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/word-count/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/word-count/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/word-count/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/wordy/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/wordy/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/wordy/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/wordy/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/wordy/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/wordy/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/wordy/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/wordy/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/wordy/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/wordy/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/yacht/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/yacht/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/yacht/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/yacht/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/yacht/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/yacht/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/yacht/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/yacht/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/yacht/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/yacht/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/exercises/practice/zebra-puzzle/vendor/LeanTest/LeanTest/Json.lean b/exercises/practice/zebra-puzzle/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/exercises/practice/zebra-puzzle/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/exercises/practice/zebra-puzzle/vendor/LeanTest/LeanTest/SourceParser.lean b/exercises/practice/zebra-puzzle/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/exercises/practice/zebra-puzzle/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/exercises/practice/zebra-puzzle/vendor/LeanTest/LeanTest/Test.lean b/exercises/practice/zebra-puzzle/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/exercises/practice/zebra-puzzle/vendor/LeanTest/LeanTest/Test.lean +++ b/exercises/practice/zebra-puzzle/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest diff --git a/templates/vendor/LeanTest/LeanTest/Json.lean b/templates/vendor/LeanTest/LeanTest/Json.lean new file mode 100644 index 0000000..a61f6b9 --- /dev/null +++ b/templates/vendor/LeanTest/LeanTest/Json.lean @@ -0,0 +1,57 @@ +/- +Minimal, dependency-free JSON string building. +-/ + +namespace LeanTest.Json + +private def hexDigit (n : Nat) : Char := + if n < 10 then Char.ofNat (n + 48) else Char.ofNat (n - 10 + 97) + +private def toHex4 (n : Nat) : String := + let d0 := hexDigit ((n / 4096) % 16) + let d1 := hexDigit ((n / 256) % 16) + let d2 := hexDigit ((n / 16) % 16) + let d3 := hexDigit (n % 16) + String.ofList [d0, d1, d2, d3] + +private def escapeChar (c : Char) : String := + match c with + | '"' => "\\\"" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\r' => "\\r" + | '\t' => "\\t" + | c => if c.toNat < 0x20 then "\\u" ++ toHex4 c.toNat else String.ofList [c] + +/-- Escape a string's contents for embedding between JSON double-quotes. -/ +def escape (s : String) : String := + String.join (s.toList.map escapeChar) + +/-- A JSON string literal, including the surrounding quotes. -/ +def str (s : String) : String := + "\"" ++ escape s ++ "\"" + +/-- A JSON string literal, or `null` when absent. -/ +def strOrNull : Option String → String + | none => "null" + | some s => str s + +/-- A JSON number, or `null` when absent. -/ +def natOrNull : Option Nat → String + | none => "null" + | some n => toString n + +/-- Truncate `s` to at most `maxLen` characters. -/ +def truncate (s : String) (maxLen : Nat) : String := + if s.length <= maxLen then s + else String.ofList (s.toList.take (maxLen - 1)) ++ "…" + +/-- Build a JSON object from a list of already-encoded `"key": value` pairs. -/ +def object (fields : List String) : String := + "{" ++ String.intercalate ", " fields ++ "}" + +/-- Build a JSON array from a list of already-encoded elements. -/ +def array (elems : List String) : String := + "[" ++ String.intercalate ", " elems ++ "]" + +end LeanTest.Json diff --git a/templates/vendor/LeanTest/LeanTest/SourceParser.lean b/templates/vendor/LeanTest/LeanTest/SourceParser.lean new file mode 100644 index 0000000..eaf5d23 --- /dev/null +++ b/templates/vendor/LeanTest/LeanTest/SourceParser.lean @@ -0,0 +1,84 @@ +/- +Extracts the literal source text of each `.addTest "" (...)` call. +-/ + +namespace LeanTest.SourceParser + +private def listStartsWith : List Char → List Char → Bool + | _, [] => true + | [], _ :: _ => false + | x :: xs, p :: ps => x == p && listStartsWith xs ps + +private def isSpace (c : Char) : Bool := + c == ' ' || c == '\t' || c == '\n' || c == '\r' + +/-- Trim leading/trailing whitespace. -/ +private def trimStr (s : String) : String := + let chars := s.toList.dropWhile isSpace + String.ofList (chars.reverse.dropWhile isSpace).reverse + +/-- Return the remainder of the list after `marker`, or `none` if it doesn't occur. -/ +private partial def findMarker (xs : List Char) (marker : List Char) : Option (List Char) := + match xs with + | [] => none + | _ :: rest => + if listStartsWith xs marker then some (xs.drop marker.length) + else findMarker rest marker + +private partial def readStringLiteral (xs : List Char) : String × List Char := + go xs #[] +where + go (xs : List Char) (acc : Array Char) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => go rest (acc.push '\\' |>.push c) + | '"' :: rest => (String.ofList acc.toList, rest) + | c :: rest => go rest (acc.push c) + +private partial def readParenBody (xs : List Char) : String × List Char := + match xs with + | '(' :: rest => go rest 0 #[] false + | _ => ("", xs) +where + go (xs : List Char) (depth : Nat) (acc : Array Char) (inString : Bool) : String × List Char := + match xs with + | [] => (String.ofList acc.toList, []) + | '\\' :: c :: rest => + if inString then go rest depth (acc.push '\\' |>.push c) inString + else go (c :: rest) depth (acc.push '\\') inString + | '"' :: rest => go rest depth (acc.push '"') (!inString) + | '(' :: rest => + if inString then go rest depth (acc.push '(') inString + else go rest (depth + 1) (acc.push '(') inString + | ')' :: rest => + if inString then go rest depth (acc.push ')') inString + else if depth == 0 then (String.ofList acc.toList, rest) + else go rest (depth - 1) (acc.push ')') inString + | c :: rest => go rest depth (acc.push c) inString + +/-- Extract `(test name, source body)` pairs for each `.addTest "" (...)` in `source`. -/ +partial def extractTestBodies (source : String) : List (String × String) := + go source.toList #[] +where + marker := ".addTest \"".toList + go (xs : List Char) (acc : Array (String × String)) : List (String × String) := + match findMarker xs marker with + | none => acc.toList + | some afterMarker => + let (name, afterName) := readStringLiteral afterMarker + let afterWs := afterName.dropWhile isSpace + let (body, rest) := readParenBody afterWs + let trimmed := (trimStr body).toList + let trimmed := + if listStartsWith trimmed ['d', 'o'] then + (trimStr (String.ofList (trimmed.drop 2))).toList + else trimmed + go rest (acc.push (name, String.ofList trimmed)) + +/-- Look up the captured source for `name`, or `""` if extraction found nothing. -/ +def lookup (name : String) (bodies : List (String × String)) : String := + match bodies.find? (fun p => p.1 == name) with + | some (_, code) => code + | none => "" + +end LeanTest.SourceParser diff --git a/templates/vendor/LeanTest/LeanTest/Test.lean b/templates/vendor/LeanTest/LeanTest/Test.lean index 5ddbae5..8e72377 100644 --- a/templates/vendor/LeanTest/LeanTest/Test.lean +++ b/templates/vendor/LeanTest/LeanTest/Test.lean @@ -3,6 +3,8 @@ Test case and test suite management. -/ import LeanTest.Assertions +import LeanTest.Json +import LeanTest.SourceParser namespace LeanTest @@ -10,14 +12,9 @@ namespace LeanTest structure TestCase where description : String test : IO AssertionResult + taskId : Option Nat := none -- set for concept exercises deriving Inhabited -/-- Result of running a test -/ -structure TestResult where - description : String - result : AssertionResult - deriving Repr - /-- A collection of tests (test suite) -/ structure TestSuite where name : String @@ -31,28 +28,49 @@ def empty (name : String) : TestSuite := { name := name, tests := [] } /-- Add a test to the suite -/ -def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) : TestSuite := - { suite with tests := suite.tests ++ [{ description := description, test := test }] } +def addTest (suite : TestSuite) (description : String) (test : IO AssertionResult) + (taskId : Option Nat := none) : TestSuite := + { suite with tests := suite.tests ++ [{ description := description, test := test, taskId := taskId }] } end TestSuite +/-- Per-test outcome, matching the v3 interface's `pass` / `fail` / `error`. -/ +inductive TestStatus where + | pass + | fail + | error + deriving Repr, BEq + +def TestStatus.toReportString : TestStatus → String + | .pass => "pass" + | .fail => "fail" + | .error => "error" + +/-- Result of running a test -/ +structure TestResult where + description : String + status : TestStatus + message : Option String -- `none` when `status = .pass` + taskId : Option Nat + deriving Repr + /-- Test statistics -/ structure TestStats where - total : Nat - passed : Nat - failed : Nat - deriving Repr + total : Nat := 0 + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 namespace TestStats -def empty : TestStats := - { total := 0, passed := 0, failed := 0 } +def empty : TestStats := {} -def addResult (stats : TestStats) (result : AssertionResult) : TestStats := - { total := stats.total + 1 - , passed := if result.isSuccess then stats.passed + 1 else stats.passed - , failed := if result.isSuccess then stats.failed else stats.failed + 1 - } +def addResult (stats : TestStats) (status : TestStatus) : TestStats := + { stats with + total := stats.total + 1 + passed := stats.passed + (if status == .pass then 1 else 0) + failed := stats.failed + (if status == .fail then 1 else 0) + errored := stats.errored + (if status == .error then 1 else 0) } end TestStats @@ -63,27 +81,33 @@ def yellowColor : String := "\x1b[33m" def resetColor : String := "\x1b[0m" def boldColor : String := "\x1b[1m" -/-- Run a single test and print the result -/ +/-- Run a single test, printing a colored result line, and returning a structured `TestResult`. + Exceptions are caught and returned as a per-test `error`. -/ def runTest (testCase : TestCase) : IO TestResult := do - let result ← testCase.test - match result with - | .success => - IO.println s!" {greenColor}✓{resetColor} {testCase.description}" - | .failure msg => + try + let result ← testCase.test + match result with + | .success => + IO.println s!" {greenColor}✓{resetColor} {testCase.description}" + return { description := testCase.description, status := .pass, message := none, taskId := testCase.taskId } + | .failure msg => + IO.println s!" {redColor}✗{resetColor} {testCase.description}" + IO.println s!" {redColor}{msg}{resetColor}" + return { description := testCase.description, status := .fail, message := some msg, taskId := testCase.taskId } + catch e => + let msg := toString e IO.println s!" {redColor}✗{resetColor} {testCase.description}" IO.println s!" {redColor}{msg}{resetColor}" - return { description := testCase.description, result := result } + return { description := testCase.description, status := .error, message := some msg, taskId := testCase.taskId } /-- Run all tests in a test suite -/ -def runTestSuite (suite : TestSuite) : IO TestStats := do +def runTestSuite (suite : TestSuite) : IO (List TestResult) := do IO.println s!"\n{boldColor}{suite.name}{resetColor}" - let mut stats := TestStats.empty - + let mut results : List TestResult := [] for testCase in suite.tests do let result ← runTest testCase - stats := stats.addResult result.result - - return stats + results := results ++ [result] + return results /-- Print test summary -/ def printSummary (stats : TestStats) : IO Unit := do @@ -94,37 +118,81 @@ def printSummary (stats : TestStats) : IO Unit := do if stats.failed > 0 then IO.println s!" {redColor}Failed: {stats.failed}{resetColor}" + if stats.errored > 0 then + IO.println s!" {redColor}Errored: {stats.errored}{resetColor}" + + if stats.failed > 0 || stats.errored > 0 then IO.println s!"\n{redColor}FAILED{resetColor}" else IO.println s!"\n{greenColor}ALL TESTS PASSED{resetColor}" -/-- Run multiple test suites -/ -def runTestSuites (suites : List TestSuite) : IO Unit := do - let mut totalStats := TestStats.empty - +/-- Build the v3 `results.json` payload for a full run's `TestResult`s. + `testCode` maps each test's description to its captured source. + `results` may be empty if an exercise is compile-time only (theorem proving, etc.). -/ +def buildResultsJson (results : List TestResult) (testCode : List (String × String)) : String := + open Json in + let overall : TestStatus := + if results.all (fun t => t.status == .pass) then .pass + else if !results.isEmpty && results.all (fun t => t.status == .error) then .error + else .fail + let testJson (t : TestResult) : String := + let code := SourceParser.lookup t.description testCode + let fields := + [ s!"\"name\": {str t.description}" + , s!"\"status\": {str t.status.toReportString}" + , s!"\"message\": {strOrNull t.message}" + , s!"\"test_code\": {str code}" + ] ++ (match t.taskId with + | none => [] + | some n => [s!"\"task_id\": {n}"]) + object fields + let topMessage : Option String := + match overall with + | .error => + let firstMsg := results.head?.bind (·.message) + some (truncate (firstMsg.getD "All tests failed with an error.") 65535) + | _ => none + object [ + s!"\"version\": 3", + s!"\"status\": {str overall.toReportString}", + s!"\"message\": {strOrNull topMessage}", + s!"\"tests\": {array (results.map testJson)}" + ] + +/-- If the runner set `EXERCISM_OUTPUT_DIR`, write `results.json` there. + Reads `EXERCISM_TEST_FILE` (if set) to source `test_code` from the test file. + Silently does nothing when `EXERCISM_OUTPUT_DIR` is unset. -/ +def writeResultsIfRequested (results : List TestResult) : IO Unit := do + match (← IO.getEnv "EXERCISM_OUTPUT_DIR") with + | none => pure () + | some outputDir => + let testCode ← + match (← IO.getEnv "EXERCISM_TEST_FILE") with + | none => pure [] + | some path => + try + let source ← IO.FS.readFile path + pure (SourceParser.extractTestBodies source) + catch _ => pure [] + IO.FS.createDirAll outputDir + IO.FS.writeFile s!"{outputDir}/results.json" (buildResultsJson results testCode) + +/-- Run multiple test suites, print a summary. + If the proper env vars are set, write `results.json`. -/ +def runTestSuites (suites : List TestSuite) : IO (List TestResult) := do + let mut allResults : List TestResult := [] for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } + let results ← runTestSuite suite + allResults := allResults ++ results - printSummary totalStats + let stats := allResults.foldl (fun s r => s.addResult r.status) TestStats.empty + printSummary stats + writeResultsIfRequested allResults + return allResults -/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed) -/ +/-- Run multiple test suites and return exit code (0 = all passed, 1 = some failed/errored) -/ def runTestSuitesWithExitCode (suites : List TestSuite) : IO UInt32 := do - let mut totalStats := TestStats.empty - - for suite in suites do - let stats ← runTestSuite suite - totalStats := { - total := totalStats.total + stats.total, - passed := totalStats.passed + stats.passed, - failed := totalStats.failed + stats.failed - } - - printSummary totalStats - return if totalStats.failed > 0 then 1 else 0 + let results ← runTestSuites suites + return if results.any (fun r => r.status != .pass) then 1 else 0 end LeanTest