From f8f6e2f34e7b0ad50fa5a1725b147445adfcfe3b Mon Sep 17 00:00:00 2001 From: David Thrane Christiansen Date: Wed, 24 Jun 2026 13:15:41 +0200 Subject: [PATCH 01/26] feat: add a proper test framework --- lake-manifest.json | 2 +- lakefile.lean | 170 ++++++++++++++++++++- src/errata-tests/ErrataTests.lean | 80 ++++++++++ src/errata/Errata.lean | 22 +++ src/errata/Errata/Assertions.lean | 50 ++++++ src/errata/Errata/CompileTime.lean | 77 ++++++++++ src/errata/Errata/CompileTime/Helpers.lean | 44 ++++++ src/errata/Errata/Context.lean | 45 ++++++ src/errata/Errata/Discovery.lean | 46 ++++++ src/errata/Errata/Golden.lean | 87 +++++++++++ src/errata/Errata/Here.lean | 32 ++++ src/errata/Errata/IsTest.lean | 42 +++++ src/errata/Errata/Process.lean | 23 +++ src/errata/Errata/Property.lean | 34 +++++ src/errata/Errata/Report.lean | 164 ++++++++++++++++++++ src/errata/Errata/Result.lean | 107 +++++++++++++ src/errata/Errata/Runner.lean | 169 ++++++++++++++++++++ src/errata/Errata/TestM.lean | 115 ++++++++++++++ src/errata/Errata/usage.txt | 16 ++ src/errata/ErrataEnumerateMain.lean | 39 +++++ 20 files changed, 1362 insertions(+), 2 deletions(-) create mode 100644 src/errata-tests/ErrataTests.lean create mode 100644 src/errata/Errata.lean create mode 100644 src/errata/Errata/Assertions.lean create mode 100644 src/errata/Errata/CompileTime.lean create mode 100644 src/errata/Errata/CompileTime/Helpers.lean create mode 100644 src/errata/Errata/Context.lean create mode 100644 src/errata/Errata/Discovery.lean create mode 100644 src/errata/Errata/Golden.lean create mode 100644 src/errata/Errata/Here.lean create mode 100644 src/errata/Errata/IsTest.lean create mode 100644 src/errata/Errata/Process.lean create mode 100644 src/errata/Errata/Property.lean create mode 100644 src/errata/Errata/Report.lean create mode 100644 src/errata/Errata/Result.lean create mode 100644 src/errata/Errata/Runner.lean create mode 100644 src/errata/Errata/TestM.lean create mode 100644 src/errata/Errata/usage.txt create mode 100644 src/errata/ErrataEnumerateMain.lean diff --git a/lake-manifest.json b/lake-manifest.json index a0b4902f3..2f390aa99 100644 --- a/lake-manifest.json +++ b/lake-manifest.json @@ -15,7 +15,7 @@ "type": "git", "subDir": null, "scope": "", - "rev": "f3f26cc72646205ca167117487c008ee1dafe816", + "rev": "f3c7bd5061bd81b4480295c524d4f245c8b7e4e2", "name": "plausible", "manifestFile": "lake-manifest.json", "inputRev": "main", diff --git a/lakefile.lean b/lakefile.lean index cea6eac61..95979cca5 100644 --- a/lakefile.lean +++ b/lakefile.lean @@ -124,11 +124,179 @@ lean_exe «verso-literate-plan» where srcDir := "src/verso-literate-plan" supportInterpreter := true +@[default_target] +input_file errataUsageFile where + text := true + path := "src/errata/Errata/usage.txt" + +lean_lib Errata where + srcDir := "src/errata" + roots := #[`Errata] + needs := #[errataUsageFile] + +-- Enumerates the Errata tests defined in a module. +lean_exe «errata-enumerate» where + root := `ErrataEnumerateMain + srcDir := "src/errata" + supportInterpreter := true + +-- Writes the fully-qualified names of the Errata tests defined directly in a module. +module_facet errataTests mod : System.FilePath := do + let ws ← getWorkspace + let exeJob ← «errata-enumerate».fetch + -- Depend on `leanArts`, not `olean`: enumeration reads the whole module, including private and + -- `meta` test declarations, which the public olean's trace excludes. The `leanArts` trace inherits + -- the source trace, so adding or removing any test invalidates the manifest. + let modJob ← mod.leanArts.fetch + let buildDir := ws.root.buildDir + let outFile := mod.filePath (buildDir / "errata-tests") "json" + exeJob.bindM fun exeFile => + modJob.mapM fun _arts => do + addLeanTrace + addTrace (← computeTrace exeFile) + buildFileUnlessUpToDate' (text := true) outFile <| + proc { + cmd := exeFile.toString + args := #[mod.name.toString, outFile.toString] + env := ← getAugmentedEnv + } + pure outFile + +-- Tests that exercise Errata using Errata itself. +lean_lib ErrataTests where + srcDir := "src/errata-tests" + roots := #[`ErrataTests] + +-- The generated discovered-tests module (`allTests`), written by the Errata driver. +lean_lib ErrataGenerated where + srcDir := ".lake/errata-runner" + roots := #[`ErrataDiscovered] + +-- The generated, discovered test runner. Its source is written by the Errata test driver. +lean_exe «errata-runner» where + root := `ErrataRunnerMain + srcDir := ".lake/errata-runner" + supportInterpreter := true + +/-- The test's name below its module: the declaration's components past the module prefix, dotted. -/ +private def errataTestName (moduleName declName : Lean.Name) : String := + let modComps := moduleName.components + let declComps := declName.components + let below := if moduleName.isPrefixOf declName then declComps.drop modComps.length else declComps + ".".intercalate (below.map (·.toString)) + +/-- Parse a per-module JSON manifest into the tests' user-facing names. -/ +private def errataParseManifest (content : String) : Array String := + match Lean.Json.parse content with + | .error _ => #[] + | .ok json => + match json.getArr? with + | .error _ => #[] + | .ok arr => arr.filterMap fun j => (j.getStr?).toOption + +/-- Generate the discovered-tests module: `import all` the test modules and collect their tests. -/ +private def errataDiscoveredSource (packageName : String) + (mods : Array (Lean.Name × Array String)) : String := Id.run do + let mut imports := #["public import Errata"] + let mut entries : Array String := #[] + for (moduleName, tests) in mods do + imports := imports.push s!"import all {moduleName}" + for name in tests do + let test := errataTestName moduleName name.toName + entries := entries.push + s!" Errata.TestEntry.of \"{packageName}\" \"{moduleName}\" \"{test}\" (@{name})" + let header := "\n".intercalate imports.toList + let body := ",\n".intercalate entries.toList + return s!"module\n\n{header}\n\n\ + public def allTests : Array Errata.TestEntry := #[\n{body}\n]\n" + +/-- The main that runs the discovered tests. -/ +private def errataMainSource : String := + "import Errata\n\ + import ErrataDiscovered\n\n\ + def main (args : List String) : IO UInt32 :=\n \ + Errata.runMain allTests args\n" + +/-- The module a target spec `[package/]module[#test]` selects (the unit of execution). -/ +private def errataSpecModule (s : String) : String := + let afterPkg := match s.splitOn "/" with | [_, rest] => rest | _ => s + (afterPkg.splitOn "#").headD afterPkg + +/-- Whether a module is selected by the given target specs (empty selects everything). -/ +private def errataModuleSelected (specs : List String) (moduleName : Lean.Name) : Bool := + specs.isEmpty || specs.any fun s => + let n := moduleName.toString + n == s || n.startsWith (s ++ ".") + +/-- Split driver arguments into module target specs and runner passthrough arguments. -/ +private def errataSplitArgs (args : List String) : List String × List String := + match args.span (· != "--") with + | (before, _ :: after) => (before, after) + | (before, []) => + (before.filter (fun a => !a.startsWith "-"), before.filter (fun a => a.startsWith "-")) + +/-- Usage information for `lake test`, shared with `Errata.usage` through one text file. -/ +private def errataUsage : String := include_str "src/errata/Errata/usage.txt" + +@[test_driver] +script «errata-test» (args) do + let ws ← getWorkspace + let (specs, runnerArgs) := errataSplitArgs args + -- Answer `--help` before discovering or building anything. + if runnerArgs.any (fun a => a == "--help" || a == "-h") then + IO.println errataUsage + return 0 + -- The module is the unit of execution; a test-level selector is rejected, not silently broadened. + for spec in specs do + if (spec.splitOn "#").length > 1 then + IO.eprintln s!"error: Errata runs whole modules; '{spec}' names a test. \ + Select the module '{errataSpecModule spec}' instead." + return 1 + let moduleSpecs := specs.map errataSpecModule + -- Discover the tests in the selected modules, building the per-module enumeration facet. + let (allNames, perModule) ← runBuild do + let mut names : Array Lean.Name := #[] + let mut jobs : Array (Job (Lean.Name × System.FilePath)) := #[] + for lib in ws.root.leanLibs do + -- The generated runner lib has no source until this script writes it, and it holds no tests. + if lib.name == `ErrataGenerated then continue + let mods ← (← lib.modules.fetch).await + for m in mods do + names := names.push m.name + if errataModuleSelected moduleSpecs m.name then + let job ← m.facet `errataTests |>.fetch + jobs := jobs.push (job.map fun p => (m.name, p)) + pure ((Job.collectArray jobs).map fun ps => (names, ps)) + -- Every selector must name a real module. + for spec in moduleSpecs do + unless allNames.any (fun n => n.toString == spec || n.toString.startsWith (spec ++ ".")) do + IO.eprintln s!"error: no module matches '{spec}'" + return 1 + let mut mods : Array (Lean.Name × Array String) := #[] + for (moduleName, path) in perModule do + let tests := errataParseManifest (← IO.FS.readFile path) + unless tests.isEmpty do + mods := mods.push (moduleName, tests) + -- Write the two generated sources, only when they change, so the build is reused across runs. + let dir := ws.root.dir / ".lake" / "errata-runner" + IO.FS.createDirAll dir + for (name, src) in [("ErrataDiscovered.lean", errataDiscoveredSource ws.root.prettyName mods), + ("ErrataRunnerMain.lean", errataMainSource)] do + let file := dir / name + let changed ← if ← file.pathExists then pure ((← IO.FS.readFile file) != src) else pure true + if changed then IO.FS.writeFile file src + -- Build and run the discovered runner. + let some exe := ws.findLeanExe? `«errata-runner» + | IO.eprintln "errata-runner executable is not configured"; return 1 + let exePath ← runBuild exe.fetch + let child ← IO.Process.spawn { cmd := exePath.toString, args := runnerArgs.toArray } + child.wait + @[default_target] lean_lib Tests where srcDir := "src/tests" -@[test_driver] +-- The legacy ad-hoc test runner. The Errata driver below is the active test driver. lean_exe «verso-tests» where root := `TestMain srcDir := "src/tests" diff --git a/src/errata-tests/ErrataTests.lean b/src/errata-tests/ErrataTests.lean new file mode 100644 index 000000000..2251be132 --- /dev/null +++ b/src/errata-tests/ErrataTests.lean @@ -0,0 +1,80 @@ +/- +Copyright (c) 2026 Lean FRO LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Author: David Thrane Christiansen + +Tests that exercise Errata using Errata itself. +-/ +module + +public import Errata +public meta import Errata + +open Errata + +/-- A bare boolean is a passing test. -/ +@[test] def onePlusOne : Bool := 1 + 1 == 2 + +/-- An assertion-based test. -/ +@[test] def equality : TestM Unit := do + assertEq (expected := 4) (actual := 2 + 2) + +/-- A test with named results. -/ +@[test] def named : TestM Unit := do + result "first" (assertEq 1 1) + result "second" (assertContains (expected := "b") (actual := "abc")) + +/-- A test that completes without any check is a bare success. -/ +@[test] def emptyBody : TestM Unit := pure () + +/-- A test that expects a failure. -/ +@[test] def expectsFailure : TestM Unit := + expectFail (assertEq 1 2) + +/-- A data-driven family expressed as a plain loop. -/ +@[test] def squares : TestM Unit := do + for (n, sq) in [(1, 1), (2, 4), (3, 9)] do + result s!"square {n}" (assertEq (expected := sq) (actual := n * n)) + +/-- A subprocess test. -/ +@[test] def echoRuns : TestM Unit := do + let out ← IO.Process.output { cmd := "echo", args := #["hello"] } + assertExitCode 0 out + assertContains (expected := "hello") (actual := out.stdout) + +/-- info: 3 -/ +#test_msgs in +#eval 1 + 2 + +-- The expected block is read from the source, so `#test_msgs` works in verso docstring mode. +set_option doc.verso true in +/-- info: 7 -/ +#test_msgs in +#eval 3 + 4 + +/-- A property test. -/ +@[test] def addComm : TestM Unit := + property (∀ a b : Nat, a + b = b + a) + +open Lean (toJson fromJson?) + +deriving instance Plausible.Shrinkable, Plausible.Arbitrary for Position +deriving instance Plausible.Shrinkable, Plausible.Arbitrary for Location +deriving instance Plausible.Shrinkable, Plausible.Arbitrary for TestFailure +deriving instance Plausible.Shrinkable, Plausible.Arbitrary for Status +deriving instance Plausible.Shrinkable, Plausible.Arbitrary for Result + +/-- The JSON encoding of a result round-trips: decoding the encoding recovers the result. -/ +@[test] def jsonRoundTrips : TestM Unit := + property (∀ r : Result, (fromJson? (toJson r)).toOption = some r) + +/-- A temp-directory fixture with a golden file. -/ +@[test] def goldenRoundTrip : TestM Unit := + IO.FS.withTempDir fun dir => do + let cfg ← read + -- In update mode this would write; here we drive it through a temp golden file. + let goldenPath := dir / "expected.txt" + IO.FS.writeFile goldenPath "contents\n" + assertFileExists goldenPath + let _ := cfg + goldenFile goldenPath "contents\n" diff --git a/src/errata/Errata.lean b/src/errata/Errata.lean new file mode 100644 index 000000000..1760f91cd --- /dev/null +++ b/src/errata/Errata.lean @@ -0,0 +1,22 @@ +/- +Copyright (c) 2026 Lean FRO LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Author: David Thrane Christiansen +-/ +module + +public import Errata.Result +public import Errata.Context +public import Errata.Here +public import Errata.TestM +public import Errata.IsTest +public import Errata.Assertions +public import Errata.Process +public import Errata.Golden +public import Errata.Report +public import Errata.Runner +public import Errata.Discovery +public import Errata.CompileTime +public import Errata.Property + +set_option doc.verso true diff --git a/src/errata/Errata/Assertions.lean b/src/errata/Errata/Assertions.lean new file mode 100644 index 000000000..4cea4b6a9 --- /dev/null +++ b/src/errata/Errata/Assertions.lean @@ -0,0 +1,50 @@ +/- +Copyright (c) 2026 Lean FRO LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Author: David Thrane Christiansen +-/ +module + +public import Errata.TestM +public import Errata.Here + +public section + +set_option linter.missingDocs true +set_option doc.verso true + +namespace Errata + +/-- Asserts that a condition holds. -/ +def assert (cond : Bool) (message : String := "assertion failed") + (loc : Location := by exact here%) : TestM Unit := + unless cond do fail message (location? := some loc) + +/-- Asserts that the actual value equals the expected value, reporting both when they differ. -/ +def assertEq {α} [BEq α] [Repr α] (expected actual : α) + (loc : Location := by exact here%) : TestM Unit := + unless actual == expected do + fail "values are not equal" + (detail? := some s!"expected: {repr expected}\nactual: {repr actual}") + (location? := some loc) + +/-- Asserts that the actual value differs from the unexpected value. -/ +def assertNe {α} [BEq α] [Repr α] (unexpected actual : α) + (loc : Location := by exact here%) : TestM Unit := do + if actual == unexpected then + fail "values are equal but should differ" + (detail? := some s!"both: {repr actual}") (location? := some loc) + +/-- Asserts that the actual string contains the expected substring. -/ +def assertContains (expected actual : String) + (loc : Location := by exact here%) : TestM Unit := + unless (actual.splitOn expected).length > 1 do + fail "substring not found" + (detail? := some s!"expected to contain: {expected}\nactual: {actual}") + (location? := some loc) + +/-- Asserts that a file exists. -/ +def assertFileExists (path : System.FilePath) + (loc : Location := by exact here%) : TestM Unit := do + unless ← path.pathExists do + fail s!"file does not exist: {path}" (location? := some loc) diff --git a/src/errata/Errata/CompileTime.lean b/src/errata/Errata/CompileTime.lean new file mode 100644 index 000000000..ce6eb52b2 --- /dev/null +++ b/src/errata/Errata/CompileTime.lean @@ -0,0 +1,77 @@ +/- +Copyright (c) 2026 Lean FRO LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Author: David Thrane Christiansen +-/ +module + +public import Errata.Result +import Errata.Discovery +public meta import Errata.CompileTime.Helpers +public import Lean.Elab.Command +public import Lean.Data.Options +import Lean.Meta.Hint +import Lean + +open Lean Elab Command Errata.CompileTime + +public section + +set_option doc.verso true + +/-- +When true, a failing Errata compile-time test is an elaboration error rather than a warning. +-/ +register_option Errata.failOnError : Bool := { + defValue := false + descr := "Make a failing Errata compile-time test an elaboration error rather than a warning." +} + +namespace Errata + +/-- Checks that the command below produces the messages given in the preceding doc comment. -/ +syntax (name := testMsgsCmd) (plainDocComment)? "#test_msgs" "in" command : command + +@[command_elab testMsgsCmd] +meta def elabTestMsgs : Command.CommandElab + | `($[$dc?:docComment]? #test_msgs%$tk in $cmd) => do + let expected := ((← dc?.mapM (getDocStringText ·)).getD "").trimAscii.copy + -- Elaborate the command, capturing its messages instead of letting them surface. + let saved := (← get).messages + modify ({ · with messages := {} }) + try + elabCommand cmd + catch e => + logError (← e.toMessageData.toString) + let produced := (← get).messages + modify ({ · with messages := saved }) + let visible := produced.toList.filter (!·.isSilent) + let strings ← (visible.mapM formatMessage : IO (List String)) + let actual := ("\n".intercalate strings).trimAscii.copy + let passed := messagesMatch expected actual + -- Reify the verdict into a discovered test, named after the source position. + let fileMap ← getFileMap + let startPos := fileMap.toPosition (tk.getPos?.getD 0) + let endPos := fileMap.toPosition (tk.getTailPos?.getD 0) + let declName := Name.mkSimple s!"errataMsgTest_L{startPos.line}_C{startPos.column}" + let verdict ← + if passed then + `(Errata.TestResult.pass) + else + `(Errata.TestResult.mismatch "compile-time messages do not match" $(quote actual) + $(quote (← getMainModule).toString) + $(quote startPos.line) $(quote startPos.column) + $(quote endPos.line) $(quote endPos.column)) + elabCommand (← `(@[test] def $(mkIdent declName) : Errata.TestResult := $verdict)) + -- Report a mismatch at build time, offering the corrected expected block as a fix. + unless passed do + let fixRef := (dc?.map (·.raw)).getD tk + let hint ← liftCoreM <| MessageData.hint m!"Update the expected output:" + #[{ suggestion := suggestedDoc actual }] (ref? := some fixRef) + let body := m!"Errata #test_msgs: the messages do not match.\n\n\ + Expected:\n{expected}\n\nActual:\n{actual}" + if (← getOptions).getBool `Errata.failOnError false then + logErrorAt tk (body ++ hint) + else + logWarningAt tk (body ++ hint) + | _ => throwUnsupportedSyntax diff --git a/src/errata/Errata/CompileTime/Helpers.lean b/src/errata/Errata/CompileTime/Helpers.lean new file mode 100644 index 000000000..756f46948 --- /dev/null +++ b/src/errata/Errata/CompileTime/Helpers.lean @@ -0,0 +1,44 @@ +/- +Copyright (c) 2026 Lean FRO LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Author: David Thrane Christiansen + +Non-meta helpers for the `#test_msgs` command, kept separate so the command elaborator is the +only meta definition. +-/ +module + +public import Lean.Message +public import Lean.Elab.GuardMsgs + +public section + +set_option linter.missingDocs true +set_option doc.verso true + +namespace Errata.CompileTime + +/-- Renders a message with a severity prefix, in the form the expected block is compared against. -/ +def formatMessage (msg : Lean.Message) : IO String := do + let mut str ← msg.data.toString + unless msg.caption == "" do + str := msg.caption ++ ":\n" ++ str + let pfx := + if msg.isTrace then "trace:" + else match msg.severity with + | .information => "info: " + | .warning => "warning: " + | .error => "error: " + return pfx ++ str + +open Lean.Elab.Tactic.GuardMsgs (WhitespaceMode) in +/-- Whether the expected and actual message blocks match, normalizing whitespace as `#guard_msgs` does. -/ +def messagesMatch (expected actual : String) : Bool := + let norm := fun s => (WhitespaceMode.normalized.apply s).trimAscii.copy + norm expected == norm actual + +/-- The doc comment that would make the expected block match the actual output. -/ +def suggestedDoc (actual : String) : String := + if actual.isEmpty then "" + else if actual.contains '\n' then s!"/--\n{actual}\n-/\n" + else s!"/-- {actual} -/\n" diff --git a/src/errata/Errata/Context.lean b/src/errata/Errata/Context.lean new file mode 100644 index 000000000..bdd804fcd --- /dev/null +++ b/src/errata/Errata/Context.lean @@ -0,0 +1,45 @@ +/- +Copyright (c) 2026 Lean FRO LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Author: David Thrane Christiansen +-/ +module + +public import Std.Data.HashMap +public import Std.Data.HashSet +public import Errata.Result + +public section + +set_option linter.missingDocs true +set_option doc.verso true + +namespace Errata + +open Std (HashMap HashSet) + +/-- A multi-map from option names to all the values supplied for them. -/ +abbrev OptionMap := HashMap String (Array String) + +/-- The run-wide configuration and per-test state threaded through every test. -/ +structure Context where + /-- Whether to report passing results, not only failures. -/ + verbose : Bool := false + /-- Whether golden checks rewrite their expected files instead of comparing. -/ + updateGolden : Bool := false + /-- Project-specific options, as a multi-map so repeated options accumulate. -/ + options : OptionMap := {} + /-- The seed used for property tests. -/ + seed : Nat := 0 + /-- The package that defines the running test. -/ + package : String := "" + /-- The module that defines the running test, as a dotted name. -/ + moduleName : String := "" + /-- The running test declaration's name below its module. -/ + test : String := "" + /-- The named result currently being recorded, below the test. -/ + resultPath : Array String := #[] + /-- The results collected so far during the current test. -/ + log : IO.Ref (Array Result) + /-- The option names read during the run, shared across all tests, for reporting unused options. -/ + usedOptions : IO.Ref (HashSet String) diff --git a/src/errata/Errata/Discovery.lean b/src/errata/Errata/Discovery.lean new file mode 100644 index 000000000..73200a59f --- /dev/null +++ b/src/errata/Errata/Discovery.lean @@ -0,0 +1,46 @@ +/- +Copyright (c) 2026 Lean FRO LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Author: David Thrane Christiansen +-/ +module + +public import Errata.IsTest +public import Errata.Runner +public import Lean + +open Lean Meta + +public section + +set_option linter.missingDocs true +set_option doc.verso true + +namespace Errata + +/-- +Verifies that a tagged declaration can be run as a test: it is not {lit}`meta`, and it has an +{name}`IsTest` instance. +-/ +def checkIsTest (decl : Name) : MetaM Unit := do + let env ← getEnv + if isMarkedMeta env decl then + throwError m!"A test must not be `meta`" + let info ← getConstInfo decl + let goal := mkApp (mkConst ``IsTest) info.type + match ← trySynthInstance goal with + | .some _ => pure () + | _ => + throwError m!"`@[test]` requires an `Errata.IsTest` instance for the test's type{indentExpr info.type}" + +/-- The attribute that marks Errata tests, holding the tagged declarations per module. -/ +initialize testAttr : TagAttribute ← + registerTagAttribute `test + "Marks a definition as a test, discovered and run by the Errata test runner." + (validate := fun decl => (checkIsTest decl).run') + +/-- The internal names of the Errata tests defined directly in a module. -/ +def testsInModule (env : Environment) (moduleName : Name) : Array Name := + match env.getModuleIdx? moduleName with + | some idx => testAttr.ext.getModuleEntries env idx + | none => #[] diff --git a/src/errata/Errata/Golden.lean b/src/errata/Errata/Golden.lean new file mode 100644 index 000000000..b5152abed --- /dev/null +++ b/src/errata/Errata/Golden.lean @@ -0,0 +1,87 @@ +/- +Copyright (c) 2026 Lean FRO LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Author: David Thrane Christiansen +-/ +module + +public import Errata.TestM +import Lean.Util.Diff + +public section + +set_option linter.missingDocs true +set_option doc.verso true + +namespace Errata + +/-- +A line-by-line diff of expected against actual output. Lines marked {lit}`-` are in the expected +output only, and lines marked {lit}`+` are in the actual output only. +-/ +private def goldenDiff (expected actual : String) : String := + let diff := Lean.Diff.diff (expected.splitOn "\n").toArray (actual.splitOn "\n").toArray + "- expected, + actual:\n" ++ Lean.Diff.linesToString diff + +/-- Compares a produced string against a golden file, or rewrites it under `--update-golden`. -/ +def goldenFile (expected : System.FilePath) (actual : String) : TestM Unit := do + let ctx ← read + if ctx.updateGolden then + if let some parent := expected.parent then IO.FS.createDirAll parent + IO.FS.writeFile expected actual + else if ← expected.pathExists then + let want ← IO.FS.readFile expected + unless want == actual do + fail s!"golden mismatch for {expected}" + (detail? := some (goldenDiff want actual)) + else + fail s!"missing golden file {expected}" + (detail? := some "Run with --update-golden to create it.") + +/-- All files below a directory, recursively. -/ +partial def filesUnder (dir : System.FilePath) : IO (Array System.FilePath) := do + let mut out : Array System.FilePath := #[] + for entry in ← dir.readDir do + if ← entry.path.isDir then + out := out ++ (← filesUnder entry.path) + else + out := out.push entry.path + return out + +/-- The path of a file relative to a base directory. -/ +private def relativeTo (base file : System.FilePath) : String := + (file.toString.drop (base.toString.length + 1)).copy + +/-- Compares a produced directory tree against a golden tree, or rewrites it under `--update-golden`. -/ +def goldenDir (expected actual : System.FilePath) : TestM Unit := do + let ctx ← read + let actualFiles ← filesUnder actual + if ctx.updateGolden then + let actualRels := actualFiles.map (relativeTo actual) + for file in actualFiles do + let dest := expected / relativeTo actual file + if let some parent := dest.parent then IO.FS.createDirAll parent + IO.FS.writeFile dest (← IO.FS.readFile file) + -- Remove expected files that the produced output no longer contains. + if ← expected.pathExists then + for file in ← filesUnder expected do + unless actualRels.contains (relativeTo expected file) do + IO.FS.removeFile file + return + unless ← expected.pathExists do + fail s!"missing golden directory {expected}" + (detail? := some "Run with --update-golden to create it.") + for file in actualFiles do + let rel := relativeTo actual file + let want := expected / rel + unless ← want.pathExists do + fail s!"file not present in the golden directory: {rel}" + let wantContent ← IO.FS.readFile want + let gotContent ← IO.FS.readFile file + unless wantContent == gotContent do + fail s!"golden mismatch for {rel}" + (detail? := some (goldenDiff wantContent gotContent)) + for file in ← filesUnder expected do + let rel := relativeTo expected file + unless ← (actual / rel).pathExists do + fail s!"file missing from the produced output: {rel}" diff --git a/src/errata/Errata/Here.lean b/src/errata/Errata/Here.lean new file mode 100644 index 000000000..d6800db64 --- /dev/null +++ b/src/errata/Errata/Here.lean @@ -0,0 +1,32 @@ +/- +Copyright (c) 2026 Lean FRO LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Author: David Thrane Christiansen +-/ +module + +public import Errata.Result +public meta import Lean + +open Lean Elab Term + +public section + +set_option doc.verso true + +/-- +`here%` elaborates to the {name}`Errata.Location` of its own occurrence. Used as a default argument +(`by exact here%`), it is elaborated at each call site, so it captures the caller's position. +-/ +syntax (name := hereStx) "here%" : term + +@[term_elab hereStx] +meta def elabHere : TermElab := fun _stx _expectedType? => do + let ref ← getRef + let fileMap ← getFileMap + let startPos := fileMap.toPosition (ref.getPos?.getD 0) + let endPos := fileMap.toPosition (ref.getTailPos?.getD (ref.getPos?.getD 0)) + let moduleName := (← getMainModule).toString + elabTerm (← `(Errata.Location.mk $(quote moduleName) + (Errata.Position.mk $(quote startPos.line) $(quote startPos.column)) + (Errata.Position.mk $(quote endPos.line) $(quote endPos.column)))) none diff --git a/src/errata/Errata/IsTest.lean b/src/errata/Errata/IsTest.lean new file mode 100644 index 000000000..0a14205ae --- /dev/null +++ b/src/errata/Errata/IsTest.lean @@ -0,0 +1,42 @@ +/- +Copyright (c) 2026 Lean FRO LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Author: David Thrane Christiansen +-/ +module + +public import Errata.TestM +public import Errata.Result + +public section + +set_option linter.missingDocs true +set_option doc.verso true + +namespace Errata + +/-- Runs a returned verdict as a test action. -/ +def TestResult.toTest : TestResult → TestM Unit + | .pass => pure () + | .fail f => throw f + | .skip reason => Errata.skip reason + +/-- Types that can serve as the body of a test. -/ +class IsTest (α : Type) where + /-- Runs the value as a test action. -/ + toTest : α → TestM Unit + +instance : IsTest (TestM Unit) where + toTest act := act + +instance : IsTest TestResult where + toTest := TestResult.toTest + +instance : IsTest (IO TestResult) where + toTest act := do (← act).toTest + +instance : IsTest Bool where + toTest b := unless b do fail "expected true, got false" + +instance : IsTest (IO Bool) where + toTest act := do unless (← act) do fail "expected true, got false" diff --git a/src/errata/Errata/Process.lean b/src/errata/Errata/Process.lean new file mode 100644 index 000000000..976f7cae0 --- /dev/null +++ b/src/errata/Errata/Process.lean @@ -0,0 +1,23 @@ +/- +Copyright (c) 2026 Lean FRO LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Author: David Thrane Christiansen +-/ +module + +public import Errata.TestM +public import Errata.Here + +public section + +set_option linter.missingDocs true +set_option doc.verso true + +namespace Errata + +/-- Asserts that a process exited with the expected code, showing its error output otherwise. -/ +def assertExitCode (expected : UInt32) (output : IO.Process.Output) + (loc : Location := by exact here%) : TestM Unit := + unless output.exitCode == expected do + fail s!"process exited with code {output.exitCode}, expected {expected}" + (detail? := some s!"stderr:\n{output.stderr}") (location? := some loc) diff --git a/src/errata/Errata/Property.lean b/src/errata/Errata/Property.lean new file mode 100644 index 000000000..0f378b477 --- /dev/null +++ b/src/errata/Errata/Property.lean @@ -0,0 +1,34 @@ +/- +Copyright (c) 2026 Lean FRO LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Author: David Thrane Christiansen +-/ + +module + +public import Errata.TestM +public import Plausible +public import Plausible.ArbitraryFueled + +public section + +set_option linter.missingDocs true +set_option doc.verso true + +namespace Errata + +open Plausible + +open scoped Plausible.Decorations in +/-- Checks a property with Plausible, failing with the counterexample if it is falsified. -/ +def property (p : Prop) (cfg : Configuration := {}) + (p' : Decorations.DecorationsOf p := by mk_decorations) [Testable p'] : TestM Unit := do + let ctx ← read + let cfg := { cfg with + quiet := true, + randomSeed := if ctx.seed == 0 then cfg.randomSeed else some ctx.seed } + match ← Testable.checkIO p' (cfg := cfg) with + | .success _ => pure () + | .gaveUp n => fail s!"property gave up after discarding {n} cases" + | .failure _ counterExample _ => + fail "property falsified" (detail? := some ("\n".intercalate counterExample)) diff --git a/src/errata/Errata/Report.lean b/src/errata/Errata/Report.lean new file mode 100644 index 000000000..a659a3147 --- /dev/null +++ b/src/errata/Errata/Report.lean @@ -0,0 +1,164 @@ +/- +Copyright (c) 2026 Lean FRO LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Author: David Thrane Christiansen +-/ +module + +public import Errata.Result +public import Lean.Data.Json + +public section + +open Lean (Json ToJson FromJson) + +set_option linter.missingDocs true +set_option doc.verso true + +namespace Errata + +/-- The number of failed or errored results. -/ +def failureCount (results : Array Result) : Nat := + results.foldl (fun n r => if r.status.isSuccess then n else n + 1) 0 + +private def indentLines (text : String) : String := + "\n".intercalate ((text.splitOn "\n").map (fun l => " " ++ l)) + +/-- Prints a human-readable report and returns the number of failures. -/ +def humanReport (verbose : Bool) (results : Array Result) : IO Nat := do + let mut passed := 0 + let mut failed := 0 + let mut errored := 0 + let mut skipped := 0 + for r in results do + let name := s!"{r.moduleTarget} {r.testName}" + match r.status with + | .pass => + passed := passed + 1 + if verbose then IO.println s!"ok {name} ({r.durationMs}ms)" + | .skip reason => + skipped := skipped + 1 + if verbose then IO.println s!"skip {name}: {reason}" + | .fail f => + failed := failed + 1 + IO.println s!"FAIL {name}: {f.message}" + if let some d := f.detail? then IO.println (indentLines d) + | .error m => + errored := errored + 1 + IO.println s!"ERROR {name}: {m}" + IO.println s!"{passed} passed, {failed} failed, {errored} errored, {skipped} skipped" + return failed + errored + +private def xmlEscape (s : String) : String := + s.replace "&" "&" |>.replace "<" "<" |>.replace ">" ">" + |>.replace "\"" """ + +/-- A source span rendered as `module:line:col-line:col`. -/ +private def locationText (l : Location) : String := + s!"{l.moduleName}:{l.startPos.line}:{l.startPos.column}-{l.endPos.line}:{l.endPos.column}" + +instance : ToJson Location where + toJson l := json%{ + "module": $l.moduleName, + "startLine": $l.startPos.line, + "startColumn": $l.startPos.column, + "endLine": $l.endPos.line, + "endColumn": $l.endPos.column + } + +instance : FromJson Location where + fromJson? j := do + return { + moduleName := ← j.getObjValAs? String "module", + startPos := ⟨← j.getObjValAs? Nat "startLine", ← j.getObjValAs? Nat "startColumn"⟩, + endPos := ⟨← j.getObjValAs? Nat "endLine", ← j.getObjValAs? Nat "endColumn"⟩ } + +/-- The suite a result belongs to: its module. -/ +private def suiteOf (r : Result) : String := + r.moduleName + +/-- The case name of a result: the test name below the module. -/ +private def caseOf (r : Result) : String := + r.testName + +private def countWhere (results : Array Result) (p : Status → Bool) : Nat := + results.foldl (fun n r => if p r.status then n + 1 else n) 0 + +/-- Renders the results as JUnit XML, grouping by the module path. -/ +def junitReport (results : Array Result) : String := Id.run do + let suites := results.toList.map suiteOf |>.eraseDups + let mut out := "\n\n" + for suite in suites do + let cases := results.filter (fun r => suiteOf r == suite) + let pkg := (cases[0]?.map (·.package)).getD "" + let failures := countWhere cases (fun s => s matches .fail _) + let errors := countWhere cases (fun s => s matches .error _) + let skipped := countWhere cases (fun s => s matches .skip _) + out := out ++ s!" \n" + for r in cases do + let time := toString (Float.ofNat r.durationMs / 1000.0) + let opening := s!" " + match r.status with + | .pass => + out := out ++ opening ++ "\n" + | .fail f => + let loc := match f.location? with | some l => locationText l ++ ": " | none => "" + out := out ++ opening ++ s!"\n \ + {xmlEscape (f.detail?.getD "")}\n \n" + | .error m => + out := out ++ opening ++ s!"\n \n \n" + | .skip reason => + out := out ++ opening ++ s!"\n \n \n" + out := out ++ " \n" + out := out ++ "\n" + return out + +private def statusFields : Status → List (String × Json) + | .pass => [("status", Json.str "pass")] + | .fail f => + [("status", Json.str "fail"), ("message", Json.str f.message)] ++ + (match f.detail? with | some d => [("detail", Json.str d)] | none => []) ++ + (match f.location? with | some l => [("location", ToJson.toJson l)] | none => []) + | .error m => [("status", Json.str "error"), ("message", Json.str m)] + | .skip reason => [("status", Json.str "skip"), ("reason", Json.str reason)] + +instance : ToJson Result where + toJson r := private + Json.mkObj <| + [("package", Json.str r.package), ("module", Json.str r.moduleName), + ("test", Json.str r.test), ("resultPath", ToJson.toJson r.resultPath), + ("durationMs", ToJson.toJson r.durationMs)] ++ + statusFields r.status + +/-- Decodes an optional field: absent maps to {lean}`none`. -/ +private def optField [FromJson α] (j : Json) (key : String) : Except String (Option α) := + match j.getObjVal? key with + | .ok v => some <$> FromJson.fromJson? v + | .error _ => pure none + +instance : FromJson Status where + fromJson? j := private do + match ← j.getObjValAs? String "status" with + | "pass" => return .pass + | "error" => return .error (← j.getObjValAs? String "message") + | "skip" => return .skip (← j.getObjValAs? String "reason") + | "fail" => return .fail { + message := ← j.getObjValAs? String "message", + detail? := ← optField j "detail", + location? := ← optField j "location" } + | other => .error s!"unknown status: {other}" + +instance : FromJson Result where + fromJson? j := do + return { + package := ← j.getObjValAs? String "package", + moduleName := ← j.getObjValAs? String "module", + test := ← j.getObjValAs? String "test", + resultPath := ← j.getObjValAs? (Array String) "resultPath", + durationMs := ← j.getObjValAs? Nat "durationMs", + status := ← FromJson.fromJson? j } + +/-- Renders the results as a JSON array of objects. -/ +def jsonReport (results : Array Result) : String := (ToJson.toJson results).pretty diff --git a/src/errata/Errata/Result.lean b/src/errata/Errata/Result.lean new file mode 100644 index 000000000..f2b79456b --- /dev/null +++ b/src/errata/Errata/Result.lean @@ -0,0 +1,107 @@ +/- +Copyright (c) 2026 Lean FRO LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Author: David Thrane Christiansen +-/ +module + +public section + +set_option linter.missingDocs true +set_option doc.verso true + +namespace Errata + +/-- A line and column within a source file, counting from one. -/ +structure Position where + /-- The line, counting from one. -/ + line : Nat + /-- The column, counting from one. -/ + column : Nat +deriving Repr, Inhabited, BEq, DecidableEq + +/-- A source span, used in failure messages and editor integration. -/ +structure Location where + /-- The module that contains the span, rendered as a string. -/ + moduleName : String + /-- The start of the span. -/ + startPos : Position + /-- The end of the span. -/ + endPos : Position +deriving Repr, Inhabited, BEq, DecidableEq + +/-- A test failure, carrying the information needed to explain it. -/ +structure TestFailure where + /-- A short description of what went wrong. -/ + message : String + /-- Supporting detail, such as a diff, a counterexample, or expected and actual values. -/ + detail? : Option String := none + /-- The source location of the failed check, when known. -/ + location? : Option Location := none +deriving Repr, Inhabited, DecidableEq + +/-- The verdict that a test body may return. -/ +inductive TestResult where + /-- The test passed. -/ + | pass + /-- The test failed, with details. -/ + | fail (failure : TestFailure) + /-- The test was skipped, with a reason. -/ + | skip (reason : String) +deriving Repr, Inhabited + +/-- The recorded outcome of a test or a named result. -/ +inductive Status where + /-- The check passed. -/ + | pass + /-- The check failed. -/ + | fail (failure : TestFailure) + /-- An error escaped the check, so it could not produce a verdict. -/ + | error (message : String) + /-- The check was skipped. -/ + | skip (reason : String) +deriving Repr, Inhabited, DecidableEq + +/-- Whether a status counts as success for the exit code. -/ +def Status.isSuccess : Status → Bool + | .pass | .skip _ => true + | .fail _ | .error _ => false + +/-- One entry collected during a run and rendered by the reporters. -/ +structure Result where + /-- The package that defines the test. -/ + package : String + /-- The module that defines the test, as a dotted name. -/ + moduleName : String + /-- The test declaration's name below its module, as a dotted name. -/ + test : String + /-- The named result below the test; empty for the test's own result. -/ + resultPath : Array String := #[] + /-- The recorded outcome. -/ + status : Status + /-- How long the check took, in milliseconds. -/ + durationMs : Nat := 0 +deriving Repr, Inhabited, DecidableEq + +/-- The test name below the module: the declaration and any named result, dotted. -/ +def Result.testName (result : Result) : String := + if result.resultPath.isEmpty then result.test + else result.test ++ "." ++ ".".intercalate result.resultPath.toList + +/-- +The module as a Lake target specification ({lit}`package/module`). This is the unit of execution: +passing it to {lit}`lake test` re-runs the module that produced the result. +-/ +def Result.moduleTarget (result : Result) : String := + result.package ++ "/" ++ result.moduleName + +/-- A failed verdict from a compile-time message mismatch, carrying its source span. -/ +def TestResult.mismatch (message detail moduleName : String) + (startLine startCol endLine endCol : Nat) : TestResult := + .fail { + message, + detail? := some detail, + location? := some { + moduleName, + startPos := { line := startLine, column := startCol }, + endPos := { line := endLine, column := endCol } } } diff --git a/src/errata/Errata/Runner.lean b/src/errata/Errata/Runner.lean new file mode 100644 index 000000000..6afce9103 --- /dev/null +++ b/src/errata/Errata/Runner.lean @@ -0,0 +1,169 @@ +/- +Copyright (c) 2026 Lean FRO LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Author: David Thrane Christiansen +-/ +module + +public import Errata.TestM +public import Errata.IsTest +public import Errata.Report + +public section + +set_option linter.missingDocs true +set_option doc.verso true + +namespace Errata + +/-- A test to run: its identity and the action that produces its results. -/ +structure TestEntry where + /-- The package that defines the test. -/ + package : String + /-- The module that defines the test, as a dotted name. -/ + moduleName : String + /-- The test declaration's name below its module. -/ + test : String + /-- The action to run. -/ + run : TestM Unit + +/-- Builds a test entry from any testable value. -/ +def TestEntry.of {α} [IsTest α] (package moduleName test : String) (value : α) : TestEntry where + package := package + moduleName := moduleName + test := test + run := IsTest.toTest value + +/-- Runs a single test entry, collecting all of its results. -/ +def runEntry (cfg : Context) (entry : TestEntry) : IO (Array Result) := do + let log ← IO.mkRef (#[] : Array Result) + let ctx := { cfg with + package := entry.package, moduleName := entry.moduleName, test := entry.test, + resultPath := #[], log } + let start ← IO.monoMsNow + let outcome ← ((entry.run ctx).run).toBaseIO + let stop ← IO.monoMsNow + let dur := stop - start + let logged ← log.get + match outcome with + | .error e => return logged.push (ctx.error (toString e) dur) + | .ok (.error f) => return logged.push (ctx.fail f dur) + | .ok (.ok ()) => + if logged.isEmpty then return #[ctx.pass dur] else return logged + +/-- Runs all the test entries and collects their results. -/ +def run (cfg : Context) (entries : Array TestEntry) : IO (Array Result) := do + let mut all : Array Result := #[] + for entry in entries do + all := all ++ (← runEntry cfg entry) + return all + +/-- A base context with the given settings and a fresh, empty log. -/ +def mkContext (verbose : Bool := false) (updateGolden : Bool := false) + (options : OptionMap := {}) (seed : Nat := 0) : IO Context := do + let log ← IO.mkRef (#[] : Array Result) + let usedOptions ← IO.mkRef ({} : Std.HashSet String) + return { verbose, updateGolden, options, seed, log, usedOptions } + +/-- The settings parsed from the runner's command line. -/ +structure Options where + /-- Reports passing results, not only failures. -/ + verbose : Bool := false + /-- Rewrites golden expected files instead of comparing. -/ + updateGolden : Bool := false + /-- The seed for property tests, for reproducing a failure. -/ + seed : Option Nat := none + /-- Writes a JUnit XML report to this path. -/ + junitPath : Option String := none + /-- Writes a JSON report to this path. -/ + jsonPath : Option String := none + /-- Project-specific options, as a multi-map so repeated options accumulate. -/ + options : OptionMap := {} + /-- Prints usage information instead of running the tests. -/ + help : Bool := false + +/-- +{given}`name : String, value : String` + +Parses arguments into {lean}`(name, value)` pairs. + +A long option is {lit}`--name`, {lit}`--name=value`, or {lit}`--name value`, taking the next token as +its value unless that token is itself an option. Short options bundle: {lit}`-xyz` is equivalent to +{lit}`--x --y --z`, and the last may take a following value. Any other argument is rejected. +-/ +partial def rawOptions : List String → Except String (List (String × String)) + | [] => .ok [] + | arg :: rest => + if let some arg := arg.dropPrefix? "--" then + match arg.copy.splitOn "=" with + | [] => unreachable! -- `splitOn` always returns at least one element + | [name] => + if name.isEmpty then .error s!"unexpected argument: {arg}" + else match rest with + | value :: rest' => + if value.startsWith "-" then (((name, "") :: ·)) <$> rawOptions rest + else (((name, value) :: ·)) <$> rawOptions rest' + | [] => .ok [(name, "")] + | [name, value] => + if name.isEmpty then .error s!"unexpected argument: {arg}" + else (((name, value) :: ·)) <$> rawOptions rest + | _ => .error s!"unexpected argument: {arg}" + else if arg.startsWith "-" && arg.length > 1 then + -- Expand bundled short flags: `-xyz` becomes `--x --y --z`. + let expanded := (arg.drop 1).copy.toList.map (fun c => "--" ++ toString c) + rawOptions (expanded ++ rest) + else + .error s!"unexpected argument: {arg}" + +/-- Parses the runner's command-line arguments, peeling off known flags and keeping the rest as +project options. -/ +def parseArgs (args : List String) : Except String Options := do + let raw ← rawOptions args + let mut opts : Options := {} + for (name, value) in raw do + match name with + | "verbose" | "v" => opts := { opts with verbose := true } + | "update-golden" => opts := { opts with updateGolden := true } + | "seed" => + match value.toNat? with + | some n => opts := { opts with seed := some n } + | none => throw s!"--seed expects a natural number, got '{value}'" + | "junit" => + if value.isEmpty then throw "--junit expects a path" + opts := { opts with junitPath := some value } + | "json" => + if value.isEmpty then throw "--json expects a path" + opts := { opts with jsonPath := some value } + | "help" | "h" => opts := { opts with help := true } + | _ => + let prev := opts.options.getD name #[] + opts := { opts with options := opts.options.insert name (prev.push value) } + return opts + +/-- Usage information for the test runner, shown for {lit}`--help`. -/ +def usage : String := include_str "usage.txt" + +/-- The entry point the generated runner calls: parse arguments, run the tests, and report. -/ +def runMain (entries : Array TestEntry) (args : List String) : IO UInt32 := do + let opts ← + match parseArgs args with + | .ok opts => pure opts + | .error msg => + IO.eprintln s!"error: {msg}" + IO.eprintln usage + return 1 + if opts.help then + IO.println usage + return 0 + let cfg ← mkContext (verbose := opts.verbose) (updateGolden := opts.updateGolden) + (options := opts.options) (seed := opts.seed.getD 0) + let results ← run cfg entries + if let some path := opts.junitPath then IO.FS.writeFile path (junitReport results) + if let some path := opts.jsonPath then IO.FS.writeFile path (jsonReport results) + let failures ← humanReport opts.verbose results + -- Warn about options that were supplied but never read by any test (typos, removed flags). + let used ← cfg.usedOptions.get + let unused := opts.options.toList.filterMap fun (k, _) => if used.contains k then none else some k + unless unused.isEmpty do + IO.eprintln s!"warning: option(s) provided but never read: {", ".intercalate unused}" + return UInt32.ofNat failures diff --git a/src/errata/Errata/TestM.lean b/src/errata/Errata/TestM.lean new file mode 100644 index 000000000..0972d3eab --- /dev/null +++ b/src/errata/Errata/TestM.lean @@ -0,0 +1,115 @@ +/- +Copyright (c) 2026 Lean FRO LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Author: David Thrane Christiansen +-/ +module + +public import Errata.Context +public import Errata.Result + +public section + +set_option linter.missingDocs true +set_option doc.verso true + +namespace Errata + +/-- +The monad in which tests run. + +The reader carries the configuration and the result log; the exception layer carries a structured +failure, which the interpreter distinguishes from an {name}`IO.Error` that escapes. +-/ +abbrev TestM := ReaderT Context (ExceptT TestFailure IO) + +/-- Fails the current test, or named result, with a message and optional detail. -/ +def fail (message : String) (detail? : Option String := none) + (location? : Option Location := none) : TestM α := + throw { message, detail?, location? } + +/-- All values supplied for a project option, in order; records that the option was read. -/ +def optionValues (name : String) : TestM (Array String) := do + let ctx ← read + ctx.usedOptions.modify (·.insert name) + return ctx.options.getD name #[] + +/-- The last value supplied for a project option, if any; records that the option was read. -/ +def option? (name : String) : TestM (Option String) := + return (← optionValues name).back? + +/-- Whether a project option is present and not set to an explicit false value; records the read. -/ +def flag (name : String) : TestM Bool := + return match (← optionValues name).back? with + | some v => v != "false" && v != "0" && v != "no" + | none => false + +/-- Builds a result for the current scope with the given status and duration. -/ +def Context.mkResult (ctx : Context) (status : Status) (durationMs : Nat := 0) : Result := + { package := ctx.package, moduleName := ctx.moduleName, test := ctx.test, + resultPath := ctx.resultPath, status, durationMs } + +/-- A passing result for the current scope. -/ +def Context.pass (ctx : Context) (durationMs : Nat := 0) : Result := + ctx.mkResult .pass durationMs + +/-- A failed result for the current scope. -/ +def Context.fail (ctx : Context) (failure : TestFailure) (durationMs : Nat := 0) : Result := + ctx.mkResult (.fail failure) durationMs + +/-- An errored result for the current scope. -/ +def Context.error (ctx : Context) (message : String) (durationMs : Nat := 0) : Result := + ctx.mkResult (.error message) durationMs + +/-- A skipped result for the current scope. -/ +def Context.skip (ctx : Context) (reason : String) (durationMs : Nat := 0) : Result := + ctx.mkResult (.skip reason) durationMs + +/-- Records a skipped result for the current scope. -/ +def skip (reason : String) : TestM Unit := do + let ctx ← read + ctx.log.modify (·.push (ctx.skip reason)) + +/-- Runs a test action, capturing its outcome as data rather than letting it propagate. -/ +def captureOutcome (act : TestM Unit) : + TestM (Except IO.Error (Except TestFailure Unit)) := do + let ctx ← read + let outcome ← ((act ctx).run).toBaseIO + pure outcome + +/-- +Runs a named result within the current test. + +Its path extends the current path, and its failure is isolated from sibling results. If the action +records no nested results and completes, it contributes one passing result; if it throws, it +contributes one failed or errored result. +-/ +def result (name : String) (act : TestM Unit) : TestM Unit := + withReader (fun c => { c with resultPath := c.resultPath.push name }) do + let ctx ← read + let before := (← ctx.log.get).size + let start ← IO.monoMsNow + let outcome ← captureOutcome act + let stop ← IO.monoMsNow + let dur := stop - start + let after := (← ctx.log.get).size + match outcome with + | .error e => + ctx.log.modify (·.push (ctx.error (toString e) dur)) + | .ok (.error f) => + ctx.log.modify (·.push (ctx.fail f dur)) + | .ok (.ok ()) => + if after == before then + ctx.log.modify (·.push (ctx.pass dur)) + +/-- +Expects the action to fail an assertion. The current scope passes if it does and fails if it +succeeds. An escaping {name}`IO.Error` is not an expected failure: it propagates and is reported as an +error, so broken setup is not mistaken for a passing negative test. +-/ +def expectFail (act : TestM Unit) : TestM Unit := do + try + act + catch _ => + return + fail "expected the action to fail, but it passed" diff --git a/src/errata/Errata/usage.txt b/src/errata/Errata/usage.txt new file mode 100644 index 000000000..ba281ddd9 --- /dev/null +++ b/src/errata/Errata/usage.txt @@ -0,0 +1,16 @@ +Errata test runner + +Usage: + lake test run every test in the package + lake test -- MODULE... run the tests in the given modules + lake test -- MODULE... -- OPTION... pass runner options after a second `--` + +Modules use Lake target syntax. Runner options: + -v, --verbose Report passing results, not only failures. + --update-golden Rewrite golden expected files instead of comparing. + --seed N Seed property tests with N, to reproduce a failure. + --junit PATH Write a JUnit XML report to PATH. + --json PATH Write a JSON report to PATH. + -h, --help Show this help and exit. + +Any other `--name value` option is passed through to the tests. diff --git a/src/errata/ErrataEnumerateMain.lean b/src/errata/ErrataEnumerateMain.lean new file mode 100644 index 000000000..c60fb2e7f --- /dev/null +++ b/src/errata/ErrataEnumerateMain.lean @@ -0,0 +1,39 @@ +/- +Copyright (c) 2026 Lean FRO LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Author: David Thrane Christiansen + +Enumerates the Errata tests defined in a module as a JSON array of their user-facing names. The +Errata test driver runs this per module to discover tests without a hand-maintained list. +-/ +module + +import Errata +import Lean + +set_option doc.verso true + +open Lean Errata + +/-- Imports a module and returns the user-facing names of the Errata tests it defines. -/ +def enumerate (moduleName : String) : IO (Array String) := do + initSearchPath (← findSysroot) + let name := moduleName.toName + let env ← importModules #[{ module := name }] {} (trustLevel := 1024) + return (testsInModule env name).map fun decl => (privateToUserName decl).toString + +/-- Enumerates a module's tests, writing or printing the JSON manifest. -/ +public def main (args : List String) : IO UInt32 := do + match args with + | [moduleName, outPath] => + let tests ← enumerate moduleName + if let some parent := (System.FilePath.mk outPath).parent then + IO.FS.createDirAll parent + IO.FS.writeFile outPath ((toJson tests).pretty ++ "\n") + return 0 + | [moduleName] => + IO.println (toJson (← enumerate moduleName)).pretty + return 0 + | _ => + IO.eprintln "usage: errata-enumerate MODULE [OUTPUT]" + return 1 From 805a92441ca69e84b31472041f17decc4899af6a Mon Sep 17 00:00:00 2001 From: David Thrane Christiansen Date: Wed, 24 Jun 2026 14:59:39 +0200 Subject: [PATCH 02/26] chore: migrate BuildLog tests --- lakefile.lean | 40 ++++++++-- src/errata-tests/ErrataTests.lean | 40 ++++++---- src/errata/Errata/Assertions.lean | 15 ++-- src/errata/Errata/Context.lean | 5 ++ src/errata/Errata/Golden.lean | 20 ++--- src/errata/Errata/IsTest.lean | 4 +- src/errata/Errata/Process.lean | 4 +- src/errata/Errata/Property.lean | 6 +- src/errata/Errata/Report.lean | 29 +++++++- src/errata/Errata/Result.lean | 42 +++++++++++ src/errata/Errata/Runner.lean | 14 ++-- src/errata/Errata/TestM.lean | 74 +++++++++++++++---- src/errata/ErrataEnumerateMain.lean | 20 +++-- src/tests/VersoTests.lean | 11 +++ src/tests/VersoTests/BuildLog.lean | 110 ++++++++++++++++++++++++++++ 15 files changed, 359 insertions(+), 75 deletions(-) create mode 100644 src/tests/VersoTests.lean create mode 100644 src/tests/VersoTests/BuildLog.lean diff --git a/lakefile.lean b/lakefile.lean index 95979cca5..e70e0c2c8 100644 --- a/lakefile.lean +++ b/lakefile.lean @@ -167,6 +167,12 @@ lean_lib ErrataTests where srcDir := "src/errata-tests" roots := #[`ErrataTests] +-- Errata ports of the Verso test suite. Submodules are globbed so each feature is discoverable. +lean_lib VersoTests where + srcDir := "src/tests" + roots := #[`VersoTests] + globs := #[Glob.andSubmodules `VersoTests] + -- The generated discovered-tests module (`allTests`), written by the Errata driver. lean_lib ErrataGenerated where srcDir := ".lake/errata-runner" @@ -185,26 +191,44 @@ private def errataTestName (moduleName declName : Lean.Name) : String := let below := if moduleName.isPrefixOf declName then declComps.drop modComps.length else declComps ".".intercalate (below.map (·.toString)) -/-- Parse a per-module JSON manifest into the tests' user-facing names. -/ -private def errataParseManifest (content : String) : Array String := +/-- A discovered test: its user-facing name and its source range. -/ +private structure ErrataTest where + name : String + startLine : Nat + startColumn : Nat + endLine : Nat + endColumn : Nat + +/-- Parse a per-module JSON manifest into the tests' names and source ranges. -/ +private def errataParseManifest (content : String) : Array ErrataTest := match Lean.Json.parse content with | .error _ => #[] | .ok json => match json.getArr? with | .error _ => #[] - | .ok arr => arr.filterMap fun j => (j.getStr?).toOption + | .ok arr => arr.filterMap fun j => do + return { + name := ← (j.getObjValAs? String "name").toOption + startLine := ← (j.getObjValAs? Nat "startLine").toOption + startColumn := ← (j.getObjValAs? Nat "startColumn").toOption + endLine := ← (j.getObjValAs? Nat "endLine").toOption + endColumn := ← (j.getObjValAs? Nat "endColumn").toOption + } /-- Generate the discovered-tests module: `import all` the test modules and collect their tests. -/ private def errataDiscoveredSource (packageName : String) - (mods : Array (Lean.Name × Array String)) : String := Id.run do + (mods : Array (Lean.Name × Array ErrataTest)) : String := Id.run do let mut imports := #["public import Errata"] let mut entries : Array String := #[] for (moduleName, tests) in mods do imports := imports.push s!"import all {moduleName}" - for name in tests do - let test := errataTestName moduleName name.toName + for t in tests do + let test := errataTestName moduleName t.name.toName + let loc := s!"(Errata.Location.mk \"{moduleName}\" \ + (Errata.Position.mk {t.startLine} {t.startColumn}) \ + (Errata.Position.mk {t.endLine} {t.endColumn}))" entries := entries.push - s!" Errata.TestEntry.of \"{packageName}\" \"{moduleName}\" \"{test}\" (@{name})" + s!" Errata.TestEntry.of \"{packageName}\" \"{moduleName}\" \"{test}\" {loc} (@{t.name})" let header := "\n".intercalate imports.toList let body := ",\n".intercalate entries.toList return s!"module\n\n{header}\n\n\ @@ -272,7 +296,7 @@ script «errata-test» (args) do unless allNames.any (fun n => n.toString == spec || n.toString.startsWith (spec ++ ".")) do IO.eprintln s!"error: no module matches '{spec}'" return 1 - let mut mods : Array (Lean.Name × Array String) := #[] + let mut mods : Array (Lean.Name × Array ErrataTest) := #[] for (moduleName, path) in perModule do let tests := errataParseManifest (← IO.FS.readFile path) unless tests.isEmpty do diff --git a/src/errata-tests/ErrataTests.lean b/src/errata-tests/ErrataTests.lean index 2251be132..0f1214e10 100644 --- a/src/errata-tests/ErrataTests.lean +++ b/src/errata-tests/ErrataTests.lean @@ -13,34 +13,41 @@ public meta import Errata open Errata /-- A bare boolean is a passing test. -/ -@[test] def onePlusOne : Bool := 1 + 1 == 2 +@[test] +def onePlusOne : Bool := 1 + 1 == 2 /-- An assertion-based test. -/ -@[test] def equality : TestM Unit := do - assertEq (expected := 4) (actual := 2 + 2) +@[test] +def equality : TestM Unit := do + assertEq 4 (2 + 2) /-- A test with named results. -/ -@[test] def named : TestM Unit := do +@[test] +def named : TestM Unit := do result "first" (assertEq 1 1) - result "second" (assertContains (expected := "b") (actual := "abc")) + result "second" (assertContains "b" "abc") /-- A test that completes without any check is a bare success. -/ -@[test] def emptyBody : TestM Unit := pure () +@[test] +def emptyBody : TestM Unit := pure () /-- A test that expects a failure. -/ -@[test] def expectsFailure : TestM Unit := +@[test] +def expectsFailure : TestM Unit := expectFail (assertEq 1 2) /-- A data-driven family expressed as a plain loop. -/ -@[test] def squares : TestM Unit := do +@[test] +def squares : TestM Unit := do for (n, sq) in [(1, 1), (2, 4), (3, 9)] do - result s!"square {n}" (assertEq (expected := sq) (actual := n * n)) + result s!"square {n}" (assertEq sq (n * n)) /-- A subprocess test. -/ -@[test] def echoRuns : TestM Unit := do +@[test] +def echoRuns : TestM Unit := do let out ← IO.Process.output { cmd := "echo", args := #["hello"] } assertExitCode 0 out - assertContains (expected := "hello") (actual := out.stdout) + assertContains "hello" out.stdout /-- info: 3 -/ #test_msgs in @@ -53,7 +60,8 @@ set_option doc.verso true in #eval 3 + 4 /-- A property test. -/ -@[test] def addComm : TestM Unit := +@[test] +def addComm : TestM Unit := property (∀ a b : Nat, a + b = b + a) open Lean (toJson fromJson?) @@ -62,14 +70,18 @@ deriving instance Plausible.Shrinkable, Plausible.Arbitrary for Position deriving instance Plausible.Shrinkable, Plausible.Arbitrary for Location deriving instance Plausible.Shrinkable, Plausible.Arbitrary for TestFailure deriving instance Plausible.Shrinkable, Plausible.Arbitrary for Status +deriving instance Plausible.Shrinkable, Plausible.Arbitrary for Output +deriving instance Plausible.Shrinkable, Plausible.Arbitrary for OutputLog deriving instance Plausible.Shrinkable, Plausible.Arbitrary for Result /-- The JSON encoding of a result round-trips: decoding the encoding recovers the result. -/ -@[test] def jsonRoundTrips : TestM Unit := +@[test] +def jsonRoundTrips : TestM Unit := property (∀ r : Result, (fromJson? (toJson r)).toOption = some r) /-- A temp-directory fixture with a golden file. -/ -@[test] def goldenRoundTrip : TestM Unit := +@[test] +def goldenRoundTrip : TestM Unit := IO.FS.withTempDir fun dir => do let cfg ← read -- In update mode this would write; here we drive it through a temp golden file. diff --git a/src/errata/Errata/Assertions.lean b/src/errata/Errata/Assertions.lean index 4cea4b6a9..ec14e7758 100644 --- a/src/errata/Errata/Assertions.lean +++ b/src/errata/Errata/Assertions.lean @@ -18,33 +18,28 @@ namespace Errata /-- Asserts that a condition holds. -/ def assert (cond : Bool) (message : String := "assertion failed") (loc : Location := by exact here%) : TestM Unit := - unless cond do fail message (location? := some loc) + unless cond do failAt loc message /-- Asserts that the actual value equals the expected value, reporting both when they differ. -/ def assertEq {α} [BEq α] [Repr α] (expected actual : α) (loc : Location := by exact here%) : TestM Unit := unless actual == expected do - fail "values are not equal" - (detail? := some s!"expected: {repr expected}\nactual: {repr actual}") - (location? := some loc) + failAt loc "values are not equal" (detail? := some s!"expected: {repr expected}\nactual: {repr actual}") /-- Asserts that the actual value differs from the unexpected value. -/ def assertNe {α} [BEq α] [Repr α] (unexpected actual : α) (loc : Location := by exact here%) : TestM Unit := do if actual == unexpected then - fail "values are equal but should differ" - (detail? := some s!"both: {repr actual}") (location? := some loc) + failAt loc "values are equal but should differ" (detail? := some s!"both: {repr actual}") /-- Asserts that the actual string contains the expected substring. -/ def assertContains (expected actual : String) (loc : Location := by exact here%) : TestM Unit := unless (actual.splitOn expected).length > 1 do - fail "substring not found" - (detail? := some s!"expected to contain: {expected}\nactual: {actual}") - (location? := some loc) + failAt loc "substring not found" (detail? := some s!"expected to contain: {expected}\nactual: {actual}") /-- Asserts that a file exists. -/ def assertFileExists (path : System.FilePath) (loc : Location := by exact here%) : TestM Unit := do unless ← path.pathExists do - fail s!"file does not exist: {path}" (location? := some loc) + failAt loc s!"file does not exist: {path}" diff --git a/src/errata/Errata/Context.lean b/src/errata/Errata/Context.lean index bdd804fcd..a924ef309 100644 --- a/src/errata/Errata/Context.lean +++ b/src/errata/Errata/Context.lean @@ -39,6 +39,11 @@ structure Context where test : String := "" /-- The named result currently being recorded, below the test. -/ resultPath : Array String := #[] + /-- + The source location reported for the next failure. The runner seeds it with the test's own + source range; the assertion language refines it to each call site. + -/ + location : Location := default /-- The results collected so far during the current test. -/ log : IO.Ref (Array Result) /-- The option names read during the run, shared across all tests, for reporting unused options. -/ diff --git a/src/errata/Errata/Golden.lean b/src/errata/Errata/Golden.lean index b5152abed..2b16916e1 100644 --- a/src/errata/Errata/Golden.lean +++ b/src/errata/Errata/Golden.lean @@ -24,7 +24,8 @@ private def goldenDiff (expected actual : String) : String := "- expected, + actual:\n" ++ Lean.Diff.linesToString diff /-- Compares a produced string against a golden file, or rewrites it under `--update-golden`. -/ -def goldenFile (expected : System.FilePath) (actual : String) : TestM Unit := do +def goldenFile (expected : System.FilePath) (actual : String) + (loc : Location := by exact here%) : TestM Unit := do let ctx ← read if ctx.updateGolden then if let some parent := expected.parent then IO.FS.createDirAll parent @@ -32,10 +33,9 @@ def goldenFile (expected : System.FilePath) (actual : String) : TestM Unit := do else if ← expected.pathExists then let want ← IO.FS.readFile expected unless want == actual do - fail s!"golden mismatch for {expected}" - (detail? := some (goldenDiff want actual)) + failAt loc s!"golden mismatch for {expected}" (detail? := some (goldenDiff want actual)) else - fail s!"missing golden file {expected}" + failAt loc s!"missing golden file {expected}" (detail? := some "Run with --update-golden to create it.") /-- All files below a directory, recursively. -/ @@ -53,7 +53,8 @@ private def relativeTo (base file : System.FilePath) : String := (file.toString.drop (base.toString.length + 1)).copy /-- Compares a produced directory tree against a golden tree, or rewrites it under `--update-golden`. -/ -def goldenDir (expected actual : System.FilePath) : TestM Unit := do +def goldenDir (expected actual : System.FilePath) + (loc : Location := by exact here%) : TestM Unit := do let ctx ← read let actualFiles ← filesUnder actual if ctx.updateGolden then @@ -69,19 +70,18 @@ def goldenDir (expected actual : System.FilePath) : TestM Unit := do IO.FS.removeFile file return unless ← expected.pathExists do - fail s!"missing golden directory {expected}" + failAt loc s!"missing golden directory {expected}" (detail? := some "Run with --update-golden to create it.") for file in actualFiles do let rel := relativeTo actual file let want := expected / rel unless ← want.pathExists do - fail s!"file not present in the golden directory: {rel}" + failAt loc s!"file not present in the golden directory: {rel}" let wantContent ← IO.FS.readFile want let gotContent ← IO.FS.readFile file unless wantContent == gotContent do - fail s!"golden mismatch for {rel}" - (detail? := some (goldenDiff wantContent gotContent)) + failAt loc s!"golden mismatch for {rel}" (detail? := some (goldenDiff wantContent gotContent)) for file in ← filesUnder expected do let rel := relativeTo expected file unless ← (actual / rel).pathExists do - fail s!"file missing from the produced output: {rel}" + failAt loc s!"file missing from the produced output: {rel}" diff --git a/src/errata/Errata/IsTest.lean b/src/errata/Errata/IsTest.lean index 0a14205ae..1f4d1728a 100644 --- a/src/errata/Errata/IsTest.lean +++ b/src/errata/Errata/IsTest.lean @@ -36,7 +36,7 @@ instance : IsTest (IO TestResult) where toTest act := do (← act).toTest instance : IsTest Bool where - toTest b := unless b do fail "expected true, got false" + toTest b := unless b do failHere "expected true, got false" instance : IsTest (IO Bool) where - toTest act := do unless (← act) do fail "expected true, got false" + toTest act := do unless (← act) do failHere "expected true, got false" diff --git a/src/errata/Errata/Process.lean b/src/errata/Errata/Process.lean index 976f7cae0..5f72f7460 100644 --- a/src/errata/Errata/Process.lean +++ b/src/errata/Errata/Process.lean @@ -19,5 +19,5 @@ namespace Errata def assertExitCode (expected : UInt32) (output : IO.Process.Output) (loc : Location := by exact here%) : TestM Unit := unless output.exitCode == expected do - fail s!"process exited with code {output.exitCode}, expected {expected}" - (detail? := some s!"stderr:\n{output.stderr}") (location? := some loc) + failAt loc s!"process exited with code {output.exitCode}, expected {expected}" + (detail? := some s!"stderr:\n{output.stderr}") diff --git a/src/errata/Errata/Property.lean b/src/errata/Errata/Property.lean index 0f378b477..de303c42a 100644 --- a/src/errata/Errata/Property.lean +++ b/src/errata/Errata/Property.lean @@ -21,7 +21,7 @@ open Plausible open scoped Plausible.Decorations in /-- Checks a property with Plausible, failing with the counterexample if it is falsified. -/ -def property (p : Prop) (cfg : Configuration := {}) +def property (p : Prop) (cfg : Configuration := {}) (loc : Location := by exact here%) (p' : Decorations.DecorationsOf p := by mk_decorations) [Testable p'] : TestM Unit := do let ctx ← read let cfg := { cfg with @@ -29,6 +29,6 @@ def property (p : Prop) (cfg : Configuration := {}) randomSeed := if ctx.seed == 0 then cfg.randomSeed else some ctx.seed } match ← Testable.checkIO p' (cfg := cfg) with | .success _ => pure () - | .gaveUp n => fail s!"property gave up after discarding {n} cases" + | .gaveUp n => failAt loc s!"property gave up after discarding {n} cases" | .failure _ counterExample _ => - fail "property falsified" (detail? := some ("\n".intercalate counterExample)) + failAt loc "property falsified" (detail? := some ("\n".intercalate counterExample)) diff --git a/src/errata/Errata/Report.lean b/src/errata/Errata/Report.lean index a659a3147..9a74e603f 100644 --- a/src/errata/Errata/Report.lean +++ b/src/errata/Errata/Report.lean @@ -43,9 +43,11 @@ def humanReport (verbose : Bool) (results : Array Result) : IO Nat := do failed := failed + 1 IO.println s!"FAIL {name}: {f.message}" if let some d := f.detail? then IO.println (indentLines d) + unless r.output.isEmpty do IO.println (indentLines s!"output:\n{r.output.all}") | .error m => errored := errored + 1 IO.println s!"ERROR {name}: {m}" + unless r.output.isEmpty do IO.println (indentLines s!"output:\n{r.output.all}") IO.println s!"{passed} passed, {failed} failed, {errored} errored, {skipped} skipped" return failed + errored @@ -73,6 +75,25 @@ instance : FromJson Location where startPos := ⟨← j.getObjValAs? Nat "startLine", ← j.getObjValAs? Nat "startColumn"⟩, endPos := ⟨← j.getObjValAs? Nat "endLine", ← j.getObjValAs? Nat "endColumn"⟩ } +instance : ToJson Output where + toJson + | .stdout s => json%{ "stream": "stdout", "text": $s } + | .stderr s => json%{ "stream": "stderr", "text": $s } + +instance : FromJson Output where + fromJson? j := do + let text ← j.getObjValAs? String "text" + match ← j.getObjValAs? String "stream" with + | "stdout" => return .stdout text + | "stderr" => return .stderr text + | other => .error s!"unknown output stream: {other}" + +instance : ToJson OutputLog where + toJson o := ToJson.toJson o.log + +instance : FromJson OutputLog where + fromJson? j := return { log := ← FromJson.fromJson? j } + /-- The suite a result belongs to: its module. -/ private def suiteOf (r : Result) : String := r.moduleName @@ -130,7 +151,8 @@ instance : ToJson Result where [("package", Json.str r.package), ("module", Json.str r.moduleName), ("test", Json.str r.test), ("resultPath", ToJson.toJson r.resultPath), ("durationMs", ToJson.toJson r.durationMs)] ++ - statusFields r.status + statusFields r.status ++ + (if r.output.isEmpty then [] else [("output", ToJson.toJson r.output)]) /-- Decodes an optional field: absent maps to {lean}`none`. -/ private def optField [FromJson α] (j : Json) (key : String) : Except String (Option α) := @@ -151,14 +173,15 @@ instance : FromJson Status where | other => .error s!"unknown status: {other}" instance : FromJson Result where - fromJson? j := do + fromJson? j := private do return { package := ← j.getObjValAs? String "package", moduleName := ← j.getObjValAs? String "module", test := ← j.getObjValAs? String "test", resultPath := ← j.getObjValAs? (Array String) "resultPath", durationMs := ← j.getObjValAs? Nat "durationMs", - status := ← FromJson.fromJson? j } + status := ← FromJson.fromJson? j, + output := (← optField j "output").getD {} } /-- Renders the results as a JSON array of objects. -/ def jsonReport (results : Array Result) : String := (ToJson.toJson results).pretty diff --git a/src/errata/Errata/Result.lean b/src/errata/Errata/Result.lean index f2b79456b..b70649a3a 100644 --- a/src/errata/Errata/Result.lean +++ b/src/errata/Errata/Result.lean @@ -67,6 +67,46 @@ def Status.isSuccess : Status → Bool | .pass | .skip _ => true | .fail _ | .error _ => false +/-- A fragment of captured output, tagged by the stream it was written to. -/ +inductive Output where + /-- Text written to standard output. -/ + | stdout (text : String) + /-- Text written to standard error. -/ + | stderr (text : String) +deriving Repr, Inhabited, DecidableEq + +/-- The text of an output fragment, regardless of stream. -/ +def Output.text : Output → String + | .stdout s | .stderr s => s + +/-- All captured output, concatenated in order. -/ +def capturedText (output : Array Output) : String := + output.foldl (fun acc o => acc ++ o.text) "" + +/-- Output captured from an action, in order and tagged by stream. -/ +structure OutputLog where + /-- The captured fragments, in order, tagged by stream. -/ + log : Array Output := #[] +deriving Repr, Inhabited, DecidableEq + +namespace OutputLog + +/-- Whether no output was captured. -/ +def isEmpty (o : OutputLog) : Bool := o.log.isEmpty + +/-- The text written to stdout, concatenated in order. -/ +def stdout (o : OutputLog) : String := + o.log.foldl (fun acc out => match out with | .stdout s => acc ++ s | .stderr _ => acc) "" + +/-- The text written to stderr, concatenated in order. -/ +def stderr (o : OutputLog) : String := + o.log.foldl (fun acc out => match out with | .stderr s => acc ++ s | .stdout _ => acc) "" + +/-- The text written to stdout and stderr, concatenated in order. -/ +def all (o : OutputLog) : String := capturedText o.log + +end OutputLog + /-- One entry collected during a run and rendered by the reporters. -/ structure Result where /-- The package that defines the test. -/ @@ -81,6 +121,8 @@ structure Result where status : Status /-- How long the check took, in milliseconds. -/ durationMs : Nat := 0 + /-- What the test wrote to stdout and stderr. -/ + output : OutputLog := {} deriving Repr, Inhabited, DecidableEq /-- The test name below the module: the declaration and any named result, dotted. -/ diff --git a/src/errata/Errata/Runner.lean b/src/errata/Errata/Runner.lean index 6afce9103..56b2a1aa8 100644 --- a/src/errata/Errata/Runner.lean +++ b/src/errata/Errata/Runner.lean @@ -24,14 +24,18 @@ structure TestEntry where moduleName : String /-- The test declaration's name below its module. -/ test : String + /-- The test's own source range, used as the default failure location. -/ + location : Location /-- The action to run. -/ run : TestM Unit /-- Builds a test entry from any testable value. -/ -def TestEntry.of {α} [IsTest α] (package moduleName test : String) (value : α) : TestEntry where +def TestEntry.of {α} [IsTest α] (package moduleName test : String) (location : Location) + (value : α) : TestEntry where package := package moduleName := moduleName test := test + location := location run := IsTest.toTest value /-- Runs a single test entry, collecting all of its results. -/ @@ -39,15 +43,15 @@ def runEntry (cfg : Context) (entry : TestEntry) : IO (Array Result) := do let log ← IO.mkRef (#[] : Array Result) let ctx := { cfg with package := entry.package, moduleName := entry.moduleName, test := entry.test, - resultPath := #[], log } + resultPath := #[], location := entry.location, log } let start ← IO.monoMsNow - let outcome ← ((entry.run ctx).run).toBaseIO + let (outcome, output) ← runCapturing ctx entry.run let stop ← IO.monoMsNow let dur := stop - start let logged ← log.get match outcome with - | .error e => return logged.push (ctx.error (toString e) dur) - | .ok (.error f) => return logged.push (ctx.fail f dur) + | .error e => return logged.push { ctx.error (toString e) dur with output } + | .ok (.error f) => return logged.push { ctx.fail f dur with output } | .ok (.ok ()) => if logged.isEmpty then return #[ctx.pass dur] else return logged diff --git a/src/errata/Errata/TestM.lean b/src/errata/Errata/TestM.lean index 0972d3eab..74043fda0 100644 --- a/src/errata/Errata/TestM.lean +++ b/src/errata/Errata/TestM.lean @@ -7,6 +7,7 @@ module public import Errata.Context public import Errata.Result +public import Errata.Here public section @@ -23,10 +24,33 @@ failure, which the interpreter distinguishes from an {name}`IO.Error` that escap -/ abbrev TestM := ReaderT Context (ExceptT TestFailure IO) +/-- +Fails at the location recorded in the context. The runner seeds that with the test's own source +range, so a failure with no more specific location still points at the test. This is the primitive +the internal layer uses when no call site is available. +-/ +def failHere (message : String) (detail? : Option String := none) : TestM α := do + throw { message, detail?, location? := some (← read).location } + +/-- +Fails at an explicit source location. The assertion language captures its call site with +{lit}`here%` and reports through this primitive. +-/ +def failAt (loc : Location) (message : String) (detail? : Option String := none) : TestM α := + throw { message, detail?, location? := some loc } + /-- Fails the current test, or named result, with a message and optional detail. -/ def fail (message : String) (detail? : Option String := none) - (location? : Option Location := none) : TestM α := - throw { message, detail?, location? } + (loc : Location := by exact here%) : TestM α := + failAt loc message detail? + +/-- +Runs an action with the current failure location set to a call site, which defaults to the caller. +A user-defined assertion helper can wrap its checks in this so their failures report at the helper's +call site rather than inside the helper. +-/ +def withLocation (loc : Location := by exact here%) (act : TestM α) : TestM α := + withReader ({ · with location := loc }) act /-- All values supplied for a project option, in order; records that the option was read. -/ def optionValues (name : String) : TestM (Array String) := do @@ -70,12 +94,36 @@ def skip (reason : String) : TestM Unit := do let ctx ← read ctx.log.modify (·.push (ctx.skip reason)) -/-- Runs a test action, capturing its outcome as data rather than letting it propagate. -/ -def captureOutcome (act : TestM Unit) : - TestM (Except IO.Error (Except TestFailure Unit)) := do - let ctx ← read - let outcome ← ((act ctx).run).toBaseIO - pure outcome +/-- A stream that appends each write to a log, tagged by the stream it came from. -/ +private def captureStream (log : IO.Ref (Array Output)) (mk : String → Output) : IO.FS.Stream where + flush := pure () + read _ := pure .empty + write bytes := log.modify (·.push (mk (String.fromUTF8! bytes))) + getLine := pure "" + putStr s := log.modify (·.push (mk s)) + isTty := pure false + +/-- +Runs a test action with the given context, capturing its outcome as data rather than letting it +propagate. The action's stdout and stderr are recorded, in order and tagged by stream, and returned +alongside the outcome, so a test's output is shown only when it fails. +-/ +def runCapturing (ctx : Context) (act : TestM Unit) : + IO (Except IO.Error (Except TestFailure Unit) × OutputLog) := do + let log ← IO.mkRef (#[] : Array Output) + let outcome ← IO.withStdout (captureStream log .stdout) <| + IO.withStderr (captureStream log .stderr) <| ((act ctx).run).toBaseIO + return (outcome, { log := ← log.get }) + +/-- +Runs an action with stdout and stderr captured into a fresh log, then returns the captured output +in order. The redirection is local to the action, so a test can make assertions about what the +action wrote. +-/ +def captureOutput (act : TestM Unit) : TestM OutputLog := do + let log ← IO.mkRef (#[] : Array Output) + IO.withStdout (captureStream log .stdout) <| IO.withStderr (captureStream log .stderr) act + return { log := ← log.get } /-- Runs a named result within the current test. @@ -89,15 +137,15 @@ def result (name : String) (act : TestM Unit) : TestM Unit := let ctx ← read let before := (← ctx.log.get).size let start ← IO.monoMsNow - let outcome ← captureOutcome act + let (outcome, output) ← runCapturing ctx act let stop ← IO.monoMsNow let dur := stop - start let after := (← ctx.log.get).size match outcome with | .error e => - ctx.log.modify (·.push (ctx.error (toString e) dur)) + ctx.log.modify (·.push { ctx.error (toString e) dur with output }) | .ok (.error f) => - ctx.log.modify (·.push (ctx.fail f dur)) + ctx.log.modify (·.push { ctx.fail f dur with output }) | .ok (.ok ()) => if after == before then ctx.log.modify (·.push (ctx.pass dur)) @@ -107,9 +155,9 @@ Expects the action to fail an assertion. The current scope passes if it does and succeeds. An escaping {name}`IO.Error` is not an expected failure: it propagates and is reported as an error, so broken setup is not mistaken for a passing negative test. -/ -def expectFail (act : TestM Unit) : TestM Unit := do +def expectFail (act : TestM Unit) (loc : Location := by exact here%) : TestM Unit := do try act catch _ => return - fail "expected the action to fail, but it passed" + failAt loc "expected the action to fail, but it passed" diff --git a/src/errata/ErrataEnumerateMain.lean b/src/errata/ErrataEnumerateMain.lean index c60fb2e7f..045d7312a 100644 --- a/src/errata/ErrataEnumerateMain.lean +++ b/src/errata/ErrataEnumerateMain.lean @@ -3,8 +3,9 @@ Copyright (c) 2026 Lean FRO LLC. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Author: David Thrane Christiansen -Enumerates the Errata tests defined in a module as a JSON array of their user-facing names. The -Errata test driver runs this per module to discover tests without a hand-maintained list. +Enumerates the Errata tests defined in a module as a JSON array of objects, each with the test's +user-facing name and its source range. The Errata test driver runs this per module to discover +tests, and seeds each test's failure location with its range. -/ module @@ -15,12 +16,21 @@ set_option doc.verso true open Lean Errata -/-- Imports a module and returns the user-facing names of the Errata tests it defines. -/ -def enumerate (moduleName : String) : IO (Array String) := do +/-- Imports a module and returns its Errata tests, each as a JSON object of name and source range. -/ +def enumerate (moduleName : String) : IO (Array Json) := do initSearchPath (← findSysroot) let name := moduleName.toName let env ← importModules #[{ module := name }] {} (trustLevel := 1024) - return (testsInModule env name).map fun decl => (privateToUserName decl).toString + return (testsInModule env name).map fun decl => + let userName := (privateToUserName decl).toString + let range := declRangeExt.find? (level := .server) env decl + let pos := (range.map (·.range.pos)).getD ⟨0, 0⟩ + let endPos := (range.map (·.range.endPos)).getD ⟨0, 0⟩ + json%{ + "name": $userName, + "startLine": $pos.line, "startColumn": $pos.column, + "endLine": $endPos.line, "endColumn": $endPos.column + } /-- Enumerates a module's tests, writing or printing the JSON manifest. -/ public def main (args : List String) : IO UInt32 := do diff --git a/src/tests/VersoTests.lean b/src/tests/VersoTests.lean new file mode 100644 index 000000000..487403062 --- /dev/null +++ b/src/tests/VersoTests.lean @@ -0,0 +1,11 @@ +/- +Copyright (c) 2026 Lean FRO LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Author: David Thrane Christiansen +-/ +module + +/-! +Errata ports of the Verso test suite. Each feature lives in its own submodule, discovered by the +Errata test driver. +-/ diff --git a/src/tests/VersoTests/BuildLog.lean b/src/tests/VersoTests/BuildLog.lean new file mode 100644 index 000000000..bdc7eec1f --- /dev/null +++ b/src/tests/VersoTests/BuildLog.lean @@ -0,0 +1,110 @@ +/- +Copyright (c) 2026 Lean FRO LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Author: David Thrane Christiansen +-/ +module + +public import Verso +public import Errata +public meta import Errata + +open Verso Errata + +/-! +Tests for Verso's build log: where a message's location and severity are recorded, how locations +format, and how logging interacts with the exit code and the ambient output streams. +-/ + +/-- A message logged with a `pos` location is saved with that file and position. -/ +@[test] +def savesPosition : TestM Unit := do + let logger ← Logger.new + let pos : Lean.Lsp.Position := { line := 4, character := 2 } + (reportError "boom" (some { file := "PosSave.lean", span := .pos pos }) : BuildLogT IO Unit).run logger + let errs ← logger.errors + let some m := errs[0]? + | fail s!"expected 1 saved error, got {errs.size}" + assert (m.severity == .error) "expected error severity" + match m.loc with + | some { file := "PosSave.lean", span := .pos p } => + assertEq 4 p.line + assertEq 2 p.character + | _ => fail "expected a saved `PosSave.lean` `pos` location" + +/-- A `range` span is likewise saved. -/ +@[test] +def savesRange : TestM Unit := do + let logger ← Logger.new + let r : Lean.Lsp.Range := + { start := { line := 1, character := 0 }, «end» := { line := 1, character := 5 } } + (reportWarning "careful" (some { file := "RangeSave.lean", span := .range r }) : BuildLogT IO Unit).run logger + let some w := (← logger.warnings)[0]? + | fail "expected 1 saved warning" + match w.loc with + | some { span := .range _, .. } => pure () + | _ => fail "expected a `range` span to be saved" + +/-- +Range formatting defers to Lean's `mkErrorStringWithPos`: `file:line:col-line:col`, with a 1-based +line and 0-based column, keeping the full end position even within one line. +-/ +@[test] +def rangeFormat : TestM Unit := do + let crossLine : LogMessage := { + severity := .error, text := "msg", + loc := some { + file := "CrossLine.lean", + span := .range { start := { line := 19, character := 4 }, «end» := { line := 20, character := 7 } } + } + } + assertEq "CrossLine.lean:20:4-21:7: msg" crossLine.format + let sameLine : LogMessage := { + severity := .error, text := "msg", + loc := some { + file := "SameLine.lean", + span := .range { start := { line := 42, character := 4 }, «end» := { line := 42, character := 21 } } + } + } + assertEq "SameLine.lean:43:4-43:21: msg" sameLine.format + +/-- A located message is formatted uniformly as `file:line:col: text` on stderr. -/ +@[test] +def fileLocationFormat : TestM Unit := do + let logger ← Logger.new + let out ← captureOutput <| + (reportError "bad term" (some { file := "FileLoc.lean", span := .pos { line := 6, character := 3 } }) + : BuildLogT IO Unit).run logger + let some m := (← logger.errors)[0]? + | fail "expected 1 saved error with a file location" + assertEq (some "FileLoc.lean") (m.loc.map (·.file)) + assertContains "FileLoc.lean:7:3: bad term" out.stderr + +/-- Errors set a non-zero exit code; warnings do not. -/ +@[test] +def exitCode : TestM Unit := do + let withErrors ← Logger.new + (do reportError "e1"; reportWarning "w1"; reportError "e2" : BuildLogT IO Unit).run withErrors + assertEq 2 (← withErrors.errors).size + assertEq 1 (← withErrors.warnings).size + assertEq 1 (← withErrors.exitCode) + let warningOnly ← Logger.new + (reportWarning "just a warning" : BuildLogT IO Unit).run warningOnly + assertEq 0 (← warningOnly.exitCode) + +/-- +Logging writes to the ambient stderr, resolved at log time: a logger created before a stderr +redirection still writes into the redirected stream, and nothing goes to stdout. +-/ +@[test] +def ambientStderr : TestM Unit := do + let logger ← Logger.new + let out ← captureOutput do + (do + reportError "first problem" (some { file := "X.lean", span := .pos { line := 0, character := 0 } }) + reportWarning "second problem" : BuildLogT IO Unit).run logger + assertContains "X.lean:1:0: first problem" out.stderr + assertContains "second problem" out.stderr + assertEq "" out.stdout + assertEq 1 (← logger.errors).size + assertEq 1 (← logger.warnings).size From e5887d34963ea456ae0a400d3c856f92f8b292ba Mon Sep 17 00:00:00 2001 From: David Thrane Christiansen Date: Wed, 24 Jun 2026 15:22:14 +0200 Subject: [PATCH 03/26] glob warning --- lakefile.lean | 46 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 46 insertions(+) diff --git a/lakefile.lean b/lakefile.lean index e70e0c2c8..ff4a9e813 100644 --- a/lakefile.lean +++ b/lakefile.lean @@ -262,6 +262,51 @@ private def errataSplitArgs (args : List String) : List String × List String := /-- Usage information for `lake test`, shared with `Errata.usage` through one text file. -/ private def errataUsage : String := include_str "src/errata/Errata/usage.txt" +/-- Every `.lean` file below a directory, recursively. -/ +private partial def errataLeanFiles (dir : System.FilePath) : IO (Array System.FilePath) := do + unless ← dir.pathExists do return #[] + let mut out := #[] + for entry in ← dir.readDir do + if ← entry.path.isDir then + out := out ++ (← errataLeanFiles entry.path) + else if entry.path.extension == some "lean" then + out := out.push entry.path + return out + +/-- The module name of a `.lean` file relative to a source directory, if it lies within it. -/ +private def errataModuleOfPath (srcDir path : System.FilePath) : Option Lean.Name := do + guard (path.extension == some "lean") + let stem ← path.fileStem + let parent ← path.parent + guard (srcDir.components.isPrefixOf parent.components) + let comps := parent.components.drop srcDir.components.length ++ [stem] + some (".".intercalate comps).toName + +/-- +Warns about modules that define `@[test]` tests but whose library's globs do not cover them, so +the tests would be silently undiscovered. A module within a library's root that is not matched by +the library's globs, in a file mentioning `@[test]`, is the signal. +-/ +private def errataWarnUncovered (ws : Lake.Workspace) : IO Unit := do + let mut missed : Array Lean.Name := #[] + for lib in ws.root.leanLibs do + if lib.name == `ErrataGenerated then continue + let srcDir := lib.srcDir + for path in ← errataLeanFiles srcDir do + let some mod := errataModuleOfPath srcDir path | continue + let withinRoot := lib.roots.any (·.isPrefixOf mod) + let globbed := lib.config.globs.any (·.matches mod) + if withinRoot && !globbed && !missed.contains mod then + let lines := (← IO.FS.readFile path).splitOn "\n" + if lines.any (fun line => line.trimAsciiStart.copy.startsWith "@[test]") then + missed := missed.push mod + unless missed.isEmpty do + IO.eprintln "warning: these modules define @[test] tests but their library's globs do not cover \ + them, so the tests are not discovered. Widen the library's `globs` \ + (e.g. `globs := #[Glob.andSubmodules `Root]`):" + for mod in missed do + IO.eprintln s!" {mod}" + @[test_driver] script «errata-test» (args) do let ws ← getWorkspace @@ -296,6 +341,7 @@ script «errata-test» (args) do unless allNames.any (fun n => n.toString == spec || n.toString.startsWith (spec ++ ".")) do IO.eprintln s!"error: no module matches '{spec}'" return 1 + errataWarnUncovered ws let mut mods : Array (Lean.Name × Array ErrataTest) := #[] for (moduleName, path) in perModule do let tests := errataParseManifest (← IO.FS.readFile path) From 2618c962158aadb2d1293333ab9e7d79ae569689 Mon Sep 17 00:00:00 2001 From: David Thrane Christiansen Date: Wed, 24 Jun 2026 16:16:26 +0200 Subject: [PATCH 04/26] Stemmer and zip tests --- src/errata-tests/ErrataTests.lean | 50 +++++++++++++++++ src/errata/Errata/Context.lean | 4 +- src/errata/Errata/Report.lean | 90 ++++++++++++++++++++++++------- src/errata/Errata/Result.lean | 25 +++++++++ src/errata/Errata/Runner.lean | 14 ++--- src/errata/Errata/usage.txt | 2 +- src/tests/VersoTests/Stemmer.lean | 30 +++++++++++ src/tests/VersoTests/Zip.lean | 85 +++++++++++++++++++++++++++++ 8 files changed, 272 insertions(+), 28 deletions(-) create mode 100644 src/tests/VersoTests/Stemmer.lean create mode 100644 src/tests/VersoTests/Zip.lean diff --git a/src/errata-tests/ErrataTests.lean b/src/errata-tests/ErrataTests.lean index 0f1214e10..1742eac2b 100644 --- a/src/errata-tests/ErrataTests.lean +++ b/src/errata-tests/ErrataTests.lean @@ -90,3 +90,53 @@ def goldenRoundTrip : TestM Unit := assertFileExists goldenPath let _ := cfg goldenFile goldenPath "contents\n" + +/-- The `Verbosity` predicates and accumulation behave as the report relies on. -/ +@[test] +def verbosityLevels : TestM Unit := do + assertEq false Verbosity.silent.showsPasses + assertEq true Verbosity.quiet.showsPasses + assertEq true Verbosity.verbose.showsPasses + assertEq false Verbosity.silent.truncates + assertEq true Verbosity.quiet.truncates + assertEq false Verbosity.verbose.truncates + assertEq Verbosity.quiet Verbosity.silent.increase + assertEq Verbosity.verbose Verbosity.quiet.increase + assertEq Verbosity.verbose Verbosity.verbose.increase + +/-- At silent verbosity the report hides passes but shows failures and the summary line. -/ +@[test] +def reportSilent : TestM Unit := do + let pass : Result := { package := "p", moduleName := "M", test := "t", status := .pass } + let fail : Result := { package := "p", moduleName := "M", test := "u", status := .fail { message := "boom" } } + let out ← captureOutput do discard <| humanReport .silent #[pass, fail] + assertContains "FAIL p/M u: boom" out.stdout + assertContains "1 passed, 1 failed, 0 errored, 0 skipped" out.stdout + assertEq 1 (out.stdout.splitOn "ok ").length + +/-- At verbose verbosity the report shows passes too. -/ +@[test] +def reportVerbose : TestM Unit := do + let pass : Result := { package := "p", moduleName := "M", test := "t", status := .pass } + let out ← captureOutput do discard <| humanReport .verbose #[pass] + assertContains "ok p/M t" out.stdout + +/-- A test's results are truncated after the cap at quiet verbosity, with a summary, but not at verbose. -/ +@[test] +def reportTruncates : TestM Unit := do + let many := (Array.range 60).map fun i => + ({ package := "p", moduleName := "M", test := "many", resultPath := #[s!"case {i}"], status := .pass } : Result) + let quiet ← captureOutput do discard <| humanReport .quiet many + assertEq 51 (quiet.stdout.splitOn "ok ").length + assertContains "(... and 10 more passed, 0 more failed)" quiet.stdout + let verbose ← captureOutput do discard <| humanReport .verbose many + assertEq 61 (verbose.stdout.splitOn "ok ").length + assertEq 1 (verbose.stdout.splitOn "(... and").length + +/-- `humanReport` returns the number of failures and errors. -/ +@[test] +def reportFailureCount : TestM Unit := do + let pass : Result := { package := "p", moduleName := "M", test := "t", status := .pass } + let fail : Result := { package := "p", moduleName := "M", test := "u", status := .fail { message := "x" } } + let err : Result := { package := "p", moduleName := "M", test := "v", status := .error "oops" } + assertEq 2 (← humanReport .silent #[pass, fail, err]) diff --git a/src/errata/Errata/Context.lean b/src/errata/Errata/Context.lean index a924ef309..9d96e4848 100644 --- a/src/errata/Errata/Context.lean +++ b/src/errata/Errata/Context.lean @@ -23,8 +23,8 @@ abbrev OptionMap := HashMap String (Array String) /-- The run-wide configuration and per-test state threaded through every test. -/ structure Context where - /-- Whether to report passing results, not only failures. -/ - verbose : Bool := false + /-- The reporting verbosity. -/ + verbosity : Verbosity := .silent /-- Whether golden checks rewrite their expected files instead of comparing. -/ updateGolden : Bool := false /-- Project-specific options, as a multi-map so repeated options accumulate. -/ diff --git a/src/errata/Errata/Report.lean b/src/errata/Errata/Report.lean index 9a74e603f..fa023ab8f 100644 --- a/src/errata/Errata/Report.lean +++ b/src/errata/Errata/Report.lean @@ -24,30 +24,84 @@ def failureCount (results : Array Result) : Nat := private def indentLines (text : String) : String := "\n".intercalate ((text.splitOn "\n").map (fun l => " " ++ l)) -/-- Prints a human-readable report and returns the number of failures. -/ -def humanReport (verbose : Bool) (results : Array Result) : IO Nat := do +/-- Prints one result: its status line, and for a failure its detail and captured output. -/ +private def printResult (r : Result) : IO Unit := do + let name := s!"{r.moduleTarget} {r.testName}" + match r.status with + | .pass => IO.println s!"ok {name} ({r.durationMs}ms)" + | .skip reason => IO.println s!"skip {name}: {reason}" + | .fail f => + IO.println s!"FAIL {name}: {f.message}" + if let some d := f.detail? then IO.println (indentLines d) + unless r.output.isEmpty do IO.println (indentLines s!"output:\n{r.output.all}") + | .error m => + IO.println s!"ERROR {name}: {m}" + unless r.output.isEmpty do IO.println (indentLines s!"output:\n{r.output.all}") + +/-- A running tally of results suppressed by truncation. -/ +private structure Suppressed where + passed : Nat := 0 + failed : Nat := 0 + errored : Nat := 0 + skipped : Nat := 0 + +/-- Counts one more suppressed result. -/ +private def Suppressed.add (s : Suppressed) : Status → Suppressed + | .pass => { s with passed := s.passed + 1 } + | .fail _ => { s with failed := s.failed + 1 } + | .error _ => { s with errored := s.errored + 1 } + | .skip _ => { s with skipped := s.skipped + 1 } + +/-- The number of suppressed results. -/ +private def Suppressed.total (s : Suppressed) : Nat := + s.passed + s.failed + s.errored + s.skipped + +/-- Prints the truncation summary for a test whose results were capped, if any were suppressed. -/ +private def printSuppressed (s : Suppressed) : IO Unit := do + if s.total > 0 then + let parts := #[s!"{s.passed} more passed", s!"{s.failed} more failed"] + ++ (if s.errored > 0 then #[s!"{s.errored} more errored"] else #[]) + ++ (if s.skipped > 0 then #[s!"{s.skipped} more skipped"] else #[]) + IO.println s!" (... and {", ".intercalate parts.toList})" + +/-- +Prints a human-readable report and returns the number of failures. Verbosity 0 shows only failures +and errors; 1 also shows passes and skips but truncates each test's results after a cap, summarizing +the rest; 2 shows everything. +-/ +def humanReport (verbosity : Verbosity) (results : Array Result) : IO Nat := do + let cap := 50 let mut passed := 0 let mut failed := 0 let mut errored := 0 let mut skipped := 0 + let mut curKey : Option (String × String) := none + let mut shown := 0 + let mut more : Suppressed := {} for r in results do - let name := s!"{r.moduleTarget} {r.testName}" match r.status with - | .pass => - passed := passed + 1 - if verbose then IO.println s!"ok {name} ({r.durationMs}ms)" - | .skip reason => - skipped := skipped + 1 - if verbose then IO.println s!"skip {name}: {reason}" - | .fail f => - failed := failed + 1 - IO.println s!"FAIL {name}: {f.message}" - if let some d := f.detail? then IO.println (indentLines d) - unless r.output.isEmpty do IO.println (indentLines s!"output:\n{r.output.all}") - | .error m => - errored := errored + 1 - IO.println s!"ERROR {name}: {m}" - unless r.output.isEmpty do IO.println (indentLines s!"output:\n{r.output.all}") + | .pass => passed := passed + 1 + | .fail _ => failed := failed + 1 + | .error _ => errored := errored + 1 + | .skip _ => skipped := skipped + 1 + -- Results of one test are contiguous; truncation is per test (its data-driven sub-results). + let key := (r.moduleTarget, r.test) + if curKey != some key then + printSuppressed more + curKey := some key + shown := 0 + more := {} + let displayable := + match r.status with + | .pass | .skip _ => verbosity.showsPasses + | .fail _ | .error _ => true + if displayable then + if verbosity.truncates && shown ≥ cap then + more := more.add r.status + else + printResult r + shown := shown + 1 + printSuppressed more IO.println s!"{passed} passed, {failed} failed, {errored} errored, {skipped} skipped" return failed + errored diff --git a/src/errata/Errata/Result.lean b/src/errata/Errata/Result.lean index b70649a3a..2941a7d78 100644 --- a/src/errata/Errata/Result.lean +++ b/src/errata/Errata/Result.lean @@ -12,6 +12,31 @@ set_option doc.verso true namespace Errata +/-- How much the human-readable report prints. -/ +inductive Verbosity where + /-- Print only failures and errors. -/ + | silent + /-- Also print passes and skips, truncating each test's results after a cap. -/ + | quiet + /-- Print every result. -/ + | verbose +deriving Repr, Inhabited, DecidableEq, BEq + +/-- Whether passes and skips are printed at this verbosity. -/ +def Verbosity.showsPasses : Verbosity → Bool + | .silent => false + | .quiet | .verbose => true + +/-- Whether each test's results are truncated after a cap at this verbosity. -/ +def Verbosity.truncates : Verbosity → Bool + | .quiet => true + | .silent | .verbose => false + +/-- The next verbosity up, for an accumulating {lit}`-v` / {lit}`-vv`. -/ +def Verbosity.increase : Verbosity → Verbosity + | .silent => .quiet + | .quiet | .verbose => .verbose + /-- A line and column within a source file, counting from one. -/ structure Position where /-- The line, counting from one. -/ diff --git a/src/errata/Errata/Runner.lean b/src/errata/Errata/Runner.lean index 56b2a1aa8..8eee43a92 100644 --- a/src/errata/Errata/Runner.lean +++ b/src/errata/Errata/Runner.lean @@ -63,16 +63,16 @@ def run (cfg : Context) (entries : Array TestEntry) : IO (Array Result) := do return all /-- A base context with the given settings and a fresh, empty log. -/ -def mkContext (verbose : Bool := false) (updateGolden : Bool := false) +def mkContext (verbosity : Verbosity := .silent) (updateGolden : Bool := false) (options : OptionMap := {}) (seed : Nat := 0) : IO Context := do let log ← IO.mkRef (#[] : Array Result) let usedOptions ← IO.mkRef ({} : Std.HashSet String) - return { verbose, updateGolden, options, seed, log, usedOptions } + return { verbosity, updateGolden, options, seed, log, usedOptions } /-- The settings parsed from the runner's command line. -/ structure Options where - /-- Reports passing results, not only failures. -/ - verbose : Bool := false + /-- The reporting verbosity. -/ + verbosity : Verbosity := .silent /-- Rewrites golden expected files instead of comparing. -/ updateGolden : Bool := false /-- The seed for property tests, for reproducing a failure. -/ @@ -126,7 +126,7 @@ def parseArgs (args : List String) : Except String Options := do let mut opts : Options := {} for (name, value) in raw do match name with - | "verbose" | "v" => opts := { opts with verbose := true } + | "verbose" | "v" => opts := { opts with verbosity := opts.verbosity.increase } | "update-golden" => opts := { opts with updateGolden := true } | "seed" => match value.toNat? with @@ -159,12 +159,12 @@ def runMain (entries : Array TestEntry) (args : List String) : IO UInt32 := do if opts.help then IO.println usage return 0 - let cfg ← mkContext (verbose := opts.verbose) (updateGolden := opts.updateGolden) + let cfg ← mkContext (verbosity := opts.verbosity) (updateGolden := opts.updateGolden) (options := opts.options) (seed := opts.seed.getD 0) let results ← run cfg entries if let some path := opts.junitPath then IO.FS.writeFile path (junitReport results) if let some path := opts.jsonPath then IO.FS.writeFile path (jsonReport results) - let failures ← humanReport opts.verbose results + let failures ← humanReport opts.verbosity results -- Warn about options that were supplied but never read by any test (typos, removed flags). let used ← cfg.usedOptions.get let unused := opts.options.toList.filterMap fun (k, _) => if used.contains k then none else some k diff --git a/src/errata/Errata/usage.txt b/src/errata/Errata/usage.txt index ba281ddd9..4b850df28 100644 --- a/src/errata/Errata/usage.txt +++ b/src/errata/Errata/usage.txt @@ -6,7 +6,7 @@ Usage: lake test -- MODULE... -- OPTION... pass runner options after a second `--` Modules use Lake target syntax. Runner options: - -v, --verbose Report passing results, not only failures. + -v, --verbose Also report passes (truncating each test's results); repeat (-vv) for all. --update-golden Rewrite golden expected files instead of comparing. --seed N Seed property tests with N, to reproduce a failure. --junit PATH Write a JUnit XML report to PATH. diff --git a/src/tests/VersoTests/Stemmer.lean b/src/tests/VersoTests/Stemmer.lean new file mode 100644 index 000000000..c36bf797a --- /dev/null +++ b/src/tests/VersoTests/Stemmer.lean @@ -0,0 +1,30 @@ +/- +Copyright (c) 2026 Lean FRO LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Author: David Thrane Christiansen +-/ +module + +public import VersoSearch.PorterStemmer +public import Errata +public meta import Errata + +open Verso.Search.Stemmer.Porter Errata + +/-! +Tests the Porter stemmer against the standard vocabulary and its expected output. +-/ + +/-- The Porter stemmer reproduces the reference output for every word in the standard vocabulary. -/ +@[test] +def porterStemmer : TestM Unit := do + let vocabulary := (include_str "../stemmer/voc.txt").splitOn "\n" + let expected := (include_str "../stemmer/output.txt").splitOn "\n" + let mut mismatches : Array String := #[] + for word in vocabulary, want in expected do + let got := porterStem word + unless got == want do + mismatches := mismatches.push s!"{word} --> {got} (wanted '{want}')" + unless mismatches.isEmpty do + fail s!"{mismatches.size} stemmer mismatches" + (detail? := some ("\n".intercalate mismatches.toList)) diff --git a/src/tests/VersoTests/Zip.lean b/src/tests/VersoTests/Zip.lean new file mode 100644 index 000000000..e30c51abd --- /dev/null +++ b/src/tests/VersoTests/Zip.lean @@ -0,0 +1,85 @@ +/- +Copyright (c) 2026 Lean FRO LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Author: David Thrane Christiansen +-/ +module + +public import VersoUtil.Zip +public import Errata +public meta import Errata + +open Verso.Zip Errata + +/-! +Tests round-tripping files through the zip writer and the external `unzip` tool. +-/ + +/-- A block of Lean-code-shaped bytes to zip: the project's lakefile. -/ +def sampleBytes : ByteArray := (include_str "../../../lakefile.lean").toByteArray + +/-- A random `stem.ext` filename. -/ +private def randName : IO String := do + let len ← IO.rand 1 10 + let stem ← len.foldM (init := "") fun _ _ acc => do + return acc.push <| Char.ofNat ('a'.toNat + (← IO.rand 0 25)) + let len ← IO.rand 2 4 + let ext ← len.foldM (init := "") fun _ _ acc => do + return acc.push <| Char.ofNat ('a'.toNat + (← IO.rand 0 25)) + return stem ++ "." ++ ext + +/-- Zips `files` with `method`, extracts the archive with `unzip`, and checks each file round-trips. -/ +def extractRoundTrips (files : Array (String × ByteArray)) (method : CompressionMethod) + (loc : Location := by exact here%) : TestM Unit := + IO.FS.withTempDir fun dir => do + let dir := dir / s!"{← IO.monoMsNow}" + IO.FS.createDirAll dir + let archive := dir / "out.zip" + zipToFile archive files method + let out ← IO.Process.output { cmd := "unzip", args := #["-u", archive.toString, "-d", dir.toString] } + -- `unzip` returns 1 on an empty archive and 2 on a corrupt one. + unless out.exitCode == 0 || (files.isEmpty && out.exitCode == 1) do + failAt loc s!"unzip exited with code {out.exitCode}" (detail? := some out.stderr) + for (name, contents) in files do + let found ← IO.FS.readBinFile (dir / name) + unless found == contents do + failAt loc s!"contents of {name} do not match" + (detail? := some s!"expected {contents.size} bytes, got {found.size}") + +/-- Fixed file sets round-trip under both compression methods. -/ +@[test] +def zipFixed : TestM Unit := do + let files := #[("x.txt", "abcdef\nlkjlkj".toByteArray), ("y.txt", "".toByteArray), + ("z.txt", "abc\n\n".toByteArray)] + for method in [CompressionMethod.store, .deflate] do + extractRoundTrips #[] method + extractRoundTrips #[("empty", .empty)] method + extractRoundTrips files method + +/-- Increasingly large prefixes of a block round-trip, alone and paired with another. -/ +@[test] +def zipChunked : TestM Unit := do + let me := sampleBytes + let bwd := me.foldl (init := .empty) fun acc b => ByteArray.empty.push b ++ acc + let chunk := me.size / 10 + for method in [CompressionMethod.store, .deflate] do + for i in [0:11] do + let block := me.extract 0 (i * chunk) + extractRoundTrips #[("T2.lean", block)] method + extractRoundTrips #[("T2.lean", block), ("other", bwd.extract 0 (i * chunk))] method + +/-- Random file sets round-trip under both compression methods. -/ +@[test] +def zipRandom : TestM Unit := do + for _ in [0:10] do + let seed ← IO.monoNanosNow + IO.setRandSeed seed + -- Printed only if the test fails, so a failure is reproducible. + IO.println s!"random seed: {seed}" + let count ← IO.rand 0 15 + let mut files := #[] + for _ in [0:count] do + let bytes ← IO.getRandomBytes (.ofNat (← IO.rand 0 50000)) + files := files.push (← randName, bytes) + for method in [CompressionMethod.store, .deflate] do + extractRoundTrips files method From 1ab9a4195d771c25d8725342cf71ca29bfb2584f Mon Sep 17 00:00:00 2001 From: David Thrane Christiansen Date: Wed, 24 Jun 2026 22:00:19 +0200 Subject: [PATCH 05/26] Blog and serialization tests Also major staging simplification --- lakefile.lean | 148 ++++++++---------------- src/errata-tests/ErrataTests.lean | 28 ++--- src/errata/Errata/CompileTime.lean | 2 +- src/errata/Errata/Discovery.lean | 97 +++++++++++++--- src/errata/Errata/Here.lean | 4 +- src/errata/Errata/Report.lean | 13 ++- src/errata/Errata/Result.lean | 8 +- src/errata/Errata/TestM.lean | 3 + src/errata/ErrataEnumerateMain.lean | 49 -------- src/tests/Tests/Arbitrary.lean | 32 +++-- src/tests/Tests/Serialization.lean | 27 +++-- src/tests/VersoTests/Blog.lean | 52 +++++++++ src/tests/VersoTests/BuildLog.lean | 15 ++- src/tests/VersoTests/Serialization.lean | 103 +++++++++++++++++ src/tests/VersoTests/Stemmer.lean | 5 +- src/tests/VersoTests/Zip.lean | 9 +- 16 files changed, 359 insertions(+), 236 deletions(-) delete mode 100644 src/errata/ErrataEnumerateMain.lean create mode 100644 src/tests/VersoTests/Blog.lean create mode 100644 src/tests/VersoTests/Serialization.lean diff --git a/lakefile.lean b/lakefile.lean index ff4a9e813..c21bc85ea 100644 --- a/lakefile.lean +++ b/lakefile.lean @@ -134,34 +134,6 @@ lean_lib Errata where roots := #[`Errata] needs := #[errataUsageFile] --- Enumerates the Errata tests defined in a module. -lean_exe «errata-enumerate» where - root := `ErrataEnumerateMain - srcDir := "src/errata" - supportInterpreter := true - --- Writes the fully-qualified names of the Errata tests defined directly in a module. -module_facet errataTests mod : System.FilePath := do - let ws ← getWorkspace - let exeJob ← «errata-enumerate».fetch - -- Depend on `leanArts`, not `olean`: enumeration reads the whole module, including private and - -- `meta` test declarations, which the public olean's trace excludes. The `leanArts` trace inherits - -- the source trace, so adding or removing any test invalidates the manifest. - let modJob ← mod.leanArts.fetch - let buildDir := ws.root.buildDir - let outFile := mod.filePath (buildDir / "errata-tests") "json" - exeJob.bindM fun exeFile => - modJob.mapM fun _arts => do - addLeanTrace - addTrace (← computeTrace exeFile) - buildFileUnlessUpToDate' (text := true) outFile <| - proc { - cmd := exeFile.toString - args := #[mod.name.toString, outFile.toString] - env := ← getAugmentedEnv - } - pure outFile - -- Tests that exercise Errata using Errata itself. lean_lib ErrataTests where srcDir := "src/errata-tests" @@ -184,62 +156,34 @@ lean_exe «errata-runner» where srcDir := ".lake/errata-runner" supportInterpreter := true -/-- The test's name below its module: the declaration's components past the module prefix, dotted. -/ -private def errataTestName (moduleName declName : Lean.Name) : String := - let modComps := moduleName.components - let declComps := declName.components - let below := if moduleName.isPrefixOf declName then declComps.drop modComps.length else declComps - ".".intercalate (below.map (·.toString)) - -/-- A discovered test: its user-facing name and its source range. -/ -private structure ErrataTest where - name : String - startLine : Nat - startColumn : Nat - endLine : Nat - endColumn : Nat - -/-- Parse a per-module JSON manifest into the tests' names and source ranges. -/ -private def errataParseManifest (content : String) : Array ErrataTest := - match Lean.Json.parse content with - | .error _ => #[] - | .ok json => - match json.getArr? with - | .error _ => #[] - | .ok arr => arr.filterMap fun j => do - return { - name := ← (j.getObjValAs? String "name").toOption - startLine := ← (j.getObjValAs? Nat "startLine").toOption - startColumn := ← (j.getObjValAs? Nat "startColumn").toOption - endLine := ← (j.getObjValAs? Nat "endLine").toOption - endColumn := ← (j.getObjValAs? Nat "endColumn").toOption - } - -/-- Generate the discovered-tests module: `import all` the test modules and collect their tests. -/ -private def errataDiscoveredSource (packageName : String) - (mods : Array (Lean.Name × Array ErrataTest)) : String := Id.run do - let mut imports := #["public import Errata"] - let mut entries : Array String := #[] - for (moduleName, tests) in mods do - imports := imports.push s!"import all {moduleName}" - for t in tests do - let test := errataTestName moduleName t.name.toName - let loc := s!"(Errata.Location.mk \"{moduleName}\" \ - (Errata.Position.mk {t.startLine} {t.startColumn}) \ - (Errata.Position.mk {t.endLine} {t.endColumn}))" - entries := entries.push - s!" Errata.TestEntry.of \"{packageName}\" \"{moduleName}\" \"{test}\" {loc} (@{t.name})" - let header := "\n".intercalate imports.toList - let body := ",\n".intercalate entries.toList - return s!"module\n\n{header}\n\n\ - public def allTests : Array Errata.TestEntry := #[\n{body}\n]\n" - -/-- The main that runs the discovered tests. -/ -private def errataMainSource : String := - "import Errata\n\ - import ErrataDiscovered\n\n\ - def main (args : List String) : IO UInt32 :=\n \ - Errata.runMain allTests args\n" +/-- Whether a source file introduces Errata tests, by an `@[test]` attribute or a `#test_msgs` +command, the only two ways a test enters a module. -/ +private def errataSourceHasTests (lines : List String) : Bool := + lines.any fun line => + let t := line.trimAsciiStart.copy + t.startsWith "@[test]" || t.startsWith "#test_msgs" + +/-- Whether a source file participates in the module system: it leads with a `module` declaration. -/ +private def errataSourceIsModule (lines : List String) : Bool := + lines.any fun line => line.trimAscii.copy == "module" + +/-- Generate the bridge module: `import all` the module-system test modules so their private tests +are reachable, gathering them into `allTests` through `getAllTests%`. -/ +private def errataDiscoveredSource (packageName : String) (mods : Array Lean.Name) : String := + let imports := "\n".intercalate ("public import Errata" :: mods.toList.map (s!"import all {·}")) + let modList := " ".intercalate (mods.toList.map (·.toString)) + s!"module\n\n{imports}\n\n\ + public def allTests : Array Errata.TestEntry := getAllTests% \"{packageName}\" {modList}\n" + +/-- Generate the non-module main: import the bridge module and the non-module test modules (which a +`module` cannot import), then run their combined tests. -/ +private def errataMainSource (packageName : String) (mods : Array Lean.Name) : String := + let imports := "\n".intercalate + ("import Errata" :: "import ErrataDiscovered" :: mods.toList.map (s!"import {·}")) + let modList := " ".intercalate (mods.toList.map (·.toString)) + s!"{imports}\n\n\ + def main (args : List String) : IO UInt32 :=\n \ + Errata.runMain (allTests ++ getAllTests% \"{packageName}\" {modList}) args\n" /-- The module a target spec `[package/]module[#test]` selects (the unit of execution). -/ private def errataSpecModule (s : String) : String := @@ -322,36 +266,40 @@ script «errata-test» (args) do Select the module '{errataSpecModule spec}' instead." return 1 let moduleSpecs := specs.map errataSpecModule - -- Discover the tests in the selected modules, building the per-module enumeration facet. - let (allNames, perModule) ← runBuild do - let mut names : Array Lean.Name := #[] - let mut jobs : Array (Job (Lean.Name × System.FilePath)) := #[] + -- Gather the built modules and their source files. The module set is authoritative (it respects + -- each library's globs), so no annotated test is silently dropped. + let modInfos ← runBuild do + let mut infos : Array (Lean.Name × System.FilePath) := #[] for lib in ws.root.leanLibs do -- The generated runner lib has no source until this script writes it, and it holds no tests. if lib.name == `ErrataGenerated then continue let mods ← (← lib.modules.fetch).await for m in mods do - names := names.push m.name - if errataModuleSelected moduleSpecs m.name then - let job ← m.facet `errataTests |>.fetch - jobs := jobs.push (job.map fun p => (m.name, p)) - pure ((Job.collectArray jobs).map fun ps => (names, ps)) + infos := infos.push (m.name, m.leanFile) + pure (Job.pure infos) + let allNames := modInfos.map (·.1) -- Every selector must name a real module. for spec in moduleSpecs do unless allNames.any (fun n => n.toString == spec || n.toString.startsWith (spec ++ ".")) do IO.eprintln s!"error: no module matches '{spec}'" return 1 errataWarnUncovered ws - let mut mods : Array (Lean.Name × Array ErrataTest) := #[] - for (moduleName, path) in perModule do - let tests := errataParseManifest (← IO.FS.readFile path) - unless tests.isEmpty do - mods := mods.push (moduleName, tests) + -- A test module is a selected one whose source introduces tests. Module-system test modules go in + -- the bridge module (`import all`); non-module ones can only be imported by the non-module main. + let mut moduleMods : Array Lean.Name := #[] + let mut nonModuleMods : Array Lean.Name := #[] + for (moduleName, path) in modInfos do + unless errataModuleSelected moduleSpecs moduleName do continue + let lines := (← IO.FS.readFile path).splitOn "\n" + if errataSourceHasTests lines then + if errataSourceIsModule lines then moduleMods := moduleMods.push moduleName + else nonModuleMods := nonModuleMods.push moduleName -- Write the two generated sources, only when they change, so the build is reused across runs. let dir := ws.root.dir / ".lake" / "errata-runner" IO.FS.createDirAll dir - for (name, src) in [("ErrataDiscovered.lean", errataDiscoveredSource ws.root.prettyName mods), - ("ErrataRunnerMain.lean", errataMainSource)] do + for (name, src) in + [("ErrataDiscovered.lean", errataDiscoveredSource ws.root.prettyName moduleMods), + ("ErrataRunnerMain.lean", errataMainSource ws.root.prettyName nonModuleMods)] do let file := dir / name let changed ← if ← file.pathExists then pure ((← IO.FS.readFile file) != src) else pure true if changed then IO.FS.writeFile file src diff --git a/src/errata-tests/ErrataTests.lean b/src/errata-tests/ErrataTests.lean index 1742eac2b..e8a526362 100644 --- a/src/errata-tests/ErrataTests.lean +++ b/src/errata-tests/ErrataTests.lean @@ -18,33 +18,33 @@ def onePlusOne : Bool := 1 + 1 == 2 /-- An assertion-based test. -/ @[test] -def equality : TestM Unit := do +def equality : Test := do assertEq 4 (2 + 2) /-- A test with named results. -/ @[test] -def named : TestM Unit := do +def named : Test := do result "first" (assertEq 1 1) result "second" (assertContains "b" "abc") /-- A test that completes without any check is a bare success. -/ @[test] -def emptyBody : TestM Unit := pure () +def emptyBody : Test := pure () /-- A test that expects a failure. -/ @[test] -def expectsFailure : TestM Unit := +def expectsFailure : Test := expectFail (assertEq 1 2) /-- A data-driven family expressed as a plain loop. -/ @[test] -def squares : TestM Unit := do +def squares : Test := do for (n, sq) in [(1, 1), (2, 4), (3, 9)] do result s!"square {n}" (assertEq sq (n * n)) /-- A subprocess test. -/ @[test] -def echoRuns : TestM Unit := do +def echoRuns : Test := do let out ← IO.Process.output { cmd := "echo", args := #["hello"] } assertExitCode 0 out assertContains "hello" out.stdout @@ -61,7 +61,7 @@ set_option doc.verso true in /-- A property test. -/ @[test] -def addComm : TestM Unit := +def addComm : Test := property (∀ a b : Nat, a + b = b + a) open Lean (toJson fromJson?) @@ -76,12 +76,12 @@ deriving instance Plausible.Shrinkable, Plausible.Arbitrary for Result /-- The JSON encoding of a result round-trips: decoding the encoding recovers the result. -/ @[test] -def jsonRoundTrips : TestM Unit := +def jsonRoundTrips : Test := property (∀ r : Result, (fromJson? (toJson r)).toOption = some r) /-- A temp-directory fixture with a golden file. -/ @[test] -def goldenRoundTrip : TestM Unit := +def goldenRoundTrip : Test := IO.FS.withTempDir fun dir => do let cfg ← read -- In update mode this would write; here we drive it through a temp golden file. @@ -93,7 +93,7 @@ def goldenRoundTrip : TestM Unit := /-- The `Verbosity` predicates and accumulation behave as the report relies on. -/ @[test] -def verbosityLevels : TestM Unit := do +def verbosityLevels : Test := do assertEq false Verbosity.silent.showsPasses assertEq true Verbosity.quiet.showsPasses assertEq true Verbosity.verbose.showsPasses @@ -106,7 +106,7 @@ def verbosityLevels : TestM Unit := do /-- At silent verbosity the report hides passes but shows failures and the summary line. -/ @[test] -def reportSilent : TestM Unit := do +def reportSilent : Test := do let pass : Result := { package := "p", moduleName := "M", test := "t", status := .pass } let fail : Result := { package := "p", moduleName := "M", test := "u", status := .fail { message := "boom" } } let out ← captureOutput do discard <| humanReport .silent #[pass, fail] @@ -116,14 +116,14 @@ def reportSilent : TestM Unit := do /-- At verbose verbosity the report shows passes too. -/ @[test] -def reportVerbose : TestM Unit := do +def reportVerbose : Test := do let pass : Result := { package := "p", moduleName := "M", test := "t", status := .pass } let out ← captureOutput do discard <| humanReport .verbose #[pass] assertContains "ok p/M t" out.stdout /-- A test's results are truncated after the cap at quiet verbosity, with a summary, but not at verbose. -/ @[test] -def reportTruncates : TestM Unit := do +def reportTruncates : Test := do let many := (Array.range 60).map fun i => ({ package := "p", moduleName := "M", test := "many", resultPath := #[s!"case {i}"], status := .pass } : Result) let quiet ← captureOutput do discard <| humanReport .quiet many @@ -135,7 +135,7 @@ def reportTruncates : TestM Unit := do /-- `humanReport` returns the number of failures and errors. -/ @[test] -def reportFailureCount : TestM Unit := do +def reportFailureCount : Test := do let pass : Result := { package := "p", moduleName := "M", test := "t", status := .pass } let fail : Result := { package := "p", moduleName := "M", test := "u", status := .fail { message := "x" } } let err : Result := { package := "p", moduleName := "M", test := "v", status := .error "oops" } diff --git a/src/errata/Errata/CompileTime.lean b/src/errata/Errata/CompileTime.lean index ce6eb52b2..9208a5168 100644 --- a/src/errata/Errata/CompileTime.lean +++ b/src/errata/Errata/CompileTime.lean @@ -59,7 +59,7 @@ meta def elabTestMsgs : Command.CommandElab `(Errata.TestResult.pass) else `(Errata.TestResult.mismatch "compile-time messages do not match" $(quote actual) - $(quote (← getMainModule).toString) + $(quote (← getFileName)) $(quote startPos.line) $(quote startPos.column) $(quote endPos.line) $(quote endPos.column)) elabCommand (← `(@[test] def $(mkIdent declName) : Errata.TestResult := $verdict)) diff --git a/src/errata/Errata/Discovery.lean b/src/errata/Errata/Discovery.lean index 73200a59f..d1057d7c2 100644 --- a/src/errata/Errata/Discovery.lean +++ b/src/errata/Errata/Discovery.lean @@ -8,8 +8,9 @@ module public import Errata.IsTest public import Errata.Runner public import Lean +public meta import Lean -open Lean Meta +open Lean Meta Elab Term public section @@ -22,7 +23,7 @@ namespace Errata Verifies that a tagged declaration can be run as a test: it is not {lit}`meta`, and it has an {name}`IsTest` instance. -/ -def checkIsTest (decl : Name) : MetaM Unit := do +meta def checkIsTest (decl : Name) : MetaM Unit := do let env ← getEnv if isMarkedMeta env decl then throwError m!"A test must not be `meta`" @@ -33,14 +34,84 @@ def checkIsTest (decl : Name) : MetaM Unit := do | _ => throwError m!"`@[test]` requires an `Errata.IsTest` instance for the test's type{indentExpr info.type}" -/-- The attribute that marks Errata tests, holding the tagged declarations per module. -/ -initialize testAttr : TagAttribute ← - registerTagAttribute `test - "Marks a definition as a test, discovered and run by the Errata test runner." - (validate := fun decl => (checkIsTest decl).run') - -/-- The internal names of the Errata tests defined directly in a module. -/ -def testsInModule (env : Environment) (moduleName : Name) : Array Name := - match env.getModuleIdx? moduleName with - | some idx => testAttr.ext.getModuleEntries env idx - | none => #[] +/-- +A recorded test: its declaration name and the source file that defines it. The file is captured +when the attribute is applied; the declaration's line and column are recovered later, once the +declaration ranges are available. +-/ +structure TestDecl where + /-- The test declaration's name. -/ + name : Name + /-- The source file that defines the test. -/ + file : String + deriving Inhabited + +/-- +The tests recorded by {lit}`@[test]`, per module. The attribute is an elaboration-time feature: +tests are recorded as modules are elaborated, and {lit}`getAllTests%` reads them back at elaboration +time to build the runnable test array. +-/ +meta initialize testExt : SimplePersistentEnvExtension TestDecl (Array TestDecl) ← + registerSimplePersistentEnvExtension { + name := `Errata.test + addEntryFn := Array.push + addImportedFn := fun es => es.foldl Array.append #[] + } + +/-- Records a declaration as a test, capturing the source file that defines it. -/ +meta def recordTest (decl : Name) : AttrM Unit := do + (checkIsTest decl).run' + modifyEnv (testExt.addEntry · { name := decl, file := ← getFileName }) + +/-- Marks a definition as a test, discovered and run by the Errata test runner. -/ +meta initialize + registerBuiltinAttribute { + ref := `Errata.test + name := `test + descr := "Marks a definition as a test, discovered and run by the Errata test runner." + applicationTime := .afterTypeChecking + add := fun decl stx kind => do + Attribute.Builtin.ensureNoArgs stx + unless kind == AttributeKind.global do throwAttrMustBeGlobal `test kind + recordTest decl + } + +/-- The test's name below its module: the declaration's components past the module prefix, dotted. -/ +meta def testNameBelow (moduleName declName : Name) : String := + let below := + if moduleName.isPrefixOf declName then declName.components.drop moduleName.components.length + else declName.components + ".".intercalate (below.map (·.toString)) + +/-- +{lit}`getAllTests% "package" Mod.A Mod.B ...` reads the tests recorded by {lit}`@[test]` in the +named modules and expands to the array of {name}`TestEntry` values that run them. Each module must +be imported, with {lit}`import all` for module-system modules, so its tests are reachable. +-/ +syntax (name := getAllTests) "getAllTests%" str ident* : term + +/-- Expands {lit}`getAllTests%` by reading the recorded tests of the named modules. -/ +@[term_elab getAllTests] +meta def elabGetAllTests : TermElab := fun stx expectedType? => do + let `(getAllTests% $pkg:str $mods:ident*) := stx + | throwUnsupportedSyntax + let package := pkg.getString + let env ← getEnv + let mut entries : Array Term := #[] + for modStx in mods do + let moduleName := modStx.getId + let some idx := env.getModuleIdx? moduleName | continue + let moduleStr := moduleName.toString + for test in testExt.getModuleEntries env idx do + let userName := privateToUserName test.name + let testName := testNameBelow moduleName userName + let range ← findDeclarationRanges? test.name + let pos := (range.map (·.range.pos)).getD ⟨0, 0⟩ + let endPos := (range.map (·.range.endPos)).getD ⟨0, 0⟩ + entries := entries.push <| ← + `(Errata.TestEntry.of $(quote package) $(quote moduleStr) $(quote testName) + (Errata.Location.mk $(quote test.file) + (Errata.Position.mk $(quote pos.line) $(quote pos.column)) + (Errata.Position.mk $(quote endPos.line) $(quote endPos.column))) + (@$(mkIdent userName))) + elabTerm (← `(#[$entries,*])) expectedType? diff --git a/src/errata/Errata/Here.lean b/src/errata/Errata/Here.lean index d6800db64..5486a74ba 100644 --- a/src/errata/Errata/Here.lean +++ b/src/errata/Errata/Here.lean @@ -26,7 +26,7 @@ meta def elabHere : TermElab := fun _stx _expectedType? => do let fileMap ← getFileMap let startPos := fileMap.toPosition (ref.getPos?.getD 0) let endPos := fileMap.toPosition (ref.getTailPos?.getD (ref.getPos?.getD 0)) - let moduleName := (← getMainModule).toString - elabTerm (← `(Errata.Location.mk $(quote moduleName) + let file ← getFileName + elabTerm (← `(Errata.Location.mk $(quote file) (Errata.Position.mk $(quote startPos.line) $(quote startPos.column)) (Errata.Position.mk $(quote endPos.line) $(quote endPos.column)))) none diff --git a/src/errata/Errata/Report.lean b/src/errata/Errata/Report.lean index fa023ab8f..389b22cc0 100644 --- a/src/errata/Errata/Report.lean +++ b/src/errata/Errata/Report.lean @@ -24,6 +24,10 @@ def failureCount (results : Array Result) : Nat := private def indentLines (text : String) : String := "\n".intercalate ((text.splitOn "\n").map (fun l => " " ++ l)) +/-- A source location rendered as the clickable `file:line:col` of the span's start. -/ +private def locationText (l : Location) : String := + s!"{l.file}:{l.startPos.line}:{l.startPos.column}" + /-- Prints one result: its status line, and for a failure its detail and captured output. -/ private def printResult (r : Result) : IO Unit := do let name := s!"{r.moduleTarget} {r.testName}" @@ -32,6 +36,7 @@ private def printResult (r : Result) : IO Unit := do | .skip reason => IO.println s!"skip {name}: {reason}" | .fail f => IO.println s!"FAIL {name}: {f.message}" + if let some l := f.location? then IO.println (indentLines (locationText l)) if let some d := f.detail? then IO.println (indentLines d) unless r.output.isEmpty do IO.println (indentLines s!"output:\n{r.output.all}") | .error m => @@ -109,13 +114,9 @@ private def xmlEscape (s : String) : String := s.replace "&" "&" |>.replace "<" "<" |>.replace ">" ">" |>.replace "\"" """ -/-- A source span rendered as `module:line:col-line:col`. -/ -private def locationText (l : Location) : String := - s!"{l.moduleName}:{l.startPos.line}:{l.startPos.column}-{l.endPos.line}:{l.endPos.column}" - instance : ToJson Location where toJson l := json%{ - "module": $l.moduleName, + "file": $l.file, "startLine": $l.startPos.line, "startColumn": $l.startPos.column, "endLine": $l.endPos.line, @@ -125,7 +126,7 @@ instance : ToJson Location where instance : FromJson Location where fromJson? j := do return { - moduleName := ← j.getObjValAs? String "module", + file := ← j.getObjValAs? String "file", startPos := ⟨← j.getObjValAs? Nat "startLine", ← j.getObjValAs? Nat "startColumn"⟩, endPos := ⟨← j.getObjValAs? Nat "endLine", ← j.getObjValAs? Nat "endColumn"⟩ } diff --git a/src/errata/Errata/Result.lean b/src/errata/Errata/Result.lean index 2941a7d78..79c3bdcd5 100644 --- a/src/errata/Errata/Result.lean +++ b/src/errata/Errata/Result.lean @@ -47,8 +47,8 @@ deriving Repr, Inhabited, BEq, DecidableEq /-- A source span, used in failure messages and editor integration. -/ structure Location where - /-- The module that contains the span, rendered as a string. -/ - moduleName : String + /-- The source file that contains the span. -/ + file : String /-- The start of the span. -/ startPos : Position /-- The end of the span. -/ @@ -163,12 +163,12 @@ def Result.moduleTarget (result : Result) : String := result.package ++ "/" ++ result.moduleName /-- A failed verdict from a compile-time message mismatch, carrying its source span. -/ -def TestResult.mismatch (message detail moduleName : String) +def TestResult.mismatch (message detail file : String) (startLine startCol endLine endCol : Nat) : TestResult := .fail { message, detail? := some detail, location? := some { - moduleName, + file, startPos := { line := startLine, column := startCol }, endPos := { line := endLine, column := endCol } } } diff --git a/src/errata/Errata/TestM.lean b/src/errata/Errata/TestM.lean index 74043fda0..76132cfba 100644 --- a/src/errata/Errata/TestM.lean +++ b/src/errata/Errata/TestM.lean @@ -24,6 +24,9 @@ failure, which the interpreter distinguishes from an {name}`IO.Error` that escap -/ abbrev TestM := ReaderT Context (ExceptT TestFailure IO) +/-- A test: a {name}`TestM` action that succeeds unless it fails an assertion or raises an error. -/ +abbrev Test := TestM Unit + /-- Fails at the location recorded in the context. The runner seeds that with the test's own source range, so a failure with no more specific location still points at the test. This is the primitive diff --git a/src/errata/ErrataEnumerateMain.lean b/src/errata/ErrataEnumerateMain.lean deleted file mode 100644 index 045d7312a..000000000 --- a/src/errata/ErrataEnumerateMain.lean +++ /dev/null @@ -1,49 +0,0 @@ -/- -Copyright (c) 2026 Lean FRO LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Author: David Thrane Christiansen - -Enumerates the Errata tests defined in a module as a JSON array of objects, each with the test's -user-facing name and its source range. The Errata test driver runs this per module to discover -tests, and seeds each test's failure location with its range. --/ -module - -import Errata -import Lean - -set_option doc.verso true - -open Lean Errata - -/-- Imports a module and returns its Errata tests, each as a JSON object of name and source range. -/ -def enumerate (moduleName : String) : IO (Array Json) := do - initSearchPath (← findSysroot) - let name := moduleName.toName - let env ← importModules #[{ module := name }] {} (trustLevel := 1024) - return (testsInModule env name).map fun decl => - let userName := (privateToUserName decl).toString - let range := declRangeExt.find? (level := .server) env decl - let pos := (range.map (·.range.pos)).getD ⟨0, 0⟩ - let endPos := (range.map (·.range.endPos)).getD ⟨0, 0⟩ - json%{ - "name": $userName, - "startLine": $pos.line, "startColumn": $pos.column, - "endLine": $endPos.line, "endColumn": $endPos.column - } - -/-- Enumerates a module's tests, writing or printing the JSON manifest. -/ -public def main (args : List String) : IO UInt32 := do - match args with - | [moduleName, outPath] => - let tests ← enumerate moduleName - if let some parent := (System.FilePath.mk outPath).parent then - IO.FS.createDirAll parent - IO.FS.writeFile outPath ((toJson tests).pretty ++ "\n") - return 0 - | [moduleName] => - IO.println (toJson (← enumerate moduleName)).pretty - return 0 - | _ => - IO.eprintln "usage: errata-enumerate MODULE [OUTPUT]" - return 1 diff --git a/src/tests/Tests/Arbitrary.lean b/src/tests/Tests/Arbitrary.lean index bfe69e9a8..737347f40 100644 --- a/src/tests/Tests/Arbitrary.lean +++ b/src/tests/Tests/Arbitrary.lean @@ -6,20 +6,19 @@ Author: David Thrane Christiansen module public import Plausible public import Plausible.ArbitraryFueled -public meta import Plausible.ArbitraryFueled import Lean.Data.Json.FromToJson import all MultiVerso.InternalId -public meta import MultiVerso.NameMap -public meta import MultiVerso -public meta import VersoManual.Html.JsFile -public meta import VersoManual.Html.CssFile -public meta import VersoManual.Html.Features -public meta import VersoManual.LicenseInfo -public meta import VersoSearch -public meta import VersoSearch.DomainSearch -public meta import Verso.Output.Html -public meta import MultiVerso.Manifest -public meta import VersoManual.Basic +public import MultiVerso.NameMap +public import MultiVerso +public import VersoManual.Html.JsFile +public import VersoManual.Html.CssFile +public import VersoManual.Html.Features +public import VersoManual.LicenseInfo +public import VersoSearch +public import VersoSearch.DomainSearch +public import Verso.Output.Html +public import MultiVerso.Manifest +public import VersoManual.Basic import all VersoManual.Basic import VersoManual.Html.CssFile @@ -35,7 +34,7 @@ deserializes. -/ -public meta section +public section def sizedArrayOf (gen : Gen α) : Gen (Array α) := do let count ← chooseNat @@ -251,12 +250,11 @@ instance : Shrinkable LetterString where (instShrinkableLetter.shrink first |>.map (String.singleton · ++ rest)) else [] -def slugChars := Slug.validChars.toArray +def slugChars : Array Char := Slug.validChars.toArray def slugChar : Gen Char := do - have : slugChars.size > 0 := by decide +native - let ⟨i, ⟨_, h⟩⟩ ← choose Nat 0 (slugChars.size - 1) (by simp) - return slugChars[i]'(by grind) + let ⟨i, _⟩ ← choose Nat 0 (slugChars.size - 1) (by omega) + return slugChars[i]! def slugString : Gen String := do let len ← chooseNat diff --git a/src/tests/Tests/Serialization.lean b/src/tests/Tests/Serialization.lean index 70729f8af..e4f7eb8ab 100644 --- a/src/tests/Tests/Serialization.lean +++ b/src/tests/Tests/Serialization.lean @@ -6,23 +6,22 @@ Author: David Thrane Christiansen module public import Plausible public import Plausible.ArbitraryFueled -public meta import Plausible.ArbitraryFueled import Lean.Data.Json.FromToJson import all MultiVerso.InternalId -public meta import MultiVerso.NameMap -public meta import MultiVerso -public meta import VersoManual.Html.JsFile -public meta import VersoManual.Html.CssFile -public meta import VersoManual.Html.Features -public meta import VersoManual.LicenseInfo -public meta import VersoSearch -public meta import VersoSearch.DomainSearch -public meta import Verso.Output.Html -public meta import MultiVerso.Manifest -public meta import VersoManual.Basic +public import MultiVerso.NameMap +public import MultiVerso +public import VersoManual.Html.JsFile +public import VersoManual.Html.CssFile +public import VersoManual.Html.Features +public import VersoManual.LicenseInfo +public import VersoSearch +public import VersoSearch.DomainSearch +public import Verso.Output.Html +public import MultiVerso.Manifest +public import VersoManual.Basic import all VersoManual.Basic import VersoManual.Html.CssFile -public meta import Tests.Arbitrary +public import Tests.Arbitrary open Lean open Plausible Gen Arbitrary @@ -30,7 +29,7 @@ open Verso Multi open Shrinkable open Std -meta section +section def isEqOk [BEq α] (actual : Except ε α) (expected : α) : Bool := match actual with diff --git a/src/tests/VersoTests/Blog.lean b/src/tests/VersoTests/Blog.lean new file mode 100644 index 000000000..4cf4050e9 --- /dev/null +++ b/src/tests/VersoTests/Blog.lean @@ -0,0 +1,52 @@ +/- +Copyright (c) 2026 Lean FRO LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Author: David Thrane Christiansen + +Property tests for blog identifier generation. This is a non-`module` file because `VersoBlog` +itself is not part of the module system; the Errata runner imports it through its non-module main. +-/ +import VersoBlog +import VersoBlog.LiterateLeanPage +import Tests.Arbitrary +import Errata + +open Lean +open Verso Genre Blog +open Verso.Multi +open Verso.NameMap +open Plausible Gen Arbitrary +open Errata + +def freshIdOk (hint : LetterString) (path : Path) (howMany : Nat) : Bool := Id.run do + let mut st : TraverseState := { remoteContent := {} } + let mut ids := #[] + for _ in 0...howMany do + let i := st.freshId path hint.sluggify + st := { st with usedIds := st.usedIds.alter path (fun used? => used?.getD {} |>.insert i) } + ids := ids.push i + ids.size == howMany && ids.all (ids.count · == 1) + +def freshIdFirstIsHint (hint : LetterString) (path : Path) : Bool := Id.run do + let st : TraverseState := { remoteContent := {} } + let i := st.freshId path hint.sluggify + hint.isEmpty || i == hint.sluggify + +def freshIdSecondIsHintWith1 (hint : LetterString) (path : Path) : Bool := Id.run do + let mut st : TraverseState := { remoteContent := {} } + let i := st.freshId path hint.sluggify + st := { st with usedIds := st.usedIds.alter path (fun used? => used?.getD {} |>.insert i) } + let i' := st.freshId path hint.sluggify + i != i' && (hint.isEmpty || (i == hint.sluggify && i' == (s!"{hint}1").sluggify)) + +/-- Identifiers freshly generated within a path are unique. -/ +@[test] +def freshIdsAreUnique : Test := property (∀ h p n, freshIdOk h p n) + +/-- The first identifier generated for a hint is the hint itself. -/ +@[test] +def freshIdFirst : Test := property (∀ h p, freshIdFirstIsHint h p) + +/-- The second identifier generated for a hint is the hint with `1` appended. -/ +@[test] +def freshIdSecond : Test := property (∀ h p, freshIdSecondIsHintWith1 h p) diff --git a/src/tests/VersoTests/BuildLog.lean b/src/tests/VersoTests/BuildLog.lean index bdc7eec1f..05e90a6b2 100644 --- a/src/tests/VersoTests/BuildLog.lean +++ b/src/tests/VersoTests/BuildLog.lean @@ -6,8 +6,7 @@ Author: David Thrane Christiansen module public import Verso -public import Errata -public meta import Errata +import Errata open Verso Errata @@ -18,7 +17,7 @@ format, and how logging interacts with the exit code and the ambient output stre /-- A message logged with a `pos` location is saved with that file and position. -/ @[test] -def savesPosition : TestM Unit := do +def savesPosition : Test := do let logger ← Logger.new let pos : Lean.Lsp.Position := { line := 4, character := 2 } (reportError "boom" (some { file := "PosSave.lean", span := .pos pos }) : BuildLogT IO Unit).run logger @@ -34,7 +33,7 @@ def savesPosition : TestM Unit := do /-- A `range` span is likewise saved. -/ @[test] -def savesRange : TestM Unit := do +def savesRange : Test := do let logger ← Logger.new let r : Lean.Lsp.Range := { start := { line := 1, character := 0 }, «end» := { line := 1, character := 5 } } @@ -50,7 +49,7 @@ Range formatting defers to Lean's `mkErrorStringWithPos`: `file:line:col-line:co line and 0-based column, keeping the full end position even within one line. -/ @[test] -def rangeFormat : TestM Unit := do +def rangeFormat : Test := do let crossLine : LogMessage := { severity := .error, text := "msg", loc := some { @@ -70,7 +69,7 @@ def rangeFormat : TestM Unit := do /-- A located message is formatted uniformly as `file:line:col: text` on stderr. -/ @[test] -def fileLocationFormat : TestM Unit := do +def fileLocationFormat : Test := do let logger ← Logger.new let out ← captureOutput <| (reportError "bad term" (some { file := "FileLoc.lean", span := .pos { line := 6, character := 3 } }) @@ -82,7 +81,7 @@ def fileLocationFormat : TestM Unit := do /-- Errors set a non-zero exit code; warnings do not. -/ @[test] -def exitCode : TestM Unit := do +def exitCode : Test := do let withErrors ← Logger.new (do reportError "e1"; reportWarning "w1"; reportError "e2" : BuildLogT IO Unit).run withErrors assertEq 2 (← withErrors.errors).size @@ -97,7 +96,7 @@ Logging writes to the ambient stderr, resolved at log time: a logger created bef redirection still writes into the redirected stream, and nothing goes to stdout. -/ @[test] -def ambientStderr : TestM Unit := do +def ambientStderr : Test := do let logger ← Logger.new let out ← captureOutput do (do diff --git a/src/tests/VersoTests/Serialization.lean b/src/tests/VersoTests/Serialization.lean new file mode 100644 index 000000000..99a2aa3f5 --- /dev/null +++ b/src/tests/VersoTests/Serialization.lean @@ -0,0 +1,103 @@ +/- +Copyright (c) 2026 Lean FRO LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Author: David Thrane Christiansen + +Round-trip property tests for Verso's serialization. The generators and the `roundTripOk`/`isEqOk` +helpers live in `Tests.Serialization`; they construct Verso types whose constructors are private, so +they stay module-internal there and are reached here through `import all`. +-/ +module + +import Errata +import all Tests.Serialization + +open Lean +open Verso Multi +open Errata + +/-- Internal identifiers round-trip through JSON. -/ +@[test] +def internalId : Test := property (∀ id : InternalId, roundTripOk id) + +/-- Objects round-trip through JSON. -/ +@[test] +def object : Test := property (∀ obj : Object, roundTripOk obj) + +/-- Domains round-trip through JSON. -/ +@[test] +def domain : Test := property (∀ dom : Domain, roundTripOk dom) + +/-- Reference domains round-trip through JSON. -/ +@[test] +def refDomain : Test := property (∀ dom : RefDomain, roundTripOk dom) + +/-- Reference objects round-trip through JSON. -/ +@[test] +def refObject : Test := property (∀ obj : RefObject, roundTripOk obj) + +/-- Remote information round-trips through JSON. -/ +@[test] +def remoteInfo : Test := property (∀ info : RemoteInfo, roundTripOk info) + +/-- The collection of remotes round-trips through JSON. -/ +@[test] +def allRemotes : Test := property (∀ remotes : AllRemotes, roundTripOk remotes) + +/-- Manual traverse state round-trips through JSON. -/ +@[test] +def traverseState : Test := + property (∀ st : Verso.Genre.Manual.TraverseState, roundTripOk st) + +/-- HTML round-trips through JSON. -/ +@[test] +def html : Test := property (∀ html : Verso.Output.Html, roundTripOk html) + +/-- Manual data files round-trip through JSON. -/ +@[test] +def dataFile : Test := property (∀ f : Verso.Genre.Manual.DataFile, roundTripOk f) + +/-- Manual numbering round-trips through JSON. -/ +@[test] +def numbering : Test := property (∀ n : Verso.Genre.Manual.Numbering, roundTripOk n) + +/-- Cross-reference sources round-trip through JSON. -/ +@[test] +def xrefSource : Test := + property (∀ src : XrefSource, isEqOk (XrefSource.fromJson? src.toJson) src) + +/-- Remotes round-trip through JSON. -/ +@[test] +def remote : Test := + property (∀ r : Remote, isEqOk (Remote.fromJson? "" r.toJson) r) + +/-- Search domain mappers and search priorities round-trip through JSON. -/ +@[test] +def searchPriorities : Test := + property <| ∀ (semantic fullText : Fin 100) (domains : Verso.NameMap (Fin 100)), + let mapper : Search.DomainMapper := + { displayName := "d", className := "c", dataToSearchables := "x => []" } + let priorities : Search.SearchPriorities := { semantic, fullText, domains } + roundTripOk mapper ∧ roundTripOk priorities + +/-- +Every entry `Verso.Search.priorityMapJson` produces is a non-neutral integer tied to an input +doc's {name}`IndexDoc.id` and {name}`IndexDoc.priority`, and every input doc with a non-neutral +priority has its id present. Documents with no priority or the neutral value `50` are omitted. +-/ +@[test] +def priorityMapJson : Test := + property <| ∀ docs : Array Search.IndexDoc, + let j : Json := Search.priorityMapJson docs + let entries : Array (String × Json) := + match Json.getObj? j with + | .error _ => #[] + | .ok obj => obj.toArray + let forward := entries.all fun (k, v) => + match Json.getInt? v with + | .error _ => false + | .ok p => p != 50 && docs.any fun d => d.id == k && d.priority == some p + let backward := docs.all fun d => + let isNeutral := d.priority.isNone || d.priority == some 50 + isNeutral || (Json.getObjVal? j d.id).toOption.isSome + forward ∧ backward diff --git a/src/tests/VersoTests/Stemmer.lean b/src/tests/VersoTests/Stemmer.lean index c36bf797a..1c7b3f919 100644 --- a/src/tests/VersoTests/Stemmer.lean +++ b/src/tests/VersoTests/Stemmer.lean @@ -6,8 +6,7 @@ Author: David Thrane Christiansen module public import VersoSearch.PorterStemmer -public import Errata -public meta import Errata +import Errata open Verso.Search.Stemmer.Porter Errata @@ -17,7 +16,7 @@ Tests the Porter stemmer against the standard vocabulary and its expected output /-- The Porter stemmer reproduces the reference output for every word in the standard vocabulary. -/ @[test] -def porterStemmer : TestM Unit := do +def porterStemmer : Test := do let vocabulary := (include_str "../stemmer/voc.txt").splitOn "\n" let expected := (include_str "../stemmer/output.txt").splitOn "\n" let mut mismatches : Array String := #[] diff --git a/src/tests/VersoTests/Zip.lean b/src/tests/VersoTests/Zip.lean index e30c51abd..27e5126aa 100644 --- a/src/tests/VersoTests/Zip.lean +++ b/src/tests/VersoTests/Zip.lean @@ -6,8 +6,7 @@ Author: David Thrane Christiansen module public import VersoUtil.Zip -public import Errata -public meta import Errata +import Errata open Verso.Zip Errata @@ -48,7 +47,7 @@ def extractRoundTrips (files : Array (String × ByteArray)) (method : Compressio /-- Fixed file sets round-trip under both compression methods. -/ @[test] -def zipFixed : TestM Unit := do +def zipFixed : Test := do let files := #[("x.txt", "abcdef\nlkjlkj".toByteArray), ("y.txt", "".toByteArray), ("z.txt", "abc\n\n".toByteArray)] for method in [CompressionMethod.store, .deflate] do @@ -58,7 +57,7 @@ def zipFixed : TestM Unit := do /-- Increasingly large prefixes of a block round-trip, alone and paired with another. -/ @[test] -def zipChunked : TestM Unit := do +def zipChunked : Test := do let me := sampleBytes let bwd := me.foldl (init := .empty) fun acc b => ByteArray.empty.push b ++ acc let chunk := me.size / 10 @@ -70,7 +69,7 @@ def zipChunked : TestM Unit := do /-- Random file sets round-trip under both compression methods. -/ @[test] -def zipRandom : TestM Unit := do +def zipRandom : Test := do for _ in [0:10] do let seed ← IO.monoNanosNow IO.setRandSeed seed From 5501fcde4fe546e9076235e28e99e3cb49ee3452 Mon Sep 17 00:00:00 2001 From: David Thrane Christiansen Date: Wed, 24 Jun 2026 23:25:11 +0200 Subject: [PATCH 06/26] Migrate the rest --- lakefile.lean | 6 - src/errata/Errata/Assertions.lean | 18 + src/tests/TestMain.lean | 394 ------------- src/tests/Tests.lean | 3 - src/tests/Tests/LiterateConfig.lean | 359 ------------ src/tests/Tests/SearchJs.lean | 117 ---- src/tests/VersoTests/Interactive.lean | 20 + src/tests/VersoTests/LiterateConfig.lean | 292 ++++++++++ .../{Tests => VersoTests}/LiterateHtml.lean | 537 +++++++++--------- src/tests/VersoTests/SearchJs.lean | 82 +++ src/tests/VersoTests/SetupLiterate.lean | 63 ++ src/tests/VersoTests/TeX.lean | 74 +++ .../literate-config/lake-manifest.json | 119 ++-- .../literate-multi-root/lake-manifest.json | 119 ++-- 14 files changed, 914 insertions(+), 1289 deletions(-) delete mode 100644 src/tests/TestMain.lean delete mode 100644 src/tests/Tests/LiterateConfig.lean delete mode 100644 src/tests/Tests/SearchJs.lean create mode 100644 src/tests/VersoTests/Interactive.lean create mode 100644 src/tests/VersoTests/LiterateConfig.lean rename src/tests/{Tests => VersoTests}/LiterateHtml.lean (69%) create mode 100644 src/tests/VersoTests/SearchJs.lean create mode 100644 src/tests/VersoTests/SetupLiterate.lean create mode 100644 src/tests/VersoTests/TeX.lean diff --git a/lakefile.lean b/lakefile.lean index c21bc85ea..ed59b43fb 100644 --- a/lakefile.lean +++ b/lakefile.lean @@ -314,12 +314,6 @@ script «errata-test» (args) do lean_lib Tests where srcDir := "src/tests" --- The legacy ad-hoc test runner. The Errata driver below is the active test driver. -lean_exe «verso-tests» where - root := `TestMain - srcDir := "src/tests" - supportInterpreter := true - lean_lib UsersGuide where srcDir := "doc" leanOptions := #[⟨`weak.linter.verso.manual.headerTags, true⟩] diff --git a/src/errata/Errata/Assertions.lean b/src/errata/Errata/Assertions.lean index ec14e7758..34e6c6bad 100644 --- a/src/errata/Errata/Assertions.lean +++ b/src/errata/Errata/Assertions.lean @@ -43,3 +43,21 @@ def assertFileExists (path : System.FilePath) (loc : Location := by exact here%) : TestM Unit := do unless ← path.pathExists do failAt loc s!"file does not exist: {path}" + +/-- Asserts that an option is absent. -/ +def assertNone {α} [Repr α] (value : Option α) + (loc : Location := by exact here%) : Test := do + if let some v := value then + failAt loc s!"expected none, got {repr v}" + +/-- Asserts that an option is present, returning its contents. -/ +def assertSome {α} (value : Option α) + (loc : Location := by exact here%) : TestM α := + match value with + | some v => pure v + | none => throw { message := "expected some, got none", location? := some loc } + +/-- Asserts that an option is present, without inspecting its contents. -/ +def assertIsSome {α} (value : Option α) + (loc : Location := by exact here%) : Test := + discard (assertSome value loc) diff --git a/src/tests/TestMain.lean b/src/tests/TestMain.lean deleted file mode 100644 index f77fde9bc..000000000 --- a/src/tests/TestMain.lean +++ /dev/null @@ -1,394 +0,0 @@ -/- -Copyright (c) 2025 Lean FRO LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Author: David Thrane Christiansen --/ - -import Verso -import VersoManual -import VersoSearch.PorterStemmer -import VersoUtil.LzCompress -import VersoLiterate -import Tests - -structure Config where - verbose : Bool := false - updateExpected : Bool := false - checkTeX : Bool := false - -open Verso.Search.Stemmer.Porter in -def testStemmer (_ : Config) : IO Unit := do - let voc := include_str "stemmer/voc.txt" - let output := include_str "stemmer/output.txt" - - let data := voc.splitOn "\n" - let outData := output.splitOn "\n" - - let mut failures := #[] - for x in data, y in outData do - let s := porterStem x - unless s == y do - failures := failures.push (x, s, y) - unless failures.isEmpty do - IO.eprintln s!"{failures.size} failures" - for (x, s, y) in failures do - IO.eprintln s!"{x} --> {s} (wanted '{y}')" - throw <| IO.userError "Stemmer tests failed" - -/-- -Tests manual-genre TeX generation. `dir` is a subdirectory specific to a particular test document, -which is where actual output should go, and which contains the expected output directory. -`doc` is the document to be rendered. --/ -def testTexOutput - (dir : System.FilePath) - (doc : Verso.Doc.VersoDoc Verso.Genre.Manual) - (config : Config) - (extraFiles : List (System.FilePath × String) := []) - (extraFilesTeX : List (System.FilePath × String) := []) : IO Unit := do - let versoConfig : Verso.Genre.Manual.Config := { - destination := "src/tests/integration" / dir / "output", - emitTeX := true, - emitHtmlMulti := .no, - extraFiles, - extraFilesTeX - } - - let runTest : IO Unit := - open Verso Genre Manual in do - let logger ← Verso.Logger.new - emitTeX versoConfig doc.toPart |>.run extension_impls% |>.run logger - - Verso.Integration.runTests { config with - testDir := "src/tests/integration" / dir, - updateExpected := config.updateExpected, - runTest - } - -def testZip (cfg : Config) : IO Unit := do - IO.println "Running zip tests with fixed files..." - testExtract #[] .store - testExtract #[] .deflate - testExtract #[("empty", .empty)] .store - testExtract #[("empty", .empty)] .deflate - testExtract files .store - testExtract files .deflate - let chunkSize := me.size / 10 - for i in (0 : Nat)...10 do - let me := me.extract 0 (i * chunkSize) - testExtract #[("T2.lean", me)] .store - testExtract #[("T2.lean", me)] .deflate - for i in (0 : Nat)...10 do - let me := me.extract 0 (i * chunkSize) - let bwd := bwd.extract 0 (i * chunkSize) - testExtract #[("T2.lean", me), ("other", bwd)] .store - testExtract #[("T2.lean", me), ("other", bwd)] .deflate - for _ in (0 : Nat)...10 do - let seedValue ← IO.monoNanosNow - if cfg.verbose then IO.println s!"Seed is {seedValue}" - IO.setRandSeed seedValue - let mut randFiles := #[] - for _ in 0...(← IO.rand 0 15) do - let name ← randName - let size ← IO.rand 0 50000 - let content ← IO.getRandomBytes <| .ofNat size - randFiles := randFiles.push (name, content) - if cfg.verbose then - IO.println s!"Running random zip test with {randFiles.size} files, sizes:" - for (x, y) in randFiles do - IO.println s!" * {x}: {y.size} bytes" - else - IO.println s!"Running random zip test with {randFiles.size} files" - testExtract randFiles .store - testExtract randFiles .deflate - -where - files := #[("x.txt", "abcdef\nlkjlkj".toByteArray), ("y.txt", "".toByteArray), ("z.txt", "abc\n\n".toByteArray)] - me := (include_str "TestMain.lean").toByteArray - bwd := me.foldl (init := .empty) fun x y => ByteArray.empty.push y ++ x - randName : IO String := do - let len ← IO.rand 1 10 - let stem ← len.foldM (init := "") fun _ _ acc => do - return acc.push <| Char.ofNat ('a'.toNat + (← IO.rand 0 25)) - let len ← IO.rand 2 4 - let ext ← len.foldM (init := "") fun _ _ acc => do - return acc.push <| Char.ofNat ('a'.toNat + (← IO.rand 0 25)) - return stem ++ "." ++ ext - -open Verso.LzCompress in -def testLz (_ : Config) : IO Unit := do - let actual := lzCompress r#"import Mathlib.Logic.Basic -- basic facts in logic --- theorems in Lean's mathematics library - --- Let P and Q be true-false statements -variable (P Q : Prop) - --- The following is a basic result in logic -example : ¬ (P ∧ Q) ↔ ¬ P ∨ ¬ Q := by - -- its proof is already in Lean's mathematics library - exact not_and_or - --- Here is another basic result in logic -example : ¬ (P ∨ Q) ↔ ¬ P ∧ ¬ Q := by - apply? -- we can search for the proof in the library - -- we can also replace `apply?` with its output -"# - let expected := - "JYWwDg9gTgLgBAWQIYwBYBtgCMB0AZCAc2AGMcAhJAZ1LgFo64traAzJEmKuYAOznRFSAKAZw0AU2gSQ3" ++ - "PnDwSkvAOTcQKVDJSlumLFCRQAnsNGNF8AApxlAEzgBFJhPFQArhLrt0VV1RgUGQleLmEANyNgJCx0VwA" ++ - "KG2cALjgrKAgwAEozMQAVLThWCHRBAHc+Qh5uJCYWEjgoCSp3dHh5QWISYQkADyRwOLhUgBq4RLhAciIn" ++ - "LLhAFMI4MZtACiJFp2GAXiZTOHpGYC44MAyIVmrbdCakO2MefkVlNTgNSRfdAWxDE2Fdvo54XgQGAAfXs" ++ - "wOguUYAAkJE1zsogVooHUaA0mi02ncBEJun9Bq5RuMVjN5msbNMxiktlgdrYwGB0MYAPx7OBlVwkZRwPx" ++ - "GEioIrQcSFY4QU5YyQfAxGWlidlwTn8JC+CCNCQMjiuAAGSHpjKZmrZB35B24EHcMDA5uEQA" - if actual ≠ expected then - throw <| IO.userError "Mismatched lzCompress output" - -def testSerialization (_ : Config) : IO Unit := do - IO.println "Running serialization tests with Plausible..." - let fails ← runSerializationTests - if fails > 0 then - throw <| IO.userError s!"{fails} serialization tests failed" - -def testSearchJs (_ : Config) : IO Unit := do - IO.println "Running search JS wire-format tests..." - let fails ← Verso.Tests.SearchJs.runSearchJsTests - if fails > 0 then - throw <| IO.userError s!"{fails} search JS tests failed" - -def testBlog (_ : Config) : IO Unit := do - IO.println "Running blog tests with Plausible..." - let fails ← runBlogTests - if fails > 0 then - throw <| IO.userError s!"{fails} blog tests failed" - -def testLiterateConfig (_ : Config) : IO Unit := do - let fails ← Tests.LiterateConfig.runLiterateConfigTests - if fails > 0 then - throw <| IO.userError s!"{fails} literate config tests failed" - -def testLiterateHtml (_ : Config) : IO Unit := - Tests.LiterateHtml.testLiterateHtml - -def testLiterateHtmlMultiRoot (_ : Config) : IO Unit := - Tests.LiterateHtml.testLiterateHtmlMultiRoot - --- Interactive tests via the LSP server -def testInteractive (_ : Config) : IO Unit := do - IO.println "Running interactive (LSP) tests..." - IO.println s!"current dir: {(← IO.Process.getCurrentDir)}" - -- We use the lower-level Process.spawn, which causes the subprocess to inherit the stdio - let child ← IO.Process.spawn { cmd := "src/tests/interactive/run_interactive.sh" } - let exitCode ← child.wait - if exitCode != 0 then - throw <| IO.userError s!"Interactive LSP tests failed with exit code {exitCode}" - -private def hasSubstring (s : String) (sub : String) : Bool := - s.find? sub |>.isSome - -def testSetupLiterate (_ : Config) : IO Unit := do - IO.println "Running setup-literate tests..." - let versoRoot ← IO.FS.realPath "." - IO.FS.withTempDir fun tmpDir => do - let run (cmd : String) (args : Array String) : IO Unit := do - let result ← IO.Process.output { - cmd := cmd - args := args - cwd := some tmpDir.toString - } - if result.exitCode != 0 then - throw <| IO.userError s!"{cmd} failed: {result.stderr}" - - -- Set up a project that depends on the Verso being tested - run "git" #["init", "-q"] - let toolchain ← IO.FS.readFile "lean-toolchain" - IO.FS.writeFile (tmpDir / "lean-toolchain") toolchain - IO.FS.writeFile (tmpDir / "lakefile.toml") - s!"name = \"test-project\"\n\n[[require]]\nname = \"verso\"\npath = \"{versoRoot}\"\n" - - -- Test 1: Fresh generation via lake exe - let result ← IO.Process.output { - cmd := "lake" - args := #["exe", "verso", "setup-literate"] - cwd := some tmpDir.toString - } - if result.exitCode != 0 then - throw <| IO.userError s!"setup-literate failed: {result.stderr}\n{result.stdout}" - - let workflowFile := tmpDir / ".github" / "workflows" / "verso-literate-pages.yml" - unless ← workflowFile.pathExists do - throw <| IO.userError "Workflow file was not created" - - let content ← IO.FS.readFile workflowFile - let checks := #[ - ("lake query :literateHtml", "lake query command"), - ("deploy-pages@v", "deploy-pages action"), - ("upload-pages-artifact@v", "upload-pages-artifact action"), - ("lean-action@v", "lean-action") - ] - for (needle, desc) in checks do - unless hasSubstring content needle do - throw <| IO.userError s!"Workflow file missing {desc} ({needle})" - IO.println " fresh generation: passed" - - -- Test 2: Idempotent (no change) - let result2 ← IO.Process.output { - cmd := "lake" - args := #["exe", "verso", "setup-literate"] - cwd := some tmpDir.toString - } - unless hasSubstring result2.stdout "up to date" do - throw <| IO.userError "Expected 'up to date' message on second run" - IO.println " idempotent: passed" - - -- Test 3: Outdated file gets .bak - IO.FS.writeFile workflowFile "modified content\n" - let result3 ← IO.Process.output { - cmd := "lake" - args := #["exe", "verso", "setup-literate"] - cwd := some tmpDir.toString - } - if result3.exitCode != 0 then - throw <| IO.userError s!"setup-literate (update) failed: {result3.stderr}" - let bakFile := tmpDir / ".github" / "workflows" / "verso-literate-pages.yml.bak" - unless ← bakFile.pathExists do - throw <| IO.userError ".bak file was not created when updating" - let bakContent ← IO.FS.readFile bakFile - unless hasSubstring bakContent "modified content" do - throw <| IO.userError ".bak file should contain old content" - IO.println " backup on update: passed" - - IO.println " All setup-literate tests passed." - -open Verso in -def testBuildLog (_ : Config) : IO Unit := do - IO.println "Running build-log tests..." - -- A message logged with a position is saved with that location (a location always names a file). - let logger ← Logger.new - let pos : Lean.Lsp.Position := { line := 4, character := 2 } - (reportError "boom" (some { file := "PosSave.lean", span := .pos pos }) : BuildLogT IO Unit).run logger - let errs ← logger.errors - let some m := errs[0]? - | throw <| IO.userError s!"expected 1 saved error, got {errs.size}" - unless m.severity == .error do throw <| IO.userError "expected error severity" - match m.loc with - | some { file := "PosSave.lean", span := .pos p } => - unless p.line == 4 && p.character == 2 do - throw <| IO.userError "saved position does not match the logged span" - | _ => throw <| IO.userError "expected a saved `PosSave.lean` `pos` location" - - -- A `range` span is likewise saved. - let logger2 ← Logger.new - let r : Lean.Lsp.Range := - { start := { line := 1, character := 0 }, «end» := { line := 1, character := 5 } } - (reportWarning "careful" (some { file := "RangeSave.lean", span := .range r }) : BuildLogT IO Unit).run logger2 - let some w := (← logger2.warnings)[0]? - | throw <| IO.userError "expected 1 saved warning" - match w.loc with - | some { span := .range _, .. } => pure () - | _ => throw <| IO.userError "expected a `range` span to be saved" - - -- Range formatting defers to Lean's `mkErrorStringWithPos`: `file:line:col-line:col`, 1-based - -- line, 0-based column, with the full end position even within one line (no `line:col-col` collapse). - let crossLine : LogMessage := - { severity := .error, text := "msg", - loc := some { file := "CrossLine.lean", - span := .range { start := { line := 19, character := 4 }, «end» := { line := 20, character := 7 } } } } - unless crossLine.format == "CrossLine.lean:20:4-21:7: msg" do - throw <| IO.userError s!"cross-line range formatted as \"{crossLine.format}\"" - let sameLine : LogMessage := - { severity := .error, text := "msg", - loc := some { file := "SameLine.lean", - span := .range { start := { line := 42, character := 4 }, «end» := { line := 42, character := 21 } } } } - unless sameLine.format == "SameLine.lean:43:4-43:21: msg" do - throw <| IO.userError s!"same-line range formatted as \"{sameLine.format}\"" - - -- A located message is formatted uniformly as `file:line:col: text`. - let loggerF ← Logger.new - let errBufF ← IO.mkRef ({} : IO.FS.Stream.Buffer) - IO.withStderr (IO.FS.Stream.ofBuffer errBufF) <| - (reportError "bad term" (some { file := "FileLoc.lean", span := .pos { line := 6, character := 3 } }) - : BuildLogT IO Unit).run loggerF - let some mF := (← loggerF.errors)[0]? - | throw <| IO.userError "expected 1 saved error with a file location" - unless mF.loc.map (·.file) == some "FileLoc.lean" do - throw <| IO.userError "saved location should carry the filename" - unless hasSubstring (String.fromUTF8! (← errBufF.get).data) "FileLoc.lean:7:3: bad term" do - throw <| IO.userError "a file location should format as file:line:col:" - - -- A single logging action can emit both severities; errors set the exit code, warnings do not. - let logger3 ← Logger.new - (do reportError "e1"; reportWarning "w1"; reportError "e2" : BuildLogT IO Unit).run logger3 - unless (← logger3.errors).size == 2 do throw <| IO.userError "expected 2 errors" - unless (← logger3.warnings).size == 1 do throw <| IO.userError "expected 1 warning" - unless (← logger3.exitCode) == 1 do throw <| IO.userError "errors must yield a non-zero exit code" - - let logger4 ← Logger.new - (reportWarning "just a warning" : BuildLogT IO Unit).run logger4 - unless (← logger4.exitCode) == 0 do - throw <| IO.userError "warnings must not affect the exit code" - - -- Logging prints to the *ambient* stderr, resolved at log time: a logger created before a - -- stderr redirection still writes into the redirected stream, and nothing goes to stdout. - let logger5 ← Logger.new - let outBuf ← IO.mkRef ({} : IO.FS.Stream.Buffer) - let errBuf ← IO.mkRef ({} : IO.FS.Stream.Buffer) - IO.withStdout (IO.FS.Stream.ofBuffer outBuf) <| - IO.withStderr (IO.FS.Stream.ofBuffer errBuf) <| - (do - reportError "first problem" (some { file := "X.lean", span := .pos { line := 0, character := 0 } }) - reportWarning "second problem" : BuildLogT IO Unit).run logger5 - let errText := String.fromUTF8! (← errBuf.get).data - let outText := String.fromUTF8! (← outBuf.get).data - unless hasSubstring errText "X.lean:1:0: first problem" do - throw <| IO.userError s!"stderr buffer is missing the formatted error; got: {errText}" - unless hasSubstring errText "second problem" do - throw <| IO.userError s!"stderr buffer is missing the warning; got: {errText}" - unless outText.isEmpty do - throw <| IO.userError s!"logging must not write to stdout; got: {outText}" - unless (← logger5.errors).size == 1 && (← logger5.warnings).size == 1 do - throw <| IO.userError "redirected logging should still accumulate into the logger's buffers" - IO.println " All build-log tests passed." - -open Verso.Integration in -def tests := [ - testBuildLog, - testSerialization, - testSearchJs, - testBlog, - testStemmer, - testTexOutput "sample-doc" SampleDoc.doc, - testTexOutput "inheritance-doc" InheritanceDoc.doc, - testTexOutput "code-content-doc" CodeContent.doc, - testTexOutput "extra-files-doc" ExtraFilesDoc.doc - (extraFiles := [("src/tests/integration/extra-files-doc/test-data/shared", "shared")]) - (extraFilesTeX := [("src/tests/integration/extra-files-doc/test-data/TeX-only", "TeX-only")]), - testTexOutput "front-matter-doc" FrontMatter.doc, - testTexOutput "diagram-doc" DiagramDoc.doc, - testZip, - testInteractive, - testLiterateConfig, - testLiterateHtml, - testLiterateHtmlMultiRoot, - testSetupLiterate -] - -def getConfig (config : Config) : List String → IO Config - | [] => pure config - | "--update-expected" :: args => getConfig { config with updateExpected := true } args - | "--verbose" :: args | "-v" :: args => getConfig { config with verbose := true } args - | "--check-tex" :: args => getConfig { config with checkTeX := true } args - | other :: _ => throw <| IO.userError s!"Didn't understand {other}" - -def main (args : List String) : IO UInt32 := do - let config ← getConfig {} args - let mut failures := 0 - for test in tests do - try - test config - catch - | e => do - IO.eprintln e - failures := failures + 1 - if failures == 0 then - IO.println "All tests passed" - return failures diff --git a/src/tests/Tests.lean b/src/tests/Tests.lean index d2bf4bd40..1f87a5ac6 100644 --- a/src/tests/Tests.lean +++ b/src/tests/Tests.lean @@ -30,7 +30,6 @@ import Tests.ParserRegression import Tests.Paths import Tests.PorterStemmer import Tests.Refs -import Tests.SearchJs import Tests.ExtensionResolution import Tests.Serialization import Tests.TeX @@ -40,5 +39,3 @@ import Tests.VersoBlog import Tests.VersoManual import Tests.Z85 import Tests.Zip -import Tests.LiterateConfig -import Tests.LiterateHtml diff --git a/src/tests/Tests/LiterateConfig.lean b/src/tests/Tests/LiterateConfig.lean deleted file mode 100644 index ca366ab7d..000000000 --- a/src/tests/Tests/LiterateConfig.lean +++ /dev/null @@ -1,359 +0,0 @@ -/- -Copyright (c) 2025 Lean FRO LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Author: David Thrane Christiansen --/ -import VersoLiterate - -open Lean -open VersoLiterate - -namespace Tests.LiterateConfig - -/-- Parses a TOML string directly into a `LiterateConfig`. -/ -private def loadFromString (toml : String) : IO LiterateConfig := - parseLiterateConfig toml - -/-- Asserts that `actual` equals `expected`, throwing with a descriptive message on failure. -/ -private def assertEq [BEq α] [Repr α] (desc : String) (actual expected : α) : IO Unit := - unless actual == expected do - throw <| IO.userError s!"{desc}: expected {repr expected}, got {repr actual}" - -private def assertTrue (desc : String) (b : Bool) : IO Unit := - unless b do - throw <| IO.userError s!"{desc}: expected true, got false" - -private def assertFalse (desc : String) (b : Bool) : IO Unit := do - if b then - throw <| IO.userError s!"{desc}: expected false, got true" - -private def assertSome [Repr α] (desc : String) (o : Option α) : IO α := - match o with - | some v => pure v - | none => throw <| IO.userError s!"{desc}: expected Some, got None" - -private def assertNone [Repr α] (desc : String) (o : Option α) : IO Unit := do - if o.isSome then - throw <| IO.userError s!"{desc}: expected None, got {repr o}" - --- ===== Individual test cases ===== - -/-- A missing file results in the default config. -/ -private def testMissingFile : IO Unit := do - let config ← loadLiterateConfig "/nonexistent/path/literate.toml" - assertEq "missing file: exclude" config.exclude #[] - assertEq "missing file: order" config.order #[] - assertEq "missing file: targets" config.targets #[] - assertNone "missing file: landingPage" config.landingPage - -/-- An empty file results in the default config. -/ -private def testEmptyFile : IO Unit := do - let config ← loadFromString "" - assertEq "empty file: exclude" config.exclude #[] - assertEq "empty file: order" config.order #[] - assertEq "empty file: targets" config.targets #[] - assertNone "empty file: landingPage" config.landingPage - -/-- A whitespace-only file results in the default config. -/ -private def testWhitespaceFile : IO Unit := do - let config ← loadFromString " \n \n " - assertEq "whitespace file: exclude" config.exclude #[] - -/-- The `exclude` list is parsed into an array of `Name` values. -/ -private def testExclude : IO Unit := do - let config ← loadFromString "exclude = [\"Foo.Bar\", \"Baz\"]\n" - assertEq "exclude length" config.exclude.size 2 - assertEq "exclude[0]" config.exclude[0]! `Foo.Bar - assertEq "exclude[1]" config.exclude[1]! `Baz - -/-- The `order` list is parsed into an array of `Name` values preserving order. -/ -private def testOrder : IO Unit := do - let config ← loadFromString "order = [\"C\", \"A\", \"B\"]\n" - assertEq "order length" config.order.size 3 - assertEq "order[0]" config.order[0]! `C - assertEq "order[1]" config.order[1]! `A - assertEq "order[2]" config.order[2]! `B - -/-- The `landing_page` field is parsed as `some` of a `Name`. -/ -private def testLandingPage : IO Unit := do - let config ← loadFromString "landing_page = \"MyLib.Overview\"\n" - let lp ← assertSome "landing_page" config.landingPage - assertEq "landing_page value" lp `MyLib.Overview - -/-- `[order_children]` entries are parsed into per-parent child orderings. -/ -private def testOrderChildren : IO Unit := do - let config ← loadFromString "[order_children]\n\"Foo\" = [\"Foo.B\", \"Foo.A\"]\n\"Bar\" = [\"Bar.Z\"]\n" - let fooChildren := config.orderChildren.find? `Foo - let fc ← assertSome "order_children: Foo" fooChildren - assertEq "order_children: Foo length" fc.size 2 - assertEq "order_children: Foo[0]" fc[0]! `Foo.B - assertEq "order_children: Foo[1]" fc[1]! `Foo.A - let barChildren := config.orderChildren.find? `Bar - let bc ← assertSome "order_children: Bar" barChildren - assertEq "order_children: Bar length" bc.size 1 - assertEq "order_children: Bar[0]" bc[0]! `Bar.Z - -/-- `[[targets]]` table entries are parsed into `Target` values with optional fields. -/ -private def testTargets : IO Unit := do - let config ← loadFromString "[[targets]]\nmodule = \"Foo\"\n\n[[targets]]\nlibrary = \"Bar\"\n" - assertEq "targets length" config.targets.size 2 - let t0 ← assertSome "targets[0].module" config.targets[0]!.module - assertEq "targets[0].module value" t0 `Foo - assertNone "targets[0].library" config.targets[0]!.library - let t1 ← assertSome "targets[1].library" config.targets[1]!.library - assertEq "targets[1].library value" t1 `Bar - assertNone "targets[1].module" config.targets[1]!.module - -/-- Multiple fields in the same file are all parsed correctly. -/ -private def testCombined : IO Unit := do - let toml := "exclude = [\"Private\"]\norder = [\"Public\", \"Examples\"]\nlanding_page = \"Public\"\n" - let config ← loadFromString toml - assertEq "combined: exclude length" config.exclude.size 1 - assertEq "combined: exclude[0]" config.exclude[0]! `Private - assertEq "combined: order length" config.order.size 2 - assertEq "combined: order[0]" config.order[0]! `Public - assertEq "combined: order[1]" config.order[1]! `Examples - let lp ← assertSome "combined: landing_page" config.landingPage - assertEq "combined: landing_page value" lp `Public - -/-- Invalid TOML produces an error. -/ -private def testInvalidToml : IO Unit := do - let mut caught := false - try - let _ ← loadFromString "this is not valid toml {{{" - catch _ => - caught := true - assertTrue "invalid TOML should throw" caught - -/-- `hide_commands` is parsed into an array of keyword pattern strings. -/ -private def testHideCommands : IO Unit := do - let config ← loadFromString "hide_commands = [\"set_option\", \"#check\"]\n" - assertEq "hide_commands length" config.hideCommands.size 2 - assertEq "hide_commands[0]" config.hideCommands[0]! "set_option" - assertEq "hide_commands[1]" config.hideCommands[1]! "#check" - -/-- `[metadata]` table is parsed into a `Metadata` value. -/ -private def testMetadata : IO Unit := do - let config ← loadFromString "[metadata]\ntitle = \"My Site\"\ndescription = \"A test site\"\nfavicon = \"favicon.ico\"\n" - let title ← assertSome "metadata.title" config.metadata.title - assertEq "metadata.title value" title "My Site" - let desc ← assertSome "metadata.description" config.metadata.description - assertEq "metadata.description value" desc "A test site" - let fav ← assertSome "metadata.favicon" config.metadata.favicon - assertEq "metadata.favicon value" fav "favicon.ico" - -/-- `extra_css` and `extra_js` are parsed into string arrays. -/ -private def testExtraCssJs : IO Unit := do - let config ← loadFromString "extra_css = [\"custom.css\", \"theme.css\"]\nextra_js = [\"analytics.js\"]\n" - assertEq "extra_css length" config.extraCss.size 2 - assertEq "extra_css[0]" config.extraCss[0]! "custom.css" - assertEq "extra_css[1]" config.extraCss[1]! "theme.css" - assertEq "extra_js length" config.extraJs.size 1 - assertEq "extra_js[0]" config.extraJs[0]! "analytics.js" - -/-- `show_docstrings = false` is parsed correctly. -/ -private def testShowDocstrings : IO Unit := do - let config ← loadFromString "show_docstrings = false\n" - assertFalse "show_docstrings" config.showDocstrings - -/-- `show_docstrings_for` is parsed into an array of `Name` values. -/ -private def testShowDocstringsFor : IO Unit := do - let config ← loadFromString "show_docstrings = false\nshow_docstrings_for = [\"Foo.bar\", \"Baz.qux\"]\n" - assertFalse "show_docstrings" config.showDocstrings - assertEq "show_docstrings_for length" config.showDocstringsFor.size 2 - assertEq "show_docstrings_for[0]" config.showDocstringsFor[0]! `Foo.bar - assertEq "show_docstrings_for[1]" config.showDocstringsFor[1]! `Baz.qux - -/-- `hide_docstrings_for` is parsed into an array of `Name` values. -/ -private def testHideDocstringsFor : IO Unit := do - let config ← loadFromString "hide_docstrings_for = [\"Foo.internal\"]\n" - assertTrue "show_docstrings default" config.showDocstrings - assertEq "hide_docstrings_for length" config.hideDocstringsFor.size 1 - assertEq "hide_docstrings_for[0]" config.hideDocstringsFor[0]! `Foo.internal - -/-- `show_output` is parsed into an array of keyword pattern strings. -/ -private def testShowOutput : IO Unit := do - let config ← loadFromString "show_output = [\"#eval\"]\n" - assertEq "show_output length" config.showOutput.size 1 - assertEq "show_output[0]" config.showOutput[0]! "#eval" - -/-- `show_output` defaults to the standard 4-element list. -/ -private def testShowOutputDefault : IO Unit := do - let config ← loadFromString "" - assertEq "show_output default length" config.showOutput.size 4 - -/-- `show_imports = false` is parsed correctly. -/ -private def testShowImports : IO Unit := do - let config ← loadFromString "show_imports = false\n" - assertFalse "show_imports" config.showImports - -/-- `show_imports` defaults to true. -/ -private def testShowImportsDefault : IO Unit := do - let config ← loadFromString "" - assertTrue "show_imports default" config.showImports - -/-- Multiple new fields combined in one config. -/ -private def testCombinedNew : IO Unit := do - let toml := String.intercalate "\n" [ - "exclude = [\"Private\"]", - "hide_commands = [\"set_option\"]", - "extra_css = [\"style.css\"]", - "show_docstrings = false", - "show_docstrings_for = [\"Public.api\"]", - "[metadata]", - "title = \"Test\"", - "" - ] - let config ← loadFromString toml - assertEq "combined new: exclude" config.exclude.size 1 - assertEq "combined new: hide_commands" config.hideCommands.size 1 - assertEq "combined new: extra_css" config.extraCss.size 1 - assertFalse "combined new: show_docstrings" config.showDocstrings - assertEq "combined new: show_docstrings_for" config.showDocstringsFor.size 1 - let title ← assertSome "combined new: metadata.title" config.metadata.title - assertEq "combined new: metadata.title value" title "Test" - -/-- `[theme]` light variables are parsed into theme map. -/ -private def testThemeLight : IO Unit := do - let toml := "[theme]\ncode_box_background_color = \"#fff\"\ntext_color = \"#111\"\n" - let config ← loadFromString toml - assertEq "theme size" config.theme.size 2 - let bg ← assertSome "theme code_box_background_color" (config.theme.get? "code_box_background_color") - assertEq "theme code_box_background_color value" bg "#fff" - let tc ← assertSome "theme text_color" (config.theme.get? "text_color") - assertEq "theme text_color value" tc "#111" - -/-- `[theme.dark]` dark variables are parsed into themeDark map. -/ -private def testThemeDark : IO Unit := do - let toml := "[theme]\ntext_color = \"#333\"\n\n[theme.dark]\ntext_color = \"#eee\"\nbackground_color = \"#111\"\n" - let config ← loadFromString toml - assertEq "theme light size" config.theme.size 1 - assertEq "themeDark size" config.themeDark.size 2 - let dt ← assertSome "themeDark text_color" (config.themeDark.get? "text_color") - assertEq "themeDark text_color value" dt "#eee" - let db ← assertSome "themeDark background_color" (config.themeDark.get? "background_color") - assertEq "themeDark background_color value" db "#111" - -/-- Empty theme produces empty maps. -/ -private def testThemeEmpty : IO Unit := do - let config ← loadFromString "" - assertEq "theme empty size" config.theme.size 0 - assertEq "themeDark empty size" config.themeDark.size 0 - -/-- `[modules."Foo.Bar"]` is parsed into a ModuleConfig. -/ -private def testModulesConfig : IO Unit := do - let toml := "[modules.\"Foo.Bar\"]\ntitle = \"Custom Title\"\nurl = \"custom-url\"\nhide_commands = [\"set_option\"]\nshow_imports = false\n" - let config ← loadFromString toml - let mc ← assertSome "modules Foo.Bar" (config.modules.find? `Foo.Bar) - let t ← assertSome "modules Foo.Bar title" mc.title - assertEq "modules Foo.Bar title value" t "Custom Title" - let u ← assertSome "modules Foo.Bar url" mc.url - assertEq "modules Foo.Bar url value" u "custom-url" - let hc ← assertSome "modules Foo.Bar hideCommands" mc.hideCommands - assertEq "modules Foo.Bar hideCommands length" hc.size 1 - let si ← assertSome "modules Foo.Bar showImports" mc.showImports - assertFalse "modules Foo.Bar showImports value" si - -/-- `resolveForModule` returns global defaults when no module config matches. -/ -private def testResolveNoMatch : IO Unit := do - let config ← loadFromString "hide_commands = [\"set_option\"]\n" - let resolved := config.resolveForModule `Unmatched.Module - assertEq "resolve no match: hideCommands" resolved.hideCommands.size 1 - assertTrue "resolve no match: showImports" resolved.showImports - assertNone "resolve no match: title" resolved.title - -/-- `resolveForModule` picks the most-specific prefix match. -/ -private def testResolvePrefixMatch : IO Unit := do - let toml := String.intercalate "\n" [ - "hide_commands = [\"set_option\"]", - "[modules.\"Foo\"]", - "show_imports = false", - "[modules.\"Foo.Bar\"]", - "title = \"Bar Title\"", - "show_imports = true", - "" - ] - let config ← loadFromString toml - -- Foo.Bar.Baz should match Foo.Bar (longest prefix) - let resolved := config.resolveForModule `Foo.Bar.Baz - let t ← assertSome "resolve prefix: title" resolved.title - assertEq "resolve prefix: title value" t "Bar Title" - assertTrue "resolve prefix: showImports" resolved.showImports - -- Foo.Qux should match Foo - let resolved2 := config.resolveForModule `Foo.Qux - assertFalse "resolve Foo prefix: showImports" resolved2.showImports - assertNone "resolve Foo prefix: title" resolved2.title - -- Exact match on Foo.Bar itself - let resolved3 := config.resolveForModule `Foo.Bar - let t3 ← assertSome "resolve exact: title" resolved3.title - assertEq "resolve exact: title value" t3 "Bar Title" - -/-- Module-level config overrides global defaults. -/ -private def testResolveOverridesGlobal : IO Unit := do - let toml := String.intercalate "\n" [ - "show_imports = true", - "show_docstrings = true", - "[modules.\"MyMod\"]", - "show_imports = false", - "show_docstrings = false", - "" - ] - let config ← loadFromString toml - let resolved := config.resolveForModule `MyMod - assertFalse "resolve override: showImports" resolved.showImports - assertFalse "resolve override: showDocstrings" resolved.showDocstrings - -- Unmatched module still gets global defaults - let resolved2 := config.resolveForModule `Other - assertTrue "resolve global: showImports" resolved2.showImports - assertTrue "resolve global: showDocstrings" resolved2.showDocstrings - --- ===== Test runner ===== - -private def configTests : List (String × IO Unit) := [ - ("missing file", testMissingFile), - ("empty file", testEmptyFile), - ("whitespace file", testWhitespaceFile), - ("exclude", testExclude), - ("order", testOrder), - ("landing_page", testLandingPage), - ("order_children", testOrderChildren), - ("targets", testTargets), - ("combined", testCombined), - ("invalid TOML", testInvalidToml), - ("hide_commands", testHideCommands), - ("metadata", testMetadata), - ("extra_css/js", testExtraCssJs), - ("show_docstrings", testShowDocstrings), - ("show_docstrings_for", testShowDocstringsFor), - ("hide_docstrings_for", testHideDocstringsFor), - ("show_output", testShowOutput), - ("show_output default", testShowOutputDefault), - ("show_imports", testShowImports), - ("show_imports default", testShowImportsDefault), - ("combined new", testCombinedNew), - ("theme light", testThemeLight), - ("theme dark", testThemeDark), - ("theme empty", testThemeEmpty), - ("modules config", testModulesConfig), - ("resolve no match", testResolveNoMatch), - ("resolve prefix match", testResolvePrefixMatch), - ("resolve overrides global", testResolveOverridesGlobal) -] - -def runLiterateConfigTests : IO Nat := do - IO.println "Running literate config unit tests..." - let mut failures := 0 - for (name, test) in configTests do - try - test - IO.println s!" {name}: passed" - catch e => - IO.eprintln s!" {name}: FAILED - {e}" - failures := failures + 1 - if failures == 0 then - IO.println " All literate config tests passed." - else - IO.eprintln s!" {failures} literate config test(s) failed." - return failures - -end Tests.LiterateConfig diff --git a/src/tests/Tests/SearchJs.lean b/src/tests/Tests/SearchJs.lean deleted file mode 100644 index 88008dc52..000000000 --- a/src/tests/Tests/SearchJs.lean +++ /dev/null @@ -1,117 +0,0 @@ -/- -Copyright (c) 2026 Lean FRO LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Author: David Thrane Christiansen --/ -module -public import VersoSearch -public import VersoSearch.DomainSearch - -/-! -Tests for the JavaScript wire format produced by `Verso.Search.DomainMapper.toJs` and -`Verso.Search.DomainMappers.toJs`. These are structural checks against the emitted JS source: they -assert that priority fields and global priority exports appear with the configured values, so the -browser-side combining code in `search-box.js` has the data it expects. --/ - -namespace Verso.Tests.SearchJs - -open Std -open Verso.Search - -private def hasSub (haystack : String) (needle : String) : Bool := - haystack.find? needle |>.isSome - -private def assertContains (label : String) (haystack : String) (needle : String) : IO Unit := do - unless hasSub haystack needle do - throw <| IO.userError s!"expected {label} output to contain {repr needle}, got:\n{haystack}" - -/-- Verifies that `DomainMapper.toJs` emits the display/class/data fields without a priority. -/ -def testMapperToJs : IO Unit := do - let mapper : DomainMapper := - { displayName := "Term" - className := "term" - dataToSearchables := "x => []" } - let rendered := (DomainMapper.toJs mapper).pretty (width := 70) - assertContains "DomainMapper" rendered "displayName:" - assertContains "DomainMapper" rendered "\"Term\"" - assertContains "DomainMapper" rendered "className:" - assertContains "DomainMapper" rendered "\"term\"" - assertContains "DomainMapper" rendered "dataToSearchables:" - if hasSub rendered "searchPriority" then - throw <| IO.userError - s!"DomainMapper output should not contain `searchPriority` (it lives in SearchPriorities now):\n{rendered}" - -/-- -Verifies that `DomainMappers.toJs` emits both the `domainMappers` constant and the -`searchPriorities` constant with the correct semantic / fullText values plus the per-domain -priorities map. --/ -def testMappersToJs : IO Unit := do - let mapper : DomainMapper := - { displayName := "Term" - className := "term" - dataToSearchables := "x => []" } - let mappers : DomainMappers := HashMap.ofList [("Verso.Test", mapper)] - let priorities : SearchPriorities := - { semantic := 60, fullText := 40, domains := ({} : Verso.NameMap _).insert `Verso.Test 73 } - let rendered := (mappers.toJs priorities).pretty (width := 70) - assertContains "DomainMappers" rendered "export const domainMappers" - assertContains "DomainMappers" rendered "export const searchPriorities" - assertContains "DomainMappers" rendered "semantic:" - assertContains "DomainMappers" rendered "60" - assertContains "DomainMappers" rendered "fullText:" - assertContains "DomainMappers" rendered "40" - assertContains "DomainMappers" rendered "domains:" - assertContains "DomainMappers" rendered "\"Verso.Test\"" - assertContains "DomainMappers" rendered "73" - -/-- -Verifies that `Verso.Search.priorityMapJson` produces a keyed map of only the documents whose priority -differs from neutral, using the same centered-at-50 integer convention as `Searchable.priority`. --/ -def testPriorityMap : IO Unit := do - let docs : Array IndexDoc := #[ - { id := "boosted", header := "", context := #[], content := "", priority := some 80 }, - { id := "no-priority", header := "", context := #[], content := "", priority := none }, - -- A `some 50` is semantically equivalent to `none` and must not bloat the emitted map: - { id := "explicit-neutral", header := "", context := #[], content := "", priority := some 50 }, - { id := "suppressed", header := "", context := #[], content := "", priority := some 10 }, - -- Ancestor-summed priorities can fall outside [0, 99]: - { id := "deep-subsection", header := "", context := #[], content := "", priority := some (-20) } - ] - let rendered := (priorityMapJson docs).compress - assertContains "priorityMapJson" rendered "\"boosted\":80" - assertContains "priorityMapJson" rendered "\"suppressed\":10" - assertContains "priorityMapJson" rendered "\"deep-subsection\":-20" - -- Neutral docs (none or some 50) must be omitted entirely, not serialized as null or 50. - for omitted in ["no-priority", "explicit-neutral"] do - if hasSub rendered omitted then - throw <| IO.userError - s!"priorityMapJson should omit neutral docs ({omitted}), but emitted:\n{rendered}" - -/-- Defaults for `SearchPriorities` are `semantic := 50` and `fullText := 50`. -/ -def testMappersToJsDefaults : IO Unit := do - let mappers : DomainMappers := {} - let rendered := (mappers.toJs).pretty (width := 70) - assertContains "DomainMappers defaults" rendered "export const searchPriorities" - assertContains "DomainMappers defaults" rendered "semantic:" - assertContains "DomainMappers defaults" rendered "fullText:" - assertContains "DomainMappers defaults" rendered "50" - -public def runSearchJsTests : IO Nat := do - let tests : List (Lean.Name × IO Unit) := - [ (`testMapperToJs, testMapperToJs) - , (`testMappersToJs, testMappersToJs) - , (`testMappersToJsDefaults, testMappersToJsDefaults) - , (`testPriorityMap, testPriorityMap) - ] - let mut failures := 0 - for (name, test) in tests do - try - test - IO.println s!"{name}: passed" - catch e => - IO.println s!"{name}: FAILED - {e}" - failures := failures + 1 - return failures diff --git a/src/tests/VersoTests/Interactive.lean b/src/tests/VersoTests/Interactive.lean new file mode 100644 index 000000000..8f6a3d499 --- /dev/null +++ b/src/tests/VersoTests/Interactive.lean @@ -0,0 +1,20 @@ +/- +Copyright (c) 2026 Lean FRO LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Author: David Thrane Christiansen +-/ +module + +import Errata + +open Errata + +/-- +The interactive tests exercise the LSP server through a shell harness. The harness inherits this +process's standard streams, so its own output appears directly; a non-zero exit is the failure. +-/ +@[test] +def interactive : Test := do + let child ← IO.Process.spawn { cmd := "src/tests/interactive/run_interactive.sh" } + let exitCode ← child.wait + assert (exitCode == 0) s!"interactive LSP tests failed with exit code {exitCode}" diff --git a/src/tests/VersoTests/LiterateConfig.lean b/src/tests/VersoTests/LiterateConfig.lean new file mode 100644 index 000000000..937f18fb6 --- /dev/null +++ b/src/tests/VersoTests/LiterateConfig.lean @@ -0,0 +1,292 @@ +/- +Copyright (c) 2026 Lean FRO LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Author: David Thrane Christiansen + +Unit tests for the literate-document TOML configuration parser. This is a non-`module` file because +`VersoLiterate` is not part of the module system; the Errata runner imports it through its +non-module main. +-/ +import VersoLiterate +import Errata + +open Lean +open VersoLiterate +open Errata + +/-- Parses a TOML string directly into a `LiterateConfig`. -/ +private def loadFromString (toml : String) : IO LiterateConfig := + parseLiterateConfig toml + +/-- A missing file results in the default config. -/ +@[test] +def missingFile : Test := do + let config ← loadLiterateConfig "/nonexistent/path/literate.toml" + assertEq #[] config.exclude + assertEq #[] config.order + assertEq #[] config.targets + assertNone config.landingPage + +/-- An empty file results in the default config. -/ +@[test] +def emptyFile : Test := do + let config ← loadFromString "" + assertEq #[] config.exclude + assertEq #[] config.order + assertEq #[] config.targets + assertNone config.landingPage + +/-- A whitespace-only file results in the default config. -/ +@[test] +def whitespaceFile : Test := do + let config ← loadFromString " \n \n " + assertEq #[] config.exclude + +/-- The `exclude` list is parsed into an array of names. -/ +@[test] +def exclude : Test := do + let config ← loadFromString "exclude = [\"Foo.Bar\", \"Baz\"]\n" + assertEq 2 config.exclude.size + assertEq `Foo.Bar config.exclude[0]! + assertEq `Baz config.exclude[1]! + +/-- The `order` list is parsed into an array of names, preserving order. -/ +@[test] +def order : Test := do + let config ← loadFromString "order = [\"C\", \"A\", \"B\"]\n" + assertEq 3 config.order.size + assertEq `C config.order[0]! + assertEq `A config.order[1]! + assertEq `B config.order[2]! + +/-- The `landing_page` field is parsed as a name. -/ +@[test] +def landingPage : Test := do + let config ← loadFromString "landing_page = \"MyLib.Overview\"\n" + let lp ← assertSome config.landingPage + assertEq `MyLib.Overview lp + +/-- The `[order_children]` table is parsed into per-parent child orderings. -/ +@[test] +def orderChildren : Test := do + let config ← loadFromString "[order_children]\n\"Foo\" = [\"Foo.B\", \"Foo.A\"]\n\"Bar\" = [\"Bar.Z\"]\n" + let fc ← assertSome (config.orderChildren.find? `Foo) + assertEq 2 fc.size + assertEq `Foo.B fc[0]! + assertEq `Foo.A fc[1]! + let bc ← assertSome (config.orderChildren.find? `Bar) + assertEq 1 bc.size + assertEq `Bar.Z bc[0]! + +/-- The `[[targets]]` entries are parsed into targets with optional fields. -/ +@[test] +def targets : Test := do + let config ← loadFromString "[[targets]]\nmodule = \"Foo\"\n\n[[targets]]\nlibrary = \"Bar\"\n" + assertEq 2 config.targets.size + let t0 ← assertSome config.targets[0]!.module + assertEq `Foo t0 + assertNone config.targets[0]!.library + let t1 ← assertSome config.targets[1]!.library + assertEq `Bar t1 + assertNone config.targets[1]!.module + +/-- Multiple fields in one file are all parsed. -/ +@[test] +def combined : Test := do + let toml := "exclude = [\"Private\"]\norder = [\"Public\", \"Examples\"]\nlanding_page = \"Public\"\n" + let config ← loadFromString toml + assertEq 1 config.exclude.size + assertEq `Private config.exclude[0]! + assertEq 2 config.order.size + assertEq `Public config.order[0]! + assertEq `Examples config.order[1]! + let lp ← assertSome config.landingPage + assertEq `Public lp + +/-- Invalid TOML produces an error. -/ +@[test] +def invalidToml : Test := do + let threw ← show IO Bool from do + try + let _ ← loadFromString "this is not valid toml {{{" + return false + catch _ => + return true + assert threw "invalid TOML should throw" + +/-- `hide_commands` is parsed into keyword pattern strings. -/ +@[test] +def hideCommands : Test := do + let config ← loadFromString "hide_commands = [\"set_option\", \"#check\"]\n" + assertEq 2 config.hideCommands.size + assertEq "set_option" config.hideCommands[0]! + assertEq "#check" config.hideCommands[1]! + +/-- The `[metadata]` table is parsed. -/ +@[test] +def metadata : Test := do + let config ← loadFromString "[metadata]\ntitle = \"My Site\"\ndescription = \"A test site\"\nfavicon = \"favicon.ico\"\n" + let title ← assertSome config.metadata.title + assertEq "My Site" title + let desc ← assertSome config.metadata.description + assertEq "A test site" desc + let fav ← assertSome config.metadata.favicon + assertEq "favicon.ico" fav + +/-- `extra_css` and `extra_js` are parsed into string arrays. -/ +@[test] +def extraCssJs : Test := do + let config ← loadFromString "extra_css = [\"custom.css\", \"theme.css\"]\nextra_js = [\"analytics.js\"]\n" + assertEq 2 config.extraCss.size + assertEq "custom.css" config.extraCss[0]! + assertEq "theme.css" config.extraCss[1]! + assertEq 1 config.extraJs.size + assertEq "analytics.js" config.extraJs[0]! + +/-- `show_docstrings = false` is parsed. -/ +@[test] +def showDocstrings : Test := do + let config ← loadFromString "show_docstrings = false\n" + assert (!config.showDocstrings) "show_docstrings" + +/-- `show_docstrings_for` is parsed into names. -/ +@[test] +def showDocstringsFor : Test := do + let config ← loadFromString "show_docstrings = false\nshow_docstrings_for = [\"Foo.bar\", \"Baz.qux\"]\n" + assert (!config.showDocstrings) "show_docstrings" + assertEq 2 config.showDocstringsFor.size + assertEq `Foo.bar config.showDocstringsFor[0]! + assertEq `Baz.qux config.showDocstringsFor[1]! + +/-- `hide_docstrings_for` is parsed into names. -/ +@[test] +def hideDocstringsFor : Test := do + let config ← loadFromString "hide_docstrings_for = [\"Foo.internal\"]\n" + assert config.showDocstrings "show_docstrings default" + assertEq 1 config.hideDocstringsFor.size + assertEq `Foo.internal config.hideDocstringsFor[0]! + +/-- `show_output` is parsed into keyword pattern strings. -/ +@[test] +def showOutput : Test := do + let config ← loadFromString "show_output = [\"#eval\"]\n" + assertEq 1 config.showOutput.size + assertEq "#eval" config.showOutput[0]! + +/-- `show_output` defaults to the standard four-element list. -/ +@[test] +def showOutputDefault : Test := do + let config ← loadFromString "" + assertEq 4 config.showOutput.size + +/-- `show_imports = false` is parsed. -/ +@[test] +def showImports : Test := do + let config ← loadFromString "show_imports = false\n" + assert (!config.showImports) "show_imports" + +/-- `show_imports` defaults to true. -/ +@[test] +def showImportsDefault : Test := do + let config ← loadFromString "" + assert config.showImports "show_imports default" + +/-- Multiple new fields combine in one config. -/ +@[test] +def combinedNew : Test := do + let toml := String.intercalate "\n" + ["exclude = [\"Private\"]", "hide_commands = [\"set_option\"]", "extra_css = [\"style.css\"]", + "show_docstrings = false", "show_docstrings_for = [\"Public.api\"]", "[metadata]", + "title = \"Test\"", ""] + let config ← loadFromString toml + assertEq 1 config.exclude.size + assertEq 1 config.hideCommands.size + assertEq 1 config.extraCss.size + assert (!config.showDocstrings) "combined new: show_docstrings" + assertEq 1 config.showDocstringsFor.size + let title ← assertSome config.metadata.title + assertEq "Test" title + +/-- The `[theme]` light variables are parsed into the theme map. -/ +@[test] +def themeLight : Test := do + let config ← loadFromString "[theme]\ncode_box_background_color = \"#fff\"\ntext_color = \"#111\"\n" + assertEq 2 config.theme.size + let bg ← assertSome (config.theme.get? "code_box_background_color") + assertEq "#fff" bg + let tc ← assertSome (config.theme.get? "text_color") + assertEq "#111" tc + +/-- The `[theme.dark]` variables are parsed into the dark theme map. -/ +@[test] +def themeDark : Test := do + let config ← loadFromString "[theme]\ntext_color = \"#333\"\n\n[theme.dark]\ntext_color = \"#eee\"\nbackground_color = \"#111\"\n" + assertEq 1 config.theme.size + assertEq 2 config.themeDark.size + let dt ← assertSome (config.themeDark.get? "text_color") + assertEq "#eee" dt + let db ← assertSome (config.themeDark.get? "background_color") + assertEq "#111" db + +/-- An empty theme produces empty maps. -/ +@[test] +def themeEmpty : Test := do + let config ← loadFromString "" + assertEq 0 config.theme.size + assertEq 0 config.themeDark.size + +/-- A `[modules."Foo.Bar"]` table is parsed into a module config. -/ +@[test] +def modulesConfig : Test := do + let toml := "[modules.\"Foo.Bar\"]\ntitle = \"Custom Title\"\nurl = \"custom-url\"\nhide_commands = [\"set_option\"]\nshow_imports = false\n" + let config ← loadFromString toml + let mc ← assertSome (config.modules.find? `Foo.Bar) + let t ← assertSome mc.title + assertEq "Custom Title" t + let u ← assertSome mc.url + assertEq "custom-url" u + let hc ← assertSome mc.hideCommands + assertEq 1 hc.size + let si ← assertSome mc.showImports + assert (!si) "modules Foo.Bar showImports value" + +/-- `resolveForModule` returns global defaults when no module config matches. -/ +@[test] +def resolveNoMatch : Test := do + let config ← loadFromString "hide_commands = [\"set_option\"]\n" + let resolved := config.resolveForModule `Unmatched.Module + assertEq 1 resolved.hideCommands.size + assert resolved.showImports "resolve no match: showImports" + assertNone resolved.title + +/-- `resolveForModule` picks the most-specific prefix match. -/ +@[test] +def resolvePrefixMatch : Test := do + let toml := String.intercalate "\n" + ["hide_commands = [\"set_option\"]", "[modules.\"Foo\"]", "show_imports = false", + "[modules.\"Foo.Bar\"]", "title = \"Bar Title\"", "show_imports = true", ""] + let config ← loadFromString toml + let resolved := config.resolveForModule `Foo.Bar.Baz + let t ← assertSome resolved.title + assertEq "Bar Title" t + assert resolved.showImports "resolve prefix: showImports" + let resolved2 := config.resolveForModule `Foo.Qux + assert (!resolved2.showImports) "resolve Foo prefix: showImports" + assertNone resolved2.title + let resolved3 := config.resolveForModule `Foo.Bar + let t3 ← assertSome resolved3.title + assertEq "Bar Title" t3 + +/-- A module-level config overrides global defaults. -/ +@[test] +def resolveOverridesGlobal : Test := do + let toml := String.intercalate "\n" + ["show_imports = true", "show_docstrings = true", "[modules.\"MyMod\"]", + "show_imports = false", "show_docstrings = false", ""] + let config ← loadFromString toml + let resolved := config.resolveForModule `MyMod + assert (!resolved.showImports) "resolve override: showImports" + assert (!resolved.showDocstrings) "resolve override: showDocstrings" + let resolved2 := config.resolveForModule `Other + assert resolved2.showImports "resolve global: showImports" + assert resolved2.showDocstrings "resolve global: showDocstrings" diff --git a/src/tests/Tests/LiterateHtml.lean b/src/tests/VersoTests/LiterateHtml.lean similarity index 69% rename from src/tests/Tests/LiterateHtml.lean rename to src/tests/VersoTests/LiterateHtml.lean index d02467656..3bfea31a6 100644 --- a/src/tests/Tests/LiterateHtml.lean +++ b/src/tests/VersoTests/LiterateHtml.lean @@ -5,10 +5,13 @@ Author: David Thrane Christiansen -/ import VersoLiterate import VersoLiterateCode +import Errata set_option maxRecDepth 1024 -namespace Tests.LiterateHtml +namespace VersoTests.LiterateHtml + +open Errata private def hasSubstring (s : String) (sub : String) : Bool := s.find? sub |>.isSome @@ -141,7 +144,7 @@ Runs a test in an independent temporary directory. The callback receives the shared JSON dir, a fresh HTML output dir, and paths for plan/toml files. -/ private def withTestDir (data : TestData) - (test : System.FilePath → System.FilePath → System.FilePath → System.FilePath → IO Unit) : IO Unit := + (test : System.FilePath → System.FilePath → System.FilePath → System.FilePath → Test) : Test := IO.FS.withTempDir fun tmpDir => do let htmlDir := tmpDir / "html" let planFile := tmpDir / "plan" @@ -152,7 +155,7 @@ private def withTestDir (data : TestData) -- ===== Individual tests ===== /-- All modules produce HTML files with expected structure, navigation, and content. -/ -private def testDefaultBehavior (data : TestData) : IO Unit := withTestDir data fun jsonDir htmlDir _ _ => do +private def testDefaultBehavior (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ _ => do runLiterateHtml jsonDir htmlDir let expectedFiles := #[ @@ -164,41 +167,41 @@ private def testDefaultBehavior (data : TestData) : IO Unit := withTestDir data ] for f in expectedFiles do unless ← f.pathExists do - throw <| IO.userError s!"Expected HTML file not found: {f}" + fail s!"Expected HTML file not found: {f}" let landingHtml ← IO.FS.readFile (htmlDir / "index.html") unless hasSubstring landingHtml "LitConfig" do - throw <| IO.userError "Landing page does not contain 'LitConfig'" + fail "Landing page does not contain 'LitConfig'" let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") unless hasSubstring litConfigHtml "LitConfig" do - throw <| IO.userError "LitConfig page title is not 'LitConfig'" + fail "LitConfig page title is not 'LitConfig'" unless hasSubstring litConfigHtml "A Test Module" do - throw <| IO.userError "LitConfig page does not contain module docstring content 'A Test Module'" + fail "LitConfig page does not contain module docstring content 'A Test Module'" unless hasSubstring litConfigHtml "code-box" do - throw <| IO.userError "LitConfig page does not contain any code boxes" + fail "LitConfig page does not contain any code boxes" unless hasSubstring litConfigHtml "module-tree" do - throw <| IO.userError "LitConfig page does not contain module tree navigation" + fail "LitConfig page does not contain module tree navigation" unless hasSubstring litConfigHtml "breadcrumbs" do - throw <| IO.userError "LitConfig page does not contain breadcrumbs" + fail "LitConfig page does not contain breadcrumbs" let coreHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "Core" / "index.html") unless hasSubstring coreHtml "Core Module" do - throw <| IO.userError "Core page does not contain module docstring content 'Core Module'" + fail "Core page does not contain module docstring content 'Core Module'" let noDocHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "NoDocstrings" / "index.html") unless hasSubstring noDocHtml "code-box" do - throw <| IO.userError "NoDocstrings page does not contain code boxes" + fail "NoDocstrings page does not contain code boxes" /-- The `{kw}` docstring role renders keyword atoms in the HTML output. -/ -private def testKeywordRole (data : TestData) : IO Unit := withTestDir data fun jsonDir htmlDir _ _ => do +private def testKeywordRole (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ _ => do runLiterateHtml jsonDir htmlDir let coreHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "Core" / "index.html") -- The module docstring contains {kw}`where`, which should render as a keyword-highlighted token unless hasSubstring coreHtml "where" do - throw <| IO.userError "Core page does not contain keyword 'where' from {kw} role" + fail "Core page does not contain keyword 'where' from {kw} role" unless hasSubstring coreHtml "keyword" do - throw <| IO.userError "Core page does not contain 'keyword' CSS class for {kw} role" + fail "Core page does not contain 'keyword' CSS class for {kw} role" /-- Per-module JSON path used by the tests. The literate facet writes @@ -212,41 +215,41 @@ Ensures that the HTML rendering pass accepts every built-in docstring extension have handlers), and that the tactic and conv handlers attach the syntax kind's docstring for hovers. -/ -private def testAllBuiltinDocRoles (data : TestData) : IO Unit := withTestDir data fun jsonDir htmlDir _ _ => do +private def testAllBuiltinDocRoles (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ _ => do runLiterateHtml jsonDir htmlDir let builtinsHtml := htmlDir / "LitConfig" / "Builtins" / "index.html" unless ← builtinsHtml.pathExists do - throw <| IO.userError s!"Expected Builtins HTML page at {builtinsHtml}" + fail s!"Expected Builtins HTML page at {builtinsHtml}" let jsonContent ← IO.FS.readFile (jsonPath jsonDir "LitConfig.Builtins") unless hasSubstring jsonContent "\"content\":\"rfl\",\"kind\":{\"keyword\":{\"docs\":\"" do - throw <| IO.userError "Builtins JSON has no docs on the `rfl` keyword token. \ + fail "Builtins JSON has no docs on the `rfl` keyword token. \ The tactic handler did not attach the syntax kind's docstring." unless hasSubstring jsonContent "\"content\":\"lhs\",\"kind\":{\"keyword\":{\"docs\":\"" do - throw <| IO.userError "Builtins JSON has no docs on the `lhs` keyword token. \ + fail "Builtins JSON has no docs on the `lhs` keyword token. \ The conv handler did not attach the syntax kind's docstring." /-- Checks that user-registered `@[inline_to_literate]` and `@[block_to_literate]` handlers shadow the built-ins. -/ -private def testCustomLiterateHandlers (data : TestData) : IO Unit := withTestDir data fun jsonDir htmlDir _ _ => do +private def testCustomLiterateHandlers (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ _ => do runLiterateHtml jsonDir htmlDir let jsonFile := jsonPath jsonDir "LitConfig.UserExt" unless ← jsonFile.pathExists do - throw <| IO.userError s!"Expected JSON for LitConfig.UserExt at {jsonFile}" + fail s!"Expected JSON for LitConfig.UserExt at {jsonFile}" let jsonContent ← IO.FS.readFile jsonFile unless hasSubstring jsonContent "USER-CONST-MARKER" do - throw <| IO.userError "UserExt JSON missing USER-CONST-MARKER: `@[inline_to_literate]` handler did not run" + fail "UserExt JSON missing USER-CONST-MARKER: `@[inline_to_literate]` handler did not run" unless hasSubstring jsonContent "USER-LEANBLOCK-MARKER" do - throw <| IO.userError "UserExt JSON missing USER-LEANBLOCK-MARKER: `@[block_to_literate]` handler did not run" + fail "UserExt JSON missing USER-LEANBLOCK-MARKER: `@[block_to_literate]` handler did not run" let html ← IO.FS.readFile (htmlDir / "LitConfig" / "UserExt" / "index.html") unless hasSubstring html "looks like you're defining a const" do - throw <| IO.userError "UserExt HTML missing the inline replacement text. The user handler's children weren't rendered." + fail "UserExt HTML missing the inline replacement text. The user handler's children weren't rendered." unless hasSubstring html "Replacement For A Lean Block" do - throw <| IO.userError "UserExt HTML missing the block replacement text. The user handler's children weren't rendered." + fail "UserExt HTML missing the block replacement text. The user handler's children weren't rendered." if hasSubstring html "trivial" then - throw <| IO.userError "UserExt HTML contains 'trivial'. The built-in lean code-block handler ran instead of the user handler." + fail "UserExt HTML contains 'trivial'. The built-in lean code-block handler ran instead of the user handler." /-- Checks that messages produced by code blocks in docstrings are attached to the rendered code block @@ -257,17 +260,17 @@ rather than to the command that carries the docstring. comment. The literate pipeline re-attaches it to the rendered code block, so the JSON contains exactly one message span, and that span wraps the {lit}`#eval` token. -/ -private def testDocstringCodeBlockMessages (data : TestData) : IO Unit := do +private def testDocstringCodeBlockMessages (data : TestData) : Test := do let jsonFile := jsonPath data.jsonDir "LitConfig.Builtins" unless ← jsonFile.pathExists do - throw <| IO.userError s!"Expected JSON for LitConfig.Builtins at {jsonFile}" + fail s!"Expected JSON for LitConfig.Builtins at {jsonFile}" let jsonContent ← IO.FS.readFile jsonFile unless hasSubstring jsonContent "\"span\":{\"content\":{\"token\":{\"tok\":{\"content\":\"#eval\"" do - throw <| IO.userError "Builtins JSON has no message span on the docstring's `#eval`. \ + fail "Builtins JSON has no message span on the docstring's `#eval`. \ Messages from docstring code blocks were not re-attached to the rendered code." let spanCount := (jsonContent.splitOn "\"span\":").length - 1 unless spanCount == 1 do - throw <| IO.userError s!"Expected exactly one message span in Builtins JSON, got {spanCount}. \ + fail s!"Expected exactly one message span in Builtins JSON, got {spanCount}. \ A message from a docstring code block may have been attached to the surrounding command." /-- @@ -280,44 +283,44 @@ facet exercises both the conversion fallback (which logs the warning) and the HT (which recurses into the children); this test then searches the build output for the warning and the generated HTML for the marker text. -/ -private def testUnknownExtensionFallback : IO Unit := do +private def testUnknownExtensionFallback : Test := do let result ← IO.Process.output { cmd := "lake" args := #["build", ":literateHtml"] cwd := "test-projects/literate-config" } if result.exitCode != 0 then - throw <| IO.userError s!"lake build :literateHtml failed (exit {result.exitCode}):\nstdout: {result.stdout}\nstderr: {result.stderr}" + fail s!"lake build :literateHtml failed (exit {result.exitCode}):\nstdout: {result.stdout}\nstderr: {result.stderr}" unless hasSubstring result.stdout "No inline handler for LitConfig.UserExt.FallbackPayload" do - throw <| IO.userError s!"Expected warning about unhandled extension in build output, got stdout: {result.stdout}\nstderr: {result.stderr}" + fail s!"Expected warning about unhandled extension in build output, got stdout: {result.stdout}\nstderr: {result.stderr}" let htmlFile : System.FilePath := "test-projects/literate-config" / ".lake" / "build" / "literate-html" / "LitConfig" / "UserExt" / "index.html" unless ← htmlFile.pathExists do - throw <| IO.userError s!"Expected HTML page at {htmlFile}" + fail s!"Expected HTML page at {htmlFile}" let html ← IO.FS.readFile htmlFile unless hasSubstring html "THIS IS THE FALLBACK" do - throw <| IO.userError "HTML missing 'THIS IS THE FALLBACK' marker. The conversion's fallback children were not rendered." + fail "HTML missing 'THIS IS THE FALLBACK' marker. The conversion's fallback children were not rendered." /-- Excluded modules produce no HTML output and are absent from the navbar. -/ -private def testExclude (data : TestData) : IO Unit := withTestDir data fun jsonDir htmlDir planFile tomlFile => do +private def testExclude (data : TestData) : Test := withTestDir data fun jsonDir htmlDir planFile tomlFile => do IO.FS.writeFile tomlFile "exclude = [\"LitConfig.NoDocstrings\"]\n" runLiteratePlan data.moduleListFile planFile (some tomlFile) runLiterateHtml jsonDir htmlDir (some planFile) (some tomlFile) if ← (htmlDir / "LitConfig" / "NoDocstrings" / "index.html").pathExists then - throw <| IO.userError "Excluded module LitConfig.NoDocstrings should not have HTML output" + fail "Excluded module LitConfig.NoDocstrings should not have HTML output" unless ← (htmlDir / "LitConfig" / "index.html").pathExists do - throw <| IO.userError "LitConfig should still have HTML output after exclude" + fail "LitConfig should still have HTML output after exclude" unless ← (htmlDir / "LitConfig" / "Core" / "index.html").pathExists do - throw <| IO.userError "LitConfig.Core should still have HTML output after exclude" + fail "LitConfig.Core should still have HTML output after exclude" let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") let navbarSection := litConfigHtml.splitOn "module-tree" |>.getD 1 "" |>.splitOn "" |>.head! if hasSubstring navbarSection "NoDocstrings" then - throw <| IO.userError "Navbar should not contain excluded module 'NoDocstrings'" + fail "Navbar should not contain excluded module 'NoDocstrings'" /-- The `order` config controls the ordering of modules in the navbar. -/ -private def testNavbarOrder (data : TestData) : IO Unit := withTestDir data fun jsonDir htmlDir planFile tomlFile => do +private def testNavbarOrder (data : TestData) : Test := withTestDir data fun jsonDir htmlDir planFile tomlFile => do IO.FS.writeFile tomlFile "order = [\"LitConfig.NoDocstrings\", \"LitConfig.Core\"]\n" runLiteratePlan data.moduleListFile planFile (some tomlFile) runLiterateHtml jsonDir htmlDir (some planFile) (some tomlFile) @@ -327,22 +330,22 @@ private def testNavbarOrder (data : TestData) : IO Unit := withTestDir data fun let noDocPos := navbarSection.splitOn "NoDocstrings" |>.head! |>.length let corePos := navbarSection.splitOn ">Core<" |>.head! |>.length unless noDocPos < corePos do - throw <| IO.userError s!"NoDocstrings (pos {noDocPos}) should appear before Core (pos {corePos}) in navbar" + fail s!"NoDocstrings (pos {noDocPos}) should appear before Core (pos {corePos}) in navbar" /-- A configured landing page module's content replaces the default table of contents. -/ -private def testLandingPage (data : TestData) : IO Unit := withTestDir data fun jsonDir htmlDir planFile tomlFile => do +private def testLandingPage (data : TestData) : Test := withTestDir data fun jsonDir htmlDir planFile tomlFile => do IO.FS.writeFile tomlFile "landing_page = \"LitConfig.Core\"\n" runLiteratePlan data.moduleListFile planFile (some tomlFile) runLiterateHtml jsonDir htmlDir (some planFile) (some tomlFile) let landingHtml ← IO.FS.readFile (htmlDir / "index.html") unless hasSubstring landingHtml "Core Module" do - throw <| IO.userError "Landing page should contain 'Core Module' content from the configured landing module" + fail "Landing page should contain 'Core Module' content from the configured landing module" unless ← (htmlDir / "LitConfig" / "Core" / "index.html").pathExists do - throw <| IO.userError "Core module should still exist at its normal location" + fail "Core module should still exist at its normal location" /-- HTML generation fails when landing_page names a module not in the loaded module tree. -/ -private def testHtmlLandingPageNotFound (data : TestData) : IO Unit := withTestDir data fun jsonDir htmlDir planFile tomlFile => do +private def testHtmlLandingPageNotFound (data : TestData) : Test := withTestDir data fun jsonDir htmlDir planFile tomlFile => do -- Use a landing_page that won't be in the module tree. -- Write a plan that includes only the real modules (so planning succeeds), -- but the TOML references a module that doesn't exist. @@ -350,27 +353,27 @@ private def testHtmlLandingPageNotFound (data : TestData) : IO Unit := withTestD runLiteratePlan data.moduleListFile planFile none let (exitCode, _, stderr) ← runLiterateHtmlCapture jsonDir htmlDir (some planFile) (some tomlFile) if exitCode == 0 then - throw <| IO.userError "HTML landing_page not found: should have failed with non-zero exit code" + fail "HTML landing_page not found: should have failed with non-zero exit code" unless hasSubstring stderr "not found" do - throw <| IO.userError "HTML landing_page not found: stderr should mention 'not found'" + fail "HTML landing_page not found: stderr should mention 'not found'" /-- Excluding a parent module also removes all its children from the output. -/ -private def testRecursiveExclusion (data : TestData) : IO Unit := withTestDir data fun jsonDir htmlDir planFile tomlFile => do +private def testRecursiveExclusion (data : TestData) : Test := withTestDir data fun jsonDir htmlDir planFile tomlFile => do IO.FS.writeFile tomlFile "exclude = [\"LitConfig.Core\"]\n" runLiteratePlan data.moduleListFile planFile (some tomlFile) runLiterateHtml jsonDir htmlDir (some planFile) (some tomlFile) if ← (htmlDir / "LitConfig" / "Core" / "index.html").pathExists then - throw <| IO.userError "Excluded module LitConfig.Core should not have HTML output" + fail "Excluded module LitConfig.Core should not have HTML output" if ← (htmlDir / "LitConfig" / "Core" / "Basic" / "index.html").pathExists then - throw <| IO.userError "Child of excluded module LitConfig.Core.Basic should not have HTML output" + fail "Child of excluded module LitConfig.Core.Basic should not have HTML output" unless ← (htmlDir / "LitConfig" / "index.html").pathExists do - throw <| IO.userError "LitConfig should still have HTML output after excluding Core" + fail "LitConfig should still have HTML output after excluding Core" unless ← (htmlDir / "LitConfig" / "NoDocstrings" / "index.html").pathExists do - throw <| IO.userError "LitConfig.NoDocstrings should still have HTML output after excluding Core" + fail "LitConfig.NoDocstrings should still have HTML output after excluding Core" /-- The `order_children` config controls the ordering of children under a specific parent. -/ -private def testOrderChildren (data : TestData) : IO Unit := withTestDir data fun jsonDir htmlDir planFile tomlFile => do +private def testOrderChildren (data : TestData) : Test := withTestDir data fun jsonDir htmlDir planFile tomlFile => do IO.FS.writeFile tomlFile "[order_children]\n\"LitConfig\" = [\"LitConfig.NoDocstrings\", \"LitConfig.Core\"]\n" runLiteratePlan data.moduleListFile planFile (some tomlFile) runLiterateHtml jsonDir htmlDir (some planFile) (some tomlFile) @@ -380,19 +383,19 @@ private def testOrderChildren (data : TestData) : IO Unit := withTestDir data fu let noDocPos := navbarSection.splitOn "NoDocstrings" |>.head! |>.length let corePos := navbarSection.splitOn ">Core<" |>.head! |>.length unless noDocPos < corePos do - throw <| IO.userError s!"order_children: NoDocstrings (pos {noDocPos}) should appear before Core (pos {corePos}) in navbar" + fail s!"order_children: NoDocstrings (pos {noDocPos}) should appear before Core (pos {corePos}) in navbar" /-- A non-empty `xref.json` cross-reference file is generated in the output. -/ -private def testXrefJsonGenerated (data : TestData) : IO Unit := withTestDir data fun jsonDir htmlDir _ _ => do +private def testXrefJsonGenerated (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ _ => do runLiterateHtml jsonDir htmlDir unless ← (htmlDir / "xref.json").pathExists do - throw <| IO.userError "xref.json was not generated" + fail "xref.json was not generated" let xrefContent ← IO.FS.readFile (htmlDir / "xref.json") unless xrefContent.trimAscii.toString.length > 2 do - throw <| IO.userError "xref.json is empty or trivial" + fail "xref.json is empty or trivial" /-- The plan file lists all modules by default and respects exclusions. -/ -private def testPlanFileContent (data : TestData) : IO Unit := IO.FS.withTempDir fun tmpDir => do +private def testPlanFileContent (data : TestData) : Test := IO.FS.withTempDir fun tmpDir => do let planFile := tmpDir / "plan" let tomlFile := tmpDir / "literate.toml" -- No config: plan should contain all modules @@ -401,21 +404,21 @@ private def testPlanFileContent (data : TestData) : IO Unit := IO.FS.withTempDir let planModules := planContent.splitOn "\n" |>.filter (!·.isEmpty) for mod in data.modules do unless planModules.contains mod do - throw <| IO.userError s!"Plan file should contain module '{mod}' but doesn't" + fail s!"Plan file should contain module '{mod}' but doesn't" -- With exclusion: excluded modules should be absent from plan IO.FS.writeFile tomlFile "exclude = [\"LitConfig.Core\"]\n" runLiteratePlan data.moduleListFile planFile (some tomlFile) let planContent ← IO.FS.readFile planFile let planModules := planContent.splitOn "\n" |>.filter (!·.isEmpty) if planModules.contains "LitConfig.Core" then - throw <| IO.userError "Plan file should not contain excluded module 'LitConfig.Core'" + fail "Plan file should not contain excluded module 'LitConfig.Core'" if planModules.contains "LitConfig.Core.Basic" then - throw <| IO.userError "Plan file should not contain child of excluded module 'LitConfig.Core.Basic'" + fail "Plan file should not contain child of excluded module 'LitConfig.Core.Basic'" unless planModules.contains "LitConfig" do - throw <| IO.userError "Plan file should still contain 'LitConfig' after excluding Core" + fail "Plan file should still contain 'LitConfig' after excluding Core" /-- Target filtering restricts the plan to only the specified module and its children. -/ -private def testTargetsFiltering (data : TestData) : IO Unit := IO.FS.withTempDir fun tmpDir => do +private def testTargetsFiltering (data : TestData) : Test := IO.FS.withTempDir fun tmpDir => do let planFile := tmpDir / "plan" let tomlFile := tmpDir / "literate.toml" IO.FS.writeFile tomlFile "[[targets]]\nmodule = \"LitConfig.Core\"\n" @@ -423,14 +426,14 @@ private def testTargetsFiltering (data : TestData) : IO Unit := IO.FS.withTempDi let planContent ← IO.FS.readFile planFile let planModules := planContent.splitOn "\n" |>.filter (!·.isEmpty) unless planModules.contains "LitConfig.Core" do - throw <| IO.userError "Plan with target LitConfig.Core should contain LitConfig.Core" + fail "Plan with target LitConfig.Core should contain LitConfig.Core" unless planModules.contains "LitConfig.Core.Basic" do - throw <| IO.userError "Plan with target LitConfig.Core should contain child LitConfig.Core.Basic" + fail "Plan with target LitConfig.Core should contain child LitConfig.Core.Basic" if planModules.contains "LitConfig.NoDocstrings" then - throw <| IO.userError "Plan with target LitConfig.Core should not contain LitConfig.NoDocstrings" + fail "Plan with target LitConfig.Core should not contain LitConfig.NoDocstrings" /-- Library-level target filtering includes all modules belonging to that library. -/ -private def testTargetsLibrary (data : TestData) : IO Unit := IO.FS.withTempDir fun tmpDir => do +private def testTargetsLibrary (data : TestData) : Test := IO.FS.withTempDir fun tmpDir => do let planFile := tmpDir / "plan" let tomlFile := tmpDir / "literate.toml" IO.FS.writeFile tomlFile "[[targets]]\nlibrary = \"LitConfig\"\n" @@ -439,25 +442,25 @@ private def testTargetsLibrary (data : TestData) : IO Unit := IO.FS.withTempDir let planModules := planContent.splitOn "\n" |>.filter (!·.isEmpty) -- All modules in the LitConfig library should be included unless planModules.contains "LitConfig" do - throw <| IO.userError "Library target should include LitConfig" + fail "Library target should include LitConfig" unless planModules.contains "LitConfig.Core" do - throw <| IO.userError "Library target should include LitConfig.Core" + fail "Library target should include LitConfig.Core" unless planModules.contains "LitConfig.Core.Basic" do - throw <| IO.userError "Library target should include LitConfig.Core.Basic" + fail "Library target should include LitConfig.Core.Basic" unless planModules.contains "LitConfig.NoDocstrings" do - throw <| IO.userError "Library target should include LitConfig.NoDocstrings" + fail "Library target should include LitConfig.NoDocstrings" /-- Library-level target filtering with a non-matching library produces an empty set. -/ -private def testTargetsLibraryNonexistent (data : TestData) : IO Unit := IO.FS.withTempDir fun tmpDir => do +private def testTargetsLibraryNonexistent (data : TestData) : Test := IO.FS.withTempDir fun tmpDir => do let planFile := tmpDir / "plan" let tomlFile := tmpDir / "literate.toml" IO.FS.writeFile tomlFile "[[targets]]\nlibrary = \"NonexistentLib\"\n" let (exitCode, _, _) ← runLiteratePlanCapture data.moduleListFile planFile (some tomlFile) unless exitCode != 0 do - throw <| IO.userError "Library target with nonexistent library should fail" + fail "Library target with nonexistent library should fail" /-- Combined library + module target filters to modules that match both constraints. -/ -private def testTargetsLibraryAndModule (data : TestData) : IO Unit := IO.FS.withTempDir fun tmpDir => do +private def testTargetsLibraryAndModule (data : TestData) : Test := IO.FS.withTempDir fun tmpDir => do let planFile := tmpDir / "plan" let tomlFile := tmpDir / "literate.toml" IO.FS.writeFile tomlFile "[[targets]]\nlibrary = \"LitConfig\"\nmodule = \"LitConfig.Core\"\n" @@ -465,39 +468,39 @@ private def testTargetsLibraryAndModule (data : TestData) : IO Unit := IO.FS.wit let planContent ← IO.FS.readFile planFile let planModules := planContent.splitOn "\n" |>.filter (!·.isEmpty) unless planModules.contains "LitConfig.Core" do - throw <| IO.userError "Library+module target should include LitConfig.Core" + fail "Library+module target should include LitConfig.Core" unless planModules.contains "LitConfig.Core.Basic" do - throw <| IO.userError "Library+module target should include LitConfig.Core.Basic" + fail "Library+module target should include LitConfig.Core.Basic" if planModules.contains "LitConfig.NoDocstrings" then - throw <| IO.userError "Library+module target should not include LitConfig.NoDocstrings" + fail "Library+module target should not include LitConfig.NoDocstrings" /-- Commands listed in `hide_commands` produce no output while other commands remain visible. -/ -private def testHideCommands (data : TestData) : IO Unit := withTestDir data fun jsonDir htmlDir _ tomlFile => do +private def testHideCommands (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ tomlFile => do IO.FS.writeFile tomlFile "hide_commands = [\"set_option\"]\n" runLiterateHtml jsonDir htmlDir (configFile := some tomlFile) let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") if hasSubstring litConfigHtml "set_option" then - throw <| IO.userError "hide_commands: LitConfig page should not contain 'set_option' text" + fail "hide_commands: LitConfig page should not contain 'set_option' text" unless hasSubstring litConfigHtml "hello" do - throw <| IO.userError "hide_commands: LitConfig page should still contain 'hello'" + fail "hide_commands: LitConfig page should still contain 'hello'" /-- The metadata title appears in the landing page and module page `` tags. -/ -private def testMetadataTitle (data : TestData) : IO Unit := withTestDir data fun jsonDir htmlDir _ tomlFile => do +private def testMetadataTitle (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ tomlFile => do IO.FS.writeFile tomlFile "[metadata]\ntitle = \"Test Site\"\n" runLiterateHtml jsonDir htmlDir (configFile := some tomlFile) let landingHtml ← IO.FS.readFile (htmlDir / "index.html") unless hasSubstring landingHtml "<title>Test Site" do - throw <| IO.userError "metadata title: landing page should contain 'Test Site'" + fail "metadata title: landing page <title> should contain 'Test Site'" let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") unless hasSubstring litConfigHtml "LitConfig" do - throw <| IO.userError "metadata title: module page should still contain module name 'LitConfig'" + fail "metadata title: module page should still contain module name 'LitConfig'" unless hasSubstring litConfigHtml "Test Site" do - throw <| IO.userError "metadata title: module page title should contain 'Test Site'" + fail "metadata title: module page title should contain 'Test Site'" /-- Extra CSS files are copied to the output directory and linked in the HTML head. -/ -private def testExtraCss (data : TestData) : IO Unit := IO.FS.withTempDir fun tmpDir => do +private def testExtraCss (data : TestData) : Test := IO.FS.withTempDir fun tmpDir => do let htmlDir := tmpDir / "html" let tomlFile := tmpDir / "literate.toml" IO.FS.createDirAll htmlDir @@ -507,73 +510,73 @@ private def testExtraCss (data : TestData) : IO Unit := IO.FS.withTempDir fun tm runLiterateHtml data.jsonDir htmlDir (configFile := some tomlFile) unless ← (htmlDir / "custom-test.css").pathExists do - throw <| IO.userError "extra CSS: custom-test.css was not copied to output" + fail "extra CSS: custom-test.css was not copied to output" let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") unless hasSubstring litConfigHtml "custom-test.css" do - throw <| IO.userError "extra CSS: HTML does not reference custom-test.css" + fail "extra CSS: HTML does not reference custom-test.css" /-- Declaration docstrings are hidden globally while module docstrings remain visible. -/ -private def testShowDocstringsFalse (data : TestData) : IO Unit := withTestDir data fun jsonDir htmlDir _ tomlFile => do +private def testShowDocstringsFalse (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ tomlFile => do IO.FS.writeFile tomlFile "show_docstrings = false\n" runLiterateHtml jsonDir htmlDir (configFile := some tomlFile) let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") if hasSubstring litConfigHtml "A greeting message" then - throw <| IO.userError "show_docstrings=false: declaration docstring 'A greeting message' should be hidden" + fail "show_docstrings=false: declaration docstring 'A greeting message' should be hidden" unless hasSubstring litConfigHtml "A Test Module" do - throw <| IO.userError "show_docstrings=false: module docstring 'A Test Module' should still appear" + fail "show_docstrings=false: module docstring 'A Test Module' should still appear" /-- `show_imports = false` hides the imports list. -/ -private def testShowImportsFalse (data : TestData) : IO Unit := withTestDir data fun jsonDir htmlDir _ tomlFile => do +private def testShowImportsFalse (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ tomlFile => do IO.FS.writeFile tomlFile "show_imports = false\n" runLiterateHtml jsonDir htmlDir (configFile := some tomlFile) let coreHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "Core" / "index.html") if hasSubstring coreHtml "imports-list" then - throw <| IO.userError "show_imports=false: page should not contain 'imports-list'" + fail "show_imports=false: page should not contain 'imports-list'" /-- Default config shows imports in a collapsible details element. -/ -private def testShowImportsDefault (data : TestData) : IO Unit := withTestDir data fun jsonDir htmlDir _ _ => do +private def testShowImportsDefault (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ _ => do runLiterateHtml jsonDir htmlDir let coreHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "Core" / "index.html") unless hasSubstring coreHtml "imports-list" do - throw <| IO.userError "show_imports default: Core page should contain 'imports-list'" + fail "show_imports default: Core page should contain 'imports-list'" unless hasSubstring coreHtml "<details" do - throw <| IO.userError "show_imports default: imports should be in a collapsible <details> element" + fail "show_imports default: imports should be in a collapsible <details> element" /-- Default config renders output blocks for #eval commands. -/ -private def testShowOutput (data : TestData) : IO Unit := withTestDir data fun jsonDir htmlDir _ _ => do +private def testShowOutput (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ _ => do runLiterateHtml jsonDir htmlDir let coreHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "Core" / "index.html") -- Check for an actual lean-output element (class on a <pre> tag), not just the CSS rules unless hasSubstring coreHtml "class=\"hl lean lean-output" do - throw <| IO.userError "show_output default: Core page should contain output block elements for #eval commands" + fail "show_output default: Core page should contain output block elements for #eval commands" /-- `show_output = []` suppresses all output blocks. -/ -private def testShowOutputEmpty (data : TestData) : IO Unit := withTestDir data fun jsonDir htmlDir _ tomlFile => do +private def testShowOutputEmpty (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ tomlFile => do IO.FS.writeFile tomlFile "show_output = []\n" runLiterateHtml jsonDir htmlDir (configFile := some tomlFile) let coreHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "Core" / "index.html") -- Check that no actual lean-output elements exist (CSS rules in `<style>` don't count) if hasSubstring coreHtml "class=\"hl lean lean-output" then - throw <| IO.userError "show_output=[]: Core page should not contain output block elements" + fail "show_output=[]: Core page should not contain output block elements" /-- Docstrings are hidden for specific named declarations while other content remains. -/ -private def testHideDocstringsFor (data : TestData) : IO Unit := withTestDir data fun jsonDir htmlDir _ tomlFile => do +private def testHideDocstringsFor (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ tomlFile => do IO.FS.writeFile tomlFile "hide_docstrings_for = [\"hello\"]\n" runLiterateHtml jsonDir htmlDir (configFile := some tomlFile) let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") if hasSubstring litConfigHtml "A greeting message" then - throw <| IO.userError "hide_docstrings_for: 'A greeting message' should be hidden for 'hello'" + fail "hide_docstrings_for: 'A greeting message' should be hidden for 'hello'" unless hasSubstring litConfigHtml "A Test Module" do - throw <| IO.userError "hide_docstrings_for: module docstring 'A Test Module' should still appear" + fail "hide_docstrings_for: module docstring 'A Test Module' should still appear" /-- Favicon is copied to the output directory and linked in the HTML. -/ -private def testFavicon (data : TestData) : IO Unit := IO.FS.withTempDir fun tmpDir => do +private def testFavicon (data : TestData) : Test := IO.FS.withTempDir fun tmpDir => do let htmlDir := tmpDir / "html" let tomlFile := tmpDir / "literate.toml" IO.FS.createDirAll htmlDir @@ -583,13 +586,13 @@ private def testFavicon (data : TestData) : IO Unit := IO.FS.withTempDir fun tmp runLiterateHtml data.jsonDir htmlDir (configFile := some tomlFile) unless ← (htmlDir / "test-favicon.png").pathExists do - throw <| IO.userError "favicon: test-favicon.png was not copied to output" + fail "favicon: test-favicon.png was not copied to output" let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") unless hasSubstring litConfigHtml "test-favicon.png" do - throw <| IO.userError "favicon: HTML does not reference test-favicon.png" + fail "favicon: HTML does not reference test-favicon.png" /-- Extra JS files are copied to the output directory and linked in the HTML. -/ -private def testExtraJs (data : TestData) : IO Unit := IO.FS.withTempDir fun tmpDir => do +private def testExtraJs (data : TestData) : Test := IO.FS.withTempDir fun tmpDir => do let htmlDir := tmpDir / "html" let tomlFile := tmpDir / "literate.toml" IO.FS.createDirAll htmlDir @@ -599,60 +602,60 @@ private def testExtraJs (data : TestData) : IO Unit := IO.FS.withTempDir fun tmp runLiterateHtml data.jsonDir htmlDir (configFile := some tomlFile) unless ← (htmlDir / "custom-test.js").pathExists do - throw <| IO.userError "extra JS: custom-test.js was not copied to output" + fail "extra JS: custom-test.js was not copied to output" let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") unless hasSubstring litConfigHtml "custom-test.js" do - throw <| IO.userError "extra JS: HTML does not reference custom-test.js" + fail "extra JS: HTML does not reference custom-test.js" /-- Targets + exclude: exclusion narrows the target set. -/ -private def testTargetsPlusExclude (data : TestData) : IO Unit := withTestDir data fun jsonDir htmlDir planFile tomlFile => do +private def testTargetsPlusExclude (data : TestData) : Test := withTestDir data fun jsonDir htmlDir planFile tomlFile => do IO.FS.writeFile tomlFile "exclude = [\"LitConfig.Core.Basic\"]\n\n[[targets]]\nmodule = \"LitConfig.Core\"\n" runLiteratePlan data.moduleListFile planFile (some tomlFile) runLiterateHtml jsonDir htmlDir (some planFile) (some tomlFile) unless ← (htmlDir / "LitConfig" / "Core" / "index.html").pathExists do - throw <| IO.userError "targets+exclude: LitConfig.Core should exist" + fail "targets+exclude: LitConfig.Core should exist" if ← (htmlDir / "LitConfig" / "Core" / "Basic" / "index.html").pathExists then - throw <| IO.userError "targets+exclude: LitConfig.Core.Basic should be excluded" + fail "targets+exclude: LitConfig.Core.Basic should be excluded" if ← (htmlDir / "LitConfig" / "NoDocstrings" / "index.html").pathExists then - throw <| IO.userError "targets+exclude: LitConfig.NoDocstrings should not be in targets" + fail "targets+exclude: LitConfig.NoDocstrings should not be in targets" /-- show_docstrings = false with show_docstrings_for exceptions still shows the excepted docstring. -/ -private def testShowDocstringsForExceptions (data : TestData) : IO Unit := withTestDir data fun jsonDir htmlDir _ tomlFile => do +private def testShowDocstringsForExceptions (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ tomlFile => do IO.FS.writeFile tomlFile "show_docstrings = false\nshow_docstrings_for = [\"hello\"]\n" runLiterateHtml jsonDir htmlDir (configFile := some tomlFile) let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") unless hasSubstring litConfigHtml "A greeting message" do - throw <| IO.userError "show_docstrings_for exception: 'A greeting message' should be visible for 'hello'" + fail "show_docstrings_for exception: 'A greeting message' should be visible for 'hello'" -- Other declaration docstrings should be hidden (e.g., in Core module) let coreHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "Core" / "index.html") if hasSubstring coreHtml "Doubles a natural number" then - throw <| IO.userError "show_docstrings_for exception: 'Doubles a natural number' should be hidden" + fail "show_docstrings_for exception: 'Doubles a natural number' should be hidden" /-- Metadata description appears as a meta tag in the HTML. -/ -private def testMetadataDescription (data : TestData) : IO Unit := withTestDir data fun jsonDir htmlDir _ tomlFile => do +private def testMetadataDescription (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ tomlFile => do IO.FS.writeFile tomlFile "[metadata]\ndescription = \"A test description\"\n" runLiterateHtml jsonDir htmlDir (configFile := some tomlFile) let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") unless hasSubstring litConfigHtml "A test description" do - throw <| IO.userError "metadata description: HTML should contain 'A test description'" + fail "metadata description: HTML should contain 'A test description'" unless hasSubstring litConfigHtml "meta" do - throw <| IO.userError "metadata description: HTML should contain a meta tag" + fail "metadata description: HTML should contain a meta tag" /-- The current page is highlighted in the navbar with the 'current' class. -/ -private def testCurrentPageHighlighting (data : TestData) : IO Unit := withTestDir data fun jsonDir htmlDir _ _ => do +private def testCurrentPageHighlighting (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ _ => do runLiterateHtml jsonDir htmlDir let coreHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "Core" / "index.html") let navbarSection := coreHtml.splitOn "module-tree" |>.getD 1 "" |>.splitOn "</nav>" |>.head! -- The Core entry should have a 'current' class unless hasSubstring navbarSection "current" do - throw <| IO.userError "current page highlighting: navbar should contain 'current' class" + fail "current page highlighting: navbar should contain 'current' class" /-- Plan with targets + exclude combined produces the correct reduced module set. -/ -private def testPlanTargetsPlusExclude (data : TestData) : IO Unit := IO.FS.withTempDir fun tmpDir => do +private def testPlanTargetsPlusExclude (data : TestData) : Test := IO.FS.withTempDir fun tmpDir => do let planFile := tmpDir / "plan" let tomlFile := tmpDir / "literate.toml" IO.FS.writeFile tomlFile "exclude = [\"LitConfig.Core.Basic\"]\n\n[[targets]]\nmodule = \"LitConfig.Core\"\n" @@ -660,61 +663,61 @@ private def testPlanTargetsPlusExclude (data : TestData) : IO Unit := IO.FS.with let planContent ← IO.FS.readFile planFile let planModules := planContent.splitOn "\n" |>.filter (!·.isEmpty) unless planModules.contains "LitConfig.Core" do - throw <| IO.userError "plan targets+exclude: should contain LitConfig.Core" + fail "plan targets+exclude: should contain LitConfig.Core" if planModules.contains "LitConfig.Core.Basic" then - throw <| IO.userError "plan targets+exclude: should not contain excluded LitConfig.Core.Basic" + fail "plan targets+exclude: should not contain excluded LitConfig.Core.Basic" if planModules.contains "LitConfig" then - throw <| IO.userError "plan targets+exclude: should not contain LitConfig (not in targets)" + fail "plan targets+exclude: should not contain LitConfig (not in targets)" /-- Plan fails with error when landing_page names a module not in the included set. -/ -private def testPlanLandingPageNotInSet (data : TestData) : IO Unit := IO.FS.withTempDir fun tmpDir => do +private def testPlanLandingPageNotInSet (data : TestData) : Test := IO.FS.withTempDir fun tmpDir => do let planFile := tmpDir / "plan" let tomlFile := tmpDir / "literate.toml" IO.FS.writeFile tomlFile "landing_page = \"NonExistent.Module\"\n" let (exitCode, _, stderr) ← runLiteratePlanCapture data.moduleListFile planFile (some tomlFile) if exitCode == 0 then - throw <| IO.userError "plan landing_page validation: should have failed with non-zero exit code" + fail "plan landing_page validation: should have failed with non-zero exit code" unless hasSubstring stderr "landing_page" do - throw <| IO.userError "plan landing_page validation: stderr should mention 'landing_page'" + fail "plan landing_page validation: stderr should mention 'landing_page'" /-- Plan fails with error when all modules are excluded (empty module set). -/ -private def testPlanEmptyModuleSet (data : TestData) : IO Unit := IO.FS.withTempDir fun tmpDir => do +private def testPlanEmptyModuleSet (data : TestData) : Test := IO.FS.withTempDir fun tmpDir => do let planFile := tmpDir / "plan" let tomlFile := tmpDir / "literate.toml" IO.FS.writeFile tomlFile "exclude = [\"LitConfig\"]\n" let (exitCode, _, stderr) ← runLiteratePlanCapture data.moduleListFile planFile (some tomlFile) if exitCode == 0 then - throw <| IO.userError "plan empty module set: should have failed with non-zero exit code" + fail "plan empty module set: should have failed with non-zero exit code" unless hasSubstring stderr "no modules" do - throw <| IO.userError "plan empty module set: stderr should mention 'no modules'" + fail "plan empty module set: stderr should mention 'no modules'" /-- Plan succeeds with a warning when an ordered module does not exist. -/ -private def testPlanOrderWarning (data : TestData) : IO Unit := IO.FS.withTempDir fun tmpDir => do +private def testPlanOrderWarning (data : TestData) : Test := IO.FS.withTempDir fun tmpDir => do let planFile := tmpDir / "plan" let tomlFile := tmpDir / "literate.toml" IO.FS.writeFile tomlFile "order = [\"NonExistent.Module\"]\n" let (exitCode, _, stderr) ← runLiteratePlanCapture data.moduleListFile planFile (some tomlFile) if exitCode != 0 then - throw <| IO.userError "plan order warning: should succeed (warning only, not error)" + fail "plan order warning: should succeed (warning only, not error)" unless hasSubstring stderr "Warning" do - throw <| IO.userError "plan order warning: stderr should contain a warning" + fail "plan order warning: stderr should contain a warning" unless hasSubstring stderr "NonExistent.Module" do - throw <| IO.userError "plan order warning: stderr should mention 'NonExistent.Module'" + fail "plan order warning: stderr should mention 'NonExistent.Module'" /-- HTML generation fails when hide_docstrings_for names a nonexistent declaration. -/ -private def testHtmlInvalidDocstringFor (data : TestData) : IO Unit := IO.FS.withTempDir fun tmpDir => do +private def testHtmlInvalidDocstringFor (data : TestData) : Test := IO.FS.withTempDir fun tmpDir => do let htmlDir := tmpDir / "html" let tomlFile := tmpDir / "literate.toml" IO.FS.createDirAll htmlDir IO.FS.writeFile tomlFile "hide_docstrings_for = [\"nonexistent_decl\"]\n" let (exitCode, _, stderr) ← runLiterateHtmlCapture data.jsonDir htmlDir (configFile := some tomlFile) if exitCode == 0 then - throw <| IO.userError "HTML invalid docstring_for: should have failed with non-zero exit code" + fail "HTML invalid docstring_for: should have failed with non-zero exit code" unless hasSubstring stderr "nonexistent_decl" do - throw <| IO.userError "HTML invalid docstring_for: stderr should mention 'nonexistent_decl'" + fail "HTML invalid docstring_for: stderr should mention 'nonexistent_decl'" /-- Theme CSS file is generated and linked when theme overrides are present. -/ -private def testThemeCss (data : TestData) : IO Unit := IO.FS.withTempDir fun tmpDir => do +private def testThemeCss (data : TestData) : Test := IO.FS.withTempDir fun tmpDir => do let htmlDir := tmpDir / "html" let tomlFile := tmpDir / "literate.toml" IO.FS.createDirAll htmlDir @@ -730,33 +733,33 @@ private def testThemeCss (data : TestData) : IO Unit := IO.FS.withTempDir fun tm runLiterateHtml data.jsonDir htmlDir (configFile := some tomlFile) unless ← (htmlDir / "literate-theme.css").pathExists do - throw <| IO.userError "theme: literate-theme.css was not generated" + fail "theme: literate-theme.css was not generated" let themeCss ← IO.FS.readFile (htmlDir / "literate-theme.css") unless hasSubstring themeCss "--verso-code-box-background-color" do - throw <| IO.userError "theme: literate-theme.css does not contain code box variable" + fail "theme: literate-theme.css does not contain code box variable" unless hasSubstring themeCss "#f0f0f0" do - throw <| IO.userError "theme: literate-theme.css does not contain light value" + fail "theme: literate-theme.css does not contain light value" unless hasSubstring themeCss "prefers-color-scheme: dark" do - throw <| IO.userError "theme: literate-theme.css does not contain dark media query" + fail "theme: literate-theme.css does not contain dark media query" unless hasSubstring themeCss "#ddd" do - throw <| IO.userError "theme: literate-theme.css does not contain dark value" + fail "theme: literate-theme.css does not contain dark value" unless hasSubstring themeCss "data-theme" do - throw <| IO.userError "theme: literate-theme.css does not contain data-theme selector" + fail "theme: literate-theme.css does not contain data-theme selector" let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") unless hasSubstring litConfigHtml "literate-theme.css" do - throw <| IO.userError "theme: HTML does not link literate-theme.css" + fail "theme: HTML does not link literate-theme.css" /-- No theme CSS file is generated when theme is empty. -/ -private def testThemeCssEmpty (data : TestData) : IO Unit := withTestDir data fun jsonDir htmlDir _ _ => do +private def testThemeCssEmpty (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ _ => do runLiterateHtml jsonDir htmlDir if ← (htmlDir / "literate-theme.css").pathExists then - throw <| IO.userError "theme empty: literate-theme.css should not exist with default config" + fail "theme empty: literate-theme.css should not exist with default config" let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") if hasSubstring litConfigHtml "literate-theme.css" then - throw <| IO.userError "theme empty: HTML should not link literate-theme.css when no theme is set" + fail "theme empty: HTML should not link literate-theme.css when no theme is set" /-- Per-module hide_commands overrides global config. -/ -private def testPerModuleHideCommands (data : TestData) : IO Unit := withTestDir data fun jsonDir htmlDir _ tomlFile => do +private def testPerModuleHideCommands (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ tomlFile => do IO.FS.writeFile tomlFile (String.intercalate "\n" [ "[modules.\"LitConfig\"]", "hide_commands = [\"set_option\"]", @@ -766,14 +769,14 @@ private def testPerModuleHideCommands (data : TestData) : IO Unit := withTestDir let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") if hasSubstring litConfigHtml "set_option" then - throw <| IO.userError "per-module hide_commands: LitConfig should not contain 'set_option'" + fail "per-module hide_commands: LitConfig should not contain 'set_option'" -- Core should NOT be affected (no module config) let coreHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "Core" / "index.html") unless hasSubstring coreHtml "code-box" do - throw <| IO.userError "per-module hide_commands: Core should still have code boxes" + fail "per-module hide_commands: Core should still have code boxes" /-- Per-module title appears in the page title and navbar. -/ -private def testPerModuleTitle (data : TestData) : IO Unit := withTestDir data fun jsonDir htmlDir _ tomlFile => do +private def testPerModuleTitle (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ tomlFile => do IO.FS.writeFile tomlFile (String.intercalate "\n" [ "[modules.\"LitConfig.Core\"]", "title = \"Core Library\"", @@ -783,15 +786,15 @@ private def testPerModuleTitle (data : TestData) : IO Unit := withTestDir data f let coreHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "Core" / "index.html") unless hasSubstring coreHtml "Core Library" do - throw <| IO.userError "per-module title: page should contain 'Core Library'" + fail "per-module title: page should contain 'Core Library'" -- Check navbar let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") let navbarSection := litConfigHtml.splitOn "module-tree" |>.getD 1 "" |>.splitOn "</nav>" |>.head! unless hasSubstring navbarSection "Core Library" do - throw <| IO.userError "per-module title: navbar should contain 'Core Library'" + fail "per-module title: navbar should contain 'Core Library'" /-- Per-module title appears in breadcrumbs without code formatting. -/ -private def testPerModuleTitleBreadcrumbs (data : TestData) : IO Unit := withTestDir data fun jsonDir htmlDir _ tomlFile => do +private def testPerModuleTitleBreadcrumbs (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ tomlFile => do IO.FS.writeFile tomlFile (String.intercalate "\n" [ "[modules.\"LitConfig.Core\"]", "title = \"Core Library\"", @@ -804,23 +807,23 @@ private def testPerModuleTitleBreadcrumbs (data : TestData) : IO Unit := withTes let breadcrumbSection := coreHtml.splitOn "breadcrumbs" |>.getD 1 "" |>.splitOn "</ol>" |>.head! -- Custom title should appear without <code> wrapping unless hasSubstring breadcrumbSection "Core Library" do - throw <| IO.userError "title breadcrumbs: should display custom title 'Core Library'" + fail "title breadcrumbs: should display custom title 'Core Library'" if hasSubstring breadcrumbSection "<code>Core Library</code>" then - throw <| IO.userError "title breadcrumbs: custom title should not be wrapped in <code>" + fail "title breadcrumbs: custom title should not be wrapped in <code>" -- On a child page, the ancestor breadcrumb should show "Core Library" as a link let basicHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "Core" / "Basic" / "index.html") let childBcSection := basicHtml.splitOn "breadcrumbs" |>.getD 1 "" |>.splitOn "</ol>" |>.head! unless hasSubstring childBcSection "Core Library" do - throw <| IO.userError "title breadcrumbs: child page should show ancestor custom title 'Core Library'" + fail "title breadcrumbs: child page should show ancestor custom title 'Core Library'" -- The ancestor link with custom title should not use <code> if hasSubstring childBcSection "<code>Core Library</code>" then - throw <| IO.userError "title breadcrumbs: ancestor custom title should not be wrapped in <code>" + fail "title breadcrumbs: ancestor custom title should not be wrapped in <code>" -- But the "LitConfig" ancestor should still use <code> (no custom title) unless hasSubstring childBcSection "<code>LitConfig</code>" do - throw <| IO.userError "title breadcrumbs: module name ancestor should be in <code>" + fail "title breadcrumbs: module name ancestor should be in <code>" /-- Per-module URL override places the HTML at the custom path and updates navbar links. -/ -private def testPerModuleUrl (data : TestData) : IO Unit := withTestDir data fun jsonDir htmlDir _ tomlFile => do +private def testPerModuleUrl (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ tomlFile => do IO.FS.writeFile tomlFile (String.intercalate "\n" [ "[modules.\"LitConfig.Core\"]", "url = \"core-docs\"", @@ -830,35 +833,35 @@ private def testPerModuleUrl (data : TestData) : IO Unit := withTestDir data fun -- HTML should be at the custom URL path, not the default unless ← (htmlDir / "core-docs" / "index.html").pathExists do - throw <| IO.userError "per-module url: expected HTML at core-docs/index.html" + fail "per-module url: expected HTML at core-docs/index.html" if ← (htmlDir / "LitConfig" / "Core" / "index.html").pathExists then - throw <| IO.userError "per-module url: HTML should not exist at default path LitConfig/Core/index.html" + fail "per-module url: HTML should not exist at default path LitConfig/Core/index.html" -- Navbar should link to the custom URL let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") let navbarSection := litConfigHtml.splitOn "module-tree" |>.getD 1 "" |>.splitOn "</nav>" |>.head! unless hasSubstring navbarSection "core-docs/" do - throw <| IO.userError "per-module url: navbar should link to 'core-docs/'" + fail "per-module url: navbar should link to 'core-docs/'" -- Base href should reflect custom URL depth (1 segment = "../"), not module name depth let coreDocsHtml ← IO.FS.readFile (htmlDir / "core-docs" / "index.html") unless hasSubstring coreDocsHtml "base href=\"../\"" do - throw <| IO.userError "per-module url: base href should be '../' (depth 1), not '../../../' (depth 3)" + fail "per-module url: base href should be '../' (depth 1), not '../../../' (depth 3)" -- Breadcrumbs should show module name labels (not URL segments) let breadcrumbSection := coreDocsHtml.splitOn "breadcrumbs" |>.getD 1 "" |>.splitOn "</ol>" |>.head! -- The breadcrumb should display "Core" (module name), not "core-docs" (URL segment) unless hasSubstring breadcrumbSection ">Core<" do - throw <| IO.userError "per-module url: breadcrumb should display module name 'Core'" + fail "per-module url: breadcrumb should display module name 'Core'" -- The ancestor breadcrumb should link to LitConfig/ unless hasSubstring breadcrumbSection "href=\"LitConfig/\"" do - throw <| IO.userError "per-module url: ancestor breadcrumb should link to 'LitConfig/'" + fail "per-module url: ancestor breadcrumb should link to 'LitConfig/'" -- Landing page should link to custom URL let landingHtml ← IO.FS.readFile (htmlDir / "index.html") unless hasSubstring landingHtml "core-docs/" do - throw <| IO.userError "per-module url: landing page should link to 'core-docs/'" + fail "per-module url: landing page should link to 'core-docs/'" if hasSubstring (landingHtml.splitOn "module-toc" |>.getD 1 "" |>.splitOn "</ul>" |>.head!) "LitConfig/Core/" then - throw <| IO.userError "per-module url: landing page should not link to 'LitConfig/Core/'" + fail "per-module url: landing page should not link to 'LitConfig/Core/'" /-- URL overrides on a parent module propagate to children via relative append. -/ -private def testPerModuleUrlInheritance (data : TestData) : IO Unit := withTestDir data fun jsonDir htmlDir _ tomlFile => do +private def testPerModuleUrlInheritance (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ tomlFile => do IO.FS.writeFile tomlFile (String.intercalate "\n" [ "[modules.\"LitConfig.Core\"]", "url = \"core-docs\"", @@ -868,20 +871,20 @@ private def testPerModuleUrlInheritance (data : TestData) : IO Unit := withTestD -- Child module LitConfig.Core.Basic should be at core-docs/Basic/, not LitConfig/Core/Basic/ unless ← (htmlDir / "core-docs" / "Basic" / "index.html").pathExists do - throw <| IO.userError "url inheritance: expected HTML at core-docs/Basic/index.html" + fail "url inheritance: expected HTML at core-docs/Basic/index.html" if ← (htmlDir / "LitConfig" / "Core" / "Basic" / "index.html").pathExists then - throw <| IO.userError "url inheritance: HTML should not exist at default path LitConfig/Core/Basic/" + fail "url inheritance: HTML should not exist at default path LitConfig/Core/Basic/" -- Base href for child should reflect depth 2 (core-docs/Basic) let childHtml ← IO.FS.readFile (htmlDir / "core-docs" / "Basic" / "index.html") unless hasSubstring childHtml "base href=\"../../\"" do - throw <| IO.userError "url inheritance: child base href should be '../../' (depth 2)" + fail "url inheritance: child base href should be '../../' (depth 2)" -- Navbar should link to the child at core-docs/Basic/ let navbarSection := childHtml.splitOn "module-tree" |>.getD 1 "" |>.splitOn "</nav>" |>.head! unless hasSubstring navbarSection "core-docs/Basic/" do - throw <| IO.userError "url inheritance: navbar should link to 'core-docs/Basic/'" + fail "url inheritance: navbar should link to 'core-docs/Basic/'" /-- Plan fails when two modules resolve to the same URL. -/ -private def testPlanDuplicateUrl (data : TestData) : IO Unit := IO.FS.withTempDir fun tmpDir => do +private def testPlanDuplicateUrl (data : TestData) : Test := IO.FS.withTempDir fun tmpDir => do let planFile := tmpDir / "plan" let tomlFile := tmpDir / "literate.toml" -- Set LitConfig.Core's url to "LitConfig/NoDocstrings" which collides with the default @@ -893,12 +896,12 @@ private def testPlanDuplicateUrl (data : TestData) : IO Unit := IO.FS.withTempDi ]) let (exitCode, _, stderr) ← runLiteratePlanCapture data.moduleListFile planFile (some tomlFile) if exitCode == 0 then - throw <| IO.userError "plan duplicate url: should have failed with non-zero exit code" + fail "plan duplicate url: should have failed with non-zero exit code" unless hasSubstring stderr "same URL" do - throw <| IO.userError s!"plan duplicate url: stderr should mention 'same URL', got: {stderr}" + fail s!"plan duplicate url: stderr should mention 'same URL', got: {stderr}" /-- URLs that differ only by a trailing slash are detected as duplicates. -/ -private def testPlanDuplicateUrlTrailingSlash (data : TestData) : IO Unit := IO.FS.withTempDir fun tmpDir => do +private def testPlanDuplicateUrlTrailingSlash (data : TestData) : Test := IO.FS.withTempDir fun tmpDir => do let planFile := tmpDir / "plan" let tomlFile := tmpDir / "literate.toml" IO.FS.writeFile tomlFile (String.intercalate "\n" [ @@ -908,12 +911,12 @@ private def testPlanDuplicateUrlTrailingSlash (data : TestData) : IO Unit := IO. ]) let (exitCode, _, stderr) ← runLiteratePlanCapture data.moduleListFile planFile (some tomlFile) if exitCode == 0 then - throw <| IO.userError "plan duplicate url trailing slash: should have failed with non-zero exit code" + fail "plan duplicate url trailing slash: should have failed with non-zero exit code" unless hasSubstring stderr "same URL" do - throw <| IO.userError s!"plan duplicate url trailing slash: stderr should mention 'same URL', got: {stderr}" + fail s!"plan duplicate url trailing slash: stderr should mention 'same URL', got: {stderr}" /-- URLs that differ only in case are detected as duplicates. -/ -private def testPlanDuplicateUrlCase (data : TestData) : IO Unit := IO.FS.withTempDir fun tmpDir => do +private def testPlanDuplicateUrlCase (data : TestData) : Test := IO.FS.withTempDir fun tmpDir => do let planFile := tmpDir / "plan" let tomlFile := tmpDir / "literate.toml" IO.FS.writeFile tomlFile (String.intercalate "\n" [ @@ -925,46 +928,46 @@ private def testPlanDuplicateUrlCase (data : TestData) : IO Unit := IO.FS.withTe ]) let (exitCode, _, stderr) ← runLiteratePlanCapture data.moduleListFile planFile (some tomlFile) if exitCode == 0 then - throw <| IO.userError "plan duplicate url case: should have failed with non-zero exit code" + fail "plan duplicate url case: should have failed with non-zero exit code" unless hasSubstring stderr "differ only in case" do - throw <| IO.userError s!"plan duplicate url case: stderr should mention 'differ only in case', got: {stderr}" + fail s!"plan duplicate url case: stderr should mention 'differ only in case', got: {stderr}" /-- CSS contains focus-visible indicators. -/ -private def testAccessibilityFocusVisible (data : TestData) : IO Unit := withTestDir data fun jsonDir htmlDir _ _ => do +private def testAccessibilityFocusVisible (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ _ => do runLiterateHtml jsonDir htmlDir let css ← IO.FS.readFile (htmlDir / "literate.css") unless hasSubstring css "focus-visible" do - throw <| IO.userError "accessibility: literate.css does not contain focus-visible rules" + fail "accessibility: literate.css does not contain focus-visible rules" /-- CSS contains prefers-reduced-motion rules. -/ -private def testAccessibilityReducedMotion (data : TestData) : IO Unit := withTestDir data fun jsonDir htmlDir _ _ => do +private def testAccessibilityReducedMotion (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ _ => do runLiterateHtml jsonDir htmlDir let css ← IO.FS.readFile (htmlDir / "literate.css") unless hasSubstring css "prefers-reduced-motion" do - throw <| IO.userError "accessibility: literate.css does not contain prefers-reduced-motion" + fail "accessibility: literate.css does not contain prefers-reduced-motion" /-- Hamburger menu has ARIA attributes. -/ -private def testAccessibilityAria (data : TestData) : IO Unit := withTestDir data fun jsonDir htmlDir _ _ => do +private def testAccessibilityAria (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ _ => do runLiterateHtml jsonDir htmlDir let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") unless hasSubstring litConfigHtml "aria-label=\"Menu\"" do - throw <| IO.userError "accessibility: hamburger input missing aria-label" + fail "accessibility: hamburger input missing aria-label" unless hasSubstring litConfigHtml "aria-label=\"Toggle navigation\"" do - throw <| IO.userError "accessibility: hamburger label missing aria-label" + fail "accessibility: hamburger label missing aria-label" /-- LitConfig root module (with headings) gets a page ToC. -/ -private def testPageToc (data : TestData) : IO Unit := withTestDir data fun jsonDir htmlDir _ _ => do +private def testPageToc (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ _ => do runLiterateHtml jsonDir htmlDir let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") unless hasSubstring litConfigHtml "page-toc" do - throw <| IO.userError "page ToC: LitConfig page should contain page-toc" + fail "page ToC: LitConfig page should contain page-toc" unless hasSubstring litConfigHtml "Page table of contents" do - throw <| IO.userError "page ToC: page-toc should have aria-label" + fail "page ToC: page-toc should have aria-label" unless hasSubstring litConfigHtml "On this page" do - throw <| IO.userError "page ToC: page-toc should contain 'On this page' title" + fail "page ToC: page-toc should contain 'On this page' title" /-- Page ToC entries for headings in the same modDoc block have distinct anchors. -/ -private def testPageTocDistinctAnchors (data : TestData) : IO Unit := withTestDir data fun jsonDir htmlDir _ _ => do +private def testPageTocDistinctAnchors (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ _ => do runLiterateHtml jsonDir htmlDir let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") -- Extract the page-toc nav element content @@ -973,57 +976,57 @@ private def testPageTocDistinctAnchors (data : TestData) : IO Unit := withTestDi let hrefs := tocSection.splitOn "href=\"" |>.drop 1 |>.map fun s => s.splitOn "\"" |>.head! -- There should be at least 2 headings unless hrefs.length >= 2 do - throw <| IO.userError s!"page ToC distinct anchors: expected at least 2 ToC entries, got {hrefs.length}" + fail s!"page ToC distinct anchors: expected at least 2 ToC entries, got {hrefs.length}" -- All hrefs should be distinct (not sharing the same anchor) let uniqueHrefs := hrefs.eraseDups unless uniqueHrefs.length == hrefs.length do - throw <| IO.userError s!"page ToC distinct anchors: ToC entries share anchors: {hrefs}" + fail s!"page ToC distinct anchors: ToC entries share anchors: {hrefs}" -- Each anchor should correspond to an id in the HTML for href in hrefs do let parts := href.splitOn "#" if let _ :: anchor :: _ := parts then unless hasSubstring litConfigHtml s!"id=\"{anchor}\"" do - throw <| IO.userError s!"page ToC distinct anchors: anchor '{anchor}' not found as an id in the HTML" + fail s!"page ToC distinct anchors: anchor '{anchor}' not found as an id in the HTML" /-- Nested Verso sections produce distinct ToC entries at each level. -/ -private def testPageTocNestedSections (data : TestData) : IO Unit := withTestDir data fun jsonDir htmlDir _ _ => do +private def testPageTocNestedSections (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ _ => do runLiterateHtml jsonDir htmlDir let coreHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "Core" / "index.html") -- Should have a page ToC unless hasSubstring coreHtml "page-toc" do - throw <| IO.userError "nested ToC: Core page should have a page-toc" + fail "nested ToC: Core page should have a page-toc" let tocSection := coreHtml.splitOn "<nav class=\"page-toc\"" |>.getD 1 "" |>.splitOn "</nav>" |>.head! let hrefs := tocSection.splitOn "href=\"" |>.drop 1 |>.map fun s => s.splitOn "\"" |>.head! -- Should have at least 3 headings (Core Module, Natural Number Utilities, Doubling) unless hrefs.length >= 3 do - throw <| IO.userError s!"nested ToC: expected at least 3 ToC entries, got {hrefs.length}" + fail s!"nested ToC: expected at least 3 ToC entries, got {hrefs.length}" -- All distinct let uniqueHrefs := hrefs.eraseDups unless uniqueHrefs.length == hrefs.length do - throw <| IO.userError s!"nested ToC: ToC entries share anchors: {hrefs}" + fail s!"nested ToC: ToC entries share anchors: {hrefs}" -- Each anchor exists in the HTML for href in hrefs do let parts := href.splitOn "#" if let _ :: anchor :: _ := parts then unless hasSubstring coreHtml s!"id=\"{anchor}\"" do - throw <| IO.userError s!"nested ToC: anchor '{anchor}' not found as id in HTML" + fail s!"nested ToC: anchor '{anchor}' not found as id in HTML" /-- NoDocstrings module (no headings) should not get a page ToC. -/ -private def testPageTocAbsent (data : TestData) : IO Unit := withTestDir data fun jsonDir htmlDir _ _ => do +private def testPageTocAbsent (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ _ => do runLiterateHtml jsonDir htmlDir let noDocHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "NoDocstrings" / "index.html") if hasSubstring noDocHtml "page-toc" then - throw <| IO.userError "page ToC absent: NoDocstrings page should not have a page-toc" + fail "page ToC absent: NoDocstrings page should not have a page-toc" /-- CSS contains dark mode defaults. -/ -private def testCssDarkMode (data : TestData) : IO Unit := withTestDir data fun jsonDir htmlDir _ _ => do +private def testCssDarkMode (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ _ => do runLiterateHtml jsonDir htmlDir let css ← IO.FS.readFile (htmlDir / "literate.css") unless hasSubstring css "prefers-color-scheme: dark" do - throw <| IO.userError "dark mode: literate.css does not contain dark mode media query" + fail "dark mode: literate.css does not contain dark mode media query" /-- Images referenced in module docstrings are copied to the output and their URLs are rewritten. -/ -private def testImageCopying (data : TestData) (projectDir : System.FilePath) : IO Unit := IO.FS.withTempDir fun tmpDir => do +private def testImageCopying (data : TestData) (projectDir : System.FilePath) : Test := IO.FS.withTempDir fun tmpDir => do let htmlDir := tmpDir / "html" IO.FS.createDirAll htmlDir let srcDir ← IO.FS.realPath projectDir @@ -1032,26 +1035,26 @@ private def testImageCopying (data : TestData) (projectDir : System.FilePath) : -- Verify copied image file exists in the flat -verso-images directory let imgDest := htmlDir / "-verso-images" / "LitConfig--test-diagram.png" unless ← imgDest.pathExists do - throw <| IO.userError s!"image copying: expected image at {imgDest}" + fail s!"image copying: expected image at {imgDest}" -- Verify no subdirectories exist inside -verso-images (flat layout) let imgDirContents ← (htmlDir / "-verso-images").readDir for entry in imgDirContents do if (← entry.path.isDir) then - throw <| IO.userError s!"image copying: -verso-images should be flat, but found subdirectory {entry.path}" + fail s!"image copying: -verso-images should be flat, but found subdirectory {entry.path}" -- Verify the HTML references the rewritten URL let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") unless hasSubstring litConfigHtml "-verso-images/LitConfig--test-diagram.png" do - throw <| IO.userError "image copying: HTML should reference rewritten image URL '-verso-images/LitConfig--test-diagram.png'" + fail "image copying: HTML should reference rewritten image URL '-verso-images/LitConfig--test-diagram.png'" -- Verify the raw source-relative path does NOT appear as an unprocessed img src let srcAttrRaw := "src=\"images/test-diagram.png\"" if hasSubstring litConfigHtml srcAttrRaw then - throw <| IO.userError s!"image copying: HTML should not contain unprocessed '{srcAttrRaw}'" + fail s!"image copying: HTML should not contain unprocessed '{srcAttrRaw}'" /-- Image paths with '..' are resolved correctly and copied into the flat output directory. -/ -private def testImagePathTraversal : IO Unit := IO.FS.withTempDir fun tmpDir => do +private def testImagePathTraversal : Test := IO.FS.withTempDir fun tmpDir => do -- srcDir is the library root; moduleParentPath prepends the module's parent dirs let srcDir := tmpDir / "src" let outDir := tmpDir / "out" @@ -1070,49 +1073,49 @@ private def testImagePathTraversal : IO Unit := IO.FS.withTempDir fun tmpDir => -- The image should be copied into the flat -verso-images directory let imgDir := outDir / "-verso-images" unless ← imgDir.pathExists do - throw <| IO.userError "image traversal: -verso-images directory should exist" + fail "image traversal: -verso-images directory should exist" unless ← (imgDir / "Sub-Mod--shared.png").pathExists do - throw <| IO.userError "image traversal: expected flattened image 'Sub-Mod--shared.png'" + fail "image traversal: expected flattened image 'Sub-Mod--shared.png'" -- No subdirectories should exist let entries ← imgDir.readDir for entry in entries do if ← entry.path.isDir then - throw <| IO.userError s!"image traversal: -verso-images should be flat, found subdirectory {entry.path}" + fail s!"image traversal: -verso-images should be flat, found subdirectory {entry.path}" /-- Single-root project: navbar uses nav-title header instead of collapsible details. -/ -private def testSingleRootNavFlattening (data : TestData) : IO Unit := withTestDir data fun jsonDir htmlDir _ _ => do +private def testSingleRootNavFlattening (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ _ => do runLiterateHtml jsonDir htmlDir let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") let navbarSection := litConfigHtml.splitOn "module-tree" |>.getD 1 "" |>.splitOn "</nav>" |>.head! -- Should have a nav-title div for the single root unless hasSubstring navbarSection "nav-title" do - throw <| IO.userError "single-root nav: navbar should contain 'nav-title' class" + fail "single-root nav: navbar should contain 'nav-title' class" -- The top-level children should be direct leaves/details, not nested inside a root <details> -- Check that LitConfig appears in a nav-title, not in a <summary> unless hasSubstring navbarSection "<div class=\"nav-title" do - throw <| IO.userError "single-root nav: root entry should be a nav-title div, not a collapsible details" + fail "single-root nav: root entry should be a nav-title div, not a collapsible details" /-- `docstrings_as_text = true` renders declaration docstrings as prose (mod-doc class). -/ -private def testDocstringsAsText (data : TestData) : IO Unit := withTestDir data fun jsonDir htmlDir _ tomlFile => do +private def testDocstringsAsText (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ tomlFile => do IO.FS.writeFile tomlFile "docstrings_as_text = true\n" runLiterateHtml jsonDir htmlDir (configFile := some tomlFile) let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") -- "A greeting message" docstring should appear as prose with mod-doc class unless hasSubstring litConfigHtml "A greeting message" do - throw <| IO.userError "docstrings_as_text: 'A greeting message' should still appear" + fail "docstrings_as_text: 'A greeting message' should still appear" unless hasSubstring litConfigHtml "mod-doc" do - throw <| IO.userError "docstrings_as_text: page should contain 'mod-doc' class for declaration docstrings" + fail "docstrings_as_text: page should contain 'mod-doc' class for declaration docstrings" /-- `docstrings_as_text` defaults to false: declaration docstrings render inside code boxes. -/ -private def testDocstringsAsTextDefault (data : TestData) : IO Unit := withTestDir data fun jsonDir htmlDir _ _ => do +private def testDocstringsAsTextDefault (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ _ => do runLiterateHtml jsonDir htmlDir let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") -- "A greeting message" should appear but NOT with mod-doc class on the declaration docstring div unless hasSubstring litConfigHtml "A greeting message" do - throw <| IO.userError "docstrings_as_text default: 'A greeting message' should appear" + fail "docstrings_as_text default: 'A greeting message' should appear" -- The declaration docstring should be in a verso-text or md-text div WITHOUT mod-doc -- Check that the docstring text is not in a mod-doc div let parts := litConfigHtml.splitOn "A greeting message" @@ -1123,24 +1126,24 @@ private def testDocstringsAsTextDefault (data : TestData) : IO Unit := withTestD -- If there's a </div> between the last mod-doc and "A greeting message", the docstring -- is not inside a mod-doc div unless lastDivClose > 1 do - throw <| IO.userError "docstrings_as_text default: declaration docstring should not be in a mod-doc div" + fail "docstrings_as_text default: declaration docstring should not be in a mod-doc div" /-- CSS uses custom properties (var(--verso-*)) throughout. -/ -private def testCssCustomProperties (data : TestData) : IO Unit := withTestDir data fun jsonDir htmlDir _ _ => do +private def testCssCustomProperties (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ _ => do runLiterateHtml jsonDir htmlDir let css ← IO.FS.readFile (htmlDir / "literate.css") unless hasSubstring css "--verso-text-color" do - throw <| IO.userError "CSS vars: literate.css does not define --verso-text-color" + fail "CSS vars: literate.css does not define --verso-text-color" unless hasSubstring css "--verso-background-color" do - throw <| IO.userError "CSS vars: literate.css does not define --verso-background-color" + fail "CSS vars: literate.css does not define --verso-background-color" unless hasSubstring css "--verso-link-color" do - throw <| IO.userError "CSS vars: literate.css does not define --verso-link-color" + fail "CSS vars: literate.css does not define --verso-link-color" unless hasSubstring css "var(--verso-text-color)" do - throw <| IO.userError "CSS vars: literate.css does not use var(--verso-text-color)" + fail "CSS vars: literate.css does not use var(--verso-text-color)" -- ===== Test runner ===== -private def htmlTests (data : TestData) (projectDir : System.FilePath) : List (String × IO Unit) := [ +private def htmlTests (data : TestData) (projectDir : System.FilePath) : List (String × Test) := [ ("default behavior", testDefaultBehavior data), ("exclude", testExclude data), ("navbar order", testNavbarOrder data), @@ -1205,8 +1208,9 @@ private def htmlTests (data : TestData) (projectDir : System.FilePath) : List (S ("unknown extension fallback", testUnknownExtensionFallback) ] -def testLiterateHtml : IO Unit := do - IO.println "Running literate HTML tests..." +/-- The literate HTML generator produces the expected output for the single-root test project. -/ +@[test] +def literateHtml : Test := do let projectDir := "test-projects/literate-config" let modules := #["LitConfig", "LitConfig.Core", "LitConfig.Core.Basic", "LitConfig.NoDocstrings", "LitConfig.Builtins", "LitConfig.UserExt"] @@ -1214,7 +1218,7 @@ def testLiterateHtml : IO Unit := do let rootToolchain := (← IO.FS.readFile "lean-toolchain").trimAscii let testToolchain := (← IO.FS.readFile (projectDir / "lean-toolchain")).trimAscii unless rootToolchain == testToolchain do - throw <| IO.userError s!"test-projects/literate-config/lean-toolchain ({testToolchain}) does not match root lean-toolchain ({rootToolchain})" + failHere s!"test-projects/literate-config/lean-toolchain ({testToolchain}) does not match root lean-toolchain ({rootToolchain})" -- Next, ensure test project manifest is up to date let lakeVars := @@ -1228,9 +1232,9 @@ def testLiterateHtml : IO Unit := do cwd := projectDir env := lakeVars.map (·, none) } - if updateResult.exitCode != 0 then - IO.eprintln s!"lake update stderr: {updateResult.stderr}" - throw <| IO.userError s!"lake update verso failed with exit code {updateResult.exitCode}" + unless updateResult.exitCode == 0 do + failHere s!"lake update verso failed with exit code {updateResult.exitCode}" + (detail? := some updateResult.stderr) -- Build shared test data (JSON) in a persistent temp dir IO.FS.withTempDir fun sharedTmpDir => do @@ -1252,54 +1256,43 @@ def testLiterateHtml : IO Unit := do let data : TestData := { jsonDir, modules, moduleListFile } - let mut failures := 0 for (name, test) in htmlTests data projectDir do - IO.print s!" {name}... " - try - test - IO.println "passed" - catch e => - IO.eprintln s!"FAILED - {e}" - failures := failures + 1 - - if failures == 0 then - IO.println " All literate HTML tests passed!" - else - throw <| IO.userError s!"{failures} literate HTML test(s) failed" + result name test -- ===== Multi-root project tests ===== /-- Multi-root project: navbar uses collapsible details for top-level entries, not nav-title. -/ -private def testMultiRootNavTree (data : TestData) : IO Unit := withTestDir data fun jsonDir htmlDir _ _ => do +private def testMultiRootNavTree (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ _ => do runLiterateHtml jsonDir htmlDir let libAHtml ← IO.FS.readFile (htmlDir / "LibA" / "index.html") let navbarSection := libAHtml.splitOn "module-tree" |>.getD 1 "" |>.splitOn "</nav>" |>.head! -- Should NOT have nav-title (that's for single-root only) if hasSubstring navbarSection "nav-title" then - throw <| IO.userError "multi-root nav: navbar should not contain 'nav-title' class" + fail "multi-root nav: navbar should not contain 'nav-title' class" -- Should have both LibA and LibB as collapsible details unless hasSubstring navbarSection "LibA" do - throw <| IO.userError "multi-root nav: navbar should contain 'LibA'" + fail "multi-root nav: navbar should contain 'LibA'" unless hasSubstring navbarSection "LibB" do - throw <| IO.userError "multi-root nav: navbar should contain 'LibB'" + fail "multi-root nav: navbar should contain 'LibB'" -- Should use <details> for top-level entries unless hasSubstring navbarSection "<details" do - throw <| IO.userError "multi-root nav: navbar should use <details> for top-level entries" + fail "multi-root nav: navbar should use <details> for top-level entries" -private def multiRootHtmlTests (data : TestData) : List (String × IO Unit) := [ +private def multiRootHtmlTests (data : TestData) : List (String × Test) := [ ("multi-root nav tree", testMultiRootNavTree data) ] -def testLiterateHtmlMultiRoot : IO Unit := do - IO.println "Running multi-root literate HTML tests..." +/-- The literate HTML generator produces the expected output for the multi-root test project. -/ +@[test] +def literateHtmlMultiRoot : Test := do let projectDir := "test-projects/literate-multi-root" let modules := #["LibA", "LibA.Core", "LibB", "LibB.Utils"] let rootToolchain := (← IO.FS.readFile "lean-toolchain").trimAscii let testToolchain := (← IO.FS.readFile (projectDir / "lean-toolchain")).trimAscii unless rootToolchain == testToolchain do - throw <| IO.userError s!"{projectDir}/lean-toolchain ({testToolchain}) does not match root lean-toolchain ({rootToolchain})" + failHere s!"{projectDir}/lean-toolchain ({testToolchain}) does not match root lean-toolchain ({rootToolchain})" let lakeVars := #["LAKE", "LAKE_HOME", "LAKE_PKG_URL_MAP", @@ -1312,9 +1305,9 @@ def testLiterateHtmlMultiRoot : IO Unit := do cwd := projectDir env := lakeVars.map (·, none) } - if updateResult.exitCode != 0 then - IO.eprintln s!"lake update stderr: {updateResult.stderr}" - throw <| IO.userError s!"lake update verso failed with exit code {updateResult.exitCode}" + unless updateResult.exitCode == 0 do + failHere s!"lake update verso failed with exit code {updateResult.exitCode}" + (detail? := some updateResult.stderr) IO.FS.withTempDir fun sharedTmpDir => do let jsonDir := sharedTmpDir / "json" @@ -1336,19 +1329,7 @@ def testLiterateHtmlMultiRoot : IO Unit := do let data : TestData := { jsonDir, modules, moduleListFile } - let mut failures := 0 for (name, test) in multiRootHtmlTests data do - IO.print s!" {name}... " - try - test - IO.println "passed" - catch e => - IO.eprintln s!"FAILED - {e}" - failures := failures + 1 - - if failures == 0 then - IO.println " All multi-root literate HTML tests passed!" - else - throw <| IO.userError s!"{failures} multi-root literate HTML test(s) failed" - -end Tests.LiterateHtml + result name test + +end VersoTests.LiterateHtml diff --git a/src/tests/VersoTests/SearchJs.lean b/src/tests/VersoTests/SearchJs.lean new file mode 100644 index 000000000..871aae16b --- /dev/null +++ b/src/tests/VersoTests/SearchJs.lean @@ -0,0 +1,82 @@ +/- +Copyright (c) 2026 Lean FRO LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Author: David Thrane Christiansen + +Tests for the JavaScript wire format produced by the search domain mappers. These are structural +checks against the emitted JS source, confirming that priority fields and global priority exports +appear with their configured values. +-/ +module + +public import VersoSearch +public import VersoSearch.DomainSearch +import Errata + +open Std +open Verso Search +open Errata + +/-- Whether `needle` occurs in `haystack`. -/ +private def omits (haystack needle : String) : Bool := + (haystack.splitOn needle).length == 1 + +/-- A domain mapper emits its display, class, and data fields, and no priority. -/ +@[test] +def mapperToJs : Test := do + let mapper : DomainMapper := + { displayName := "Term", className := "term", dataToSearchables := "x => []" } + let rendered := (DomainMapper.toJs mapper).pretty (width := 70) + assertContains "displayName:" rendered + assertContains "\"Term\"" rendered + assertContains "className:" rendered + assertContains "\"term\"" rendered + assertContains "dataToSearchables:" rendered + -- The priority lives in `SearchPriorities` now, not on the mapper. + assert (omits rendered "searchPriority") "mapper output should not contain `searchPriority`" + +/-- A mapper collection emits the mappers and the search priorities with the configured values. -/ +@[test] +def mappersToJs : Test := do + let mapper : DomainMapper := + { displayName := "Term", className := "term", dataToSearchables := "x => []" } + let mappers : DomainMappers := HashMap.ofList [("Verso.Test", mapper)] + let priorities : SearchPriorities := + { semantic := 60, fullText := 40, domains := ({} : Verso.NameMap _).insert `Verso.Test 73 } + let rendered := (mappers.toJs priorities).pretty (width := 70) + assertContains "export const domainMappers" rendered + assertContains "export const searchPriorities" rendered + assertContains "semantic:" rendered + assertContains "60" rendered + assertContains "fullText:" rendered + assertContains "40" rendered + assertContains "domains:" rendered + assertContains "\"Verso.Test\"" rendered + assertContains "73" rendered + +/-- An empty mapper collection emits the neutral default priorities of `50`. -/ +@[test] +def mappersToJsDefaults : Test := do + let mappers : DomainMappers := {} + let rendered := (mappers.toJs).pretty (width := 70) + assertContains "export const searchPriorities" rendered + assertContains "semantic:" rendered + assertContains "fullText:" rendered + assertContains "50" rendered + +/-- The priority map keys only the documents whose priority differs from neutral. -/ +@[test] +def priorityMap : Test := do + let docs : Array IndexDoc := #[ + { id := "boosted", header := "", context := #[], content := "", priority := some 80 }, + { id := "no-priority", header := "", context := #[], content := "", priority := none }, + { id := "explicit-neutral", header := "", context := #[], content := "", priority := some 50 }, + { id := "suppressed", header := "", context := #[], content := "", priority := some 10 }, + { id := "deep-subsection", header := "", context := #[], content := "", priority := some (-20) }] + let rendered := (priorityMapJson docs).compress + assertContains "\"boosted\":80" rendered + assertContains "\"suppressed\":10" rendered + assertContains "\"deep-subsection\":-20" rendered + -- Neutral docs (`none` or `some 50`) are omitted entirely. + for omitted in ["no-priority", "explicit-neutral"] do + assert (omits rendered omitted) s!"priorityMapJson should omit the neutral doc {omitted}" diff --git a/src/tests/VersoTests/SetupLiterate.lean b/src/tests/VersoTests/SetupLiterate.lean new file mode 100644 index 000000000..f078dd0ec --- /dev/null +++ b/src/tests/VersoTests/SetupLiterate.lean @@ -0,0 +1,63 @@ +/- +Copyright (c) 2026 Lean FRO LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Author: David Thrane Christiansen + +Tests for `verso setup-literate`, which scaffolds the GitHub Pages workflow in a downstream project. +-/ +module + +import Errata + +open Errata + +/-- The `verso-literate-pages.yml` workflow path within a project. -/ +private def workflowPath (root : System.FilePath) : System.FilePath := + root / ".github" / "workflows" / "verso-literate-pages.yml" + +/-- +`verso setup-literate` generates the Pages workflow on a fresh project, reports that it is up to +date on a second run, and backs up a hand-edited workflow before rewriting it. +-/ +@[test] +def setupLiterate : Test := do + let versoRoot ← IO.FS.realPath "." + IO.FS.withTempDir fun tmpDir => do + let setupLiterate : TestM IO.Process.Output := do + let out ← IO.Process.output { + cmd := "lake", args := #["exe", "verso", "setup-literate"], cwd := some tmpDir.toString } + pure out + let runOk (label cmd : String) (args : Array String) : TestM Unit := do + let out ← IO.Process.output { cmd, args, cwd := some tmpDir.toString } + unless out.exitCode == 0 do + failHere s!"{label} failed (exit {out.exitCode})" (detail? := some (out.stdout ++ out.stderr)) + + -- A project that depends on the Verso under test. + runOk "git init" "git" #["init", "-q"] + IO.FS.writeFile (tmpDir / "lean-toolchain") (← IO.FS.readFile "lean-toolchain") + IO.FS.writeFile (tmpDir / "lakefile.toml") + s!"name = \"test-project\"\n\n[[require]]\nname = \"verso\"\npath = \"{versoRoot}\"\n" + + -- Fresh generation writes a workflow with the expected steps. + let fresh ← setupLiterate + unless fresh.exitCode == 0 do + failHere s!"setup-literate failed (exit {fresh.exitCode})" + (detail? := some (fresh.stdout ++ fresh.stderr)) + assertFileExists (workflowPath tmpDir) + let content ← IO.FS.readFile (workflowPath tmpDir) + for needle in ["lake query :literateHtml", "deploy-pages@v", "upload-pages-artifact@v", "lean-action@v"] do + assertContains needle content + + -- A second run changes nothing. + let again ← setupLiterate + assertContains "up to date" again.stdout + + -- Editing the workflow makes the next run back up the old content. + IO.FS.writeFile (workflowPath tmpDir) "modified content\n" + let updated ← setupLiterate + unless updated.exitCode == 0 do + failHere s!"setup-literate update failed (exit {updated.exitCode})" + (detail? := some (updated.stdout ++ updated.stderr)) + let backup := (workflowPath tmpDir).toString ++ ".bak" + assertFileExists backup + assertContains "modified content" (← IO.FS.readFile backup) diff --git a/src/tests/VersoTests/TeX.lean b/src/tests/VersoTests/TeX.lean new file mode 100644 index 000000000..5c7446a5e --- /dev/null +++ b/src/tests/VersoTests/TeX.lean @@ -0,0 +1,74 @@ +/- +Copyright (c) 2026 Lean FRO LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Author: David Thrane Christiansen + +Golden tests for manual-genre TeX generation. This is a non-`module` file because `VersoManual` +and the integration document fixtures are not part of the module system; the Errata runner imports +it through its non-module main. +-/ +import VersoManual +import Tests.Integration.SampleDoc +import Tests.Integration.InheritanceDoc +import Tests.Integration.CodeContent +import Tests.Integration.ExtraFilesDoc +import Tests.Integration.FrontMatter +import Tests.Integration.DiagramDoc +import Errata + +open Verso Genre Manual +open Verso.Integration +open Errata + +/-- +Renders `doc` to TeX under `integration/<dir>/output`, checks the produced tree against the golden +`expected` tree, and, under `--check-tex`, confirms `lualatex` builds the result. The extra-file +lists place additional assets alongside the output, matching the document's expectations. +-/ +def texGolden (dir : System.FilePath) (doc : Verso.Doc.VersoDoc Manual) + (extraFiles extraFilesTeX : List (System.FilePath × String) := []) : Test := do + let base : System.FilePath := "src/tests/integration" / dir + let output := base / "output" + if ← output.pathExists then IO.FS.removeDirAll output + let config : Manual.Config := + { destination := output, emitTeX := true, emitHtmlMulti := .no, extraFiles, extraFilesTeX } + let logger ← Verso.Logger.new + emitTeX config doc.toPart |>.run extension_impls% |>.run logger + goldenDir (base / "expected") output + if ← flag "check-tex" then + -- `-shell-escape` lets the `svg` package call Inkscape to rasterize `diagram` attachments. + let out ← IO.Process.output { + cwd := output / "tex" + cmd := "lualatex" + args := #["-shell-escape", "-halt-on-error", "-interaction=nonstopmode", "main.tex"] + } + unless out.exitCode == 0 do + failHere s!"lualatex exited with code {out.exitCode}" + (detail? := some (out.stdout ++ out.stderr)) + +/-- The sample document renders to its golden TeX. -/ +@[test] +def sampleDoc : Test := texGolden "sample-doc" SampleDoc.doc + +/-- A document using inheritance renders to its golden TeX. -/ +@[test] +def inheritanceDoc : Test := texGolden "inheritance-doc" InheritanceDoc.doc + +/-- A document exercising code content renders to its golden TeX. -/ +@[test] +def codeContentDoc : Test := texGolden "code-content-doc" CodeContent.doc + +/-- A document with extra bundled files renders to its golden TeX. -/ +@[test] +def extraFilesDoc : Test := + texGolden "extra-files-doc" ExtraFilesDoc.doc + (extraFiles := [("src/tests/integration/extra-files-doc/test-data/shared", "shared")]) + (extraFilesTeX := [("src/tests/integration/extra-files-doc/test-data/TeX-only", "TeX-only")]) + +/-- A document with front matter renders to its golden TeX. -/ +@[test] +def frontMatterDoc : Test := texGolden "front-matter-doc" FrontMatter.doc + +/-- A document with diagrams renders to its golden TeX. -/ +@[test] +def diagramDoc : Test := texGolden "diagram-doc" DiagramDoc.doc diff --git a/test-projects/literate-config/lake-manifest.json b/test-projects/literate-config/lake-manifest.json index 9464cfc77..ed7654315 100644 --- a/test-projects/literate-config/lake-manifest.json +++ b/test-projects/literate-config/lake-manifest.json @@ -1,66 +1,53 @@ -{ - "version": "1.2.0", - "packagesDir": ".lake/packages", - "packages": [ - { - "type": "path", - "scope": "", - "name": "verso", - "manifestFile": "lake-manifest.json", - "inherited": false, - "dir": "../..", - "configFile": "lakefile.lean" - }, - { - "url": "https://github.com/leanprover/illuminate", - "type": "git", - "subDir": null, - "scope": "", - "rev": "c7a8de81e102ee2a42a7395f98d1ed12a861a43b", - "name": "illuminate", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.lean" - }, - { - "url": "https://github.com/leanprover-community/plausible", - "type": "git", - "subDir": null, - "scope": "", - "rev": "744117af710b1c0400cd297c9ce91f8d0ad3a347", - "name": "plausible", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/acmepjz/md4lean", - "type": "git", - "subDir": null, - "scope": "", - "rev": "6a3fb240133bcb7e1a066fdc784b3fdc304e3fc5", - "name": "MD4Lean", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.lean" - }, - { - "url": "https://github.com/leanprover/subverso", - "type": "git", - "subDir": null, - "scope": "", - "rev": "0bd508e8362f56d4a05cbf63614d4c97db954041", - "name": "subverso", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.lean" - } - ], - "name": "«literate-config-test»", - "lakeDir": ".lake", - "fixedToolchain": false -} +{"version": "1.2.0", + "packagesDir": ".lake/packages", + "packages": + [{"type": "path", + "scope": "", + "name": "verso", + "manifestFile": "lake-manifest.json", + "inherited": false, + "dir": "../..", + "configFile": "lakefile.lean"}, + {"url": "https://github.com/leanprover/illuminate", + "type": "git", + "subDir": null, + "scope": "", + "rev": "ae95e7e7d01c072421732d0b84cf63ff903f4f0e", + "name": "illuminate", + "manifestFile": "lake-manifest.json", + "inputRev": "main", + "inherited": true, + "configFile": "lakefile.lean"}, + {"url": "https://github.com/leanprover-community/plausible", + "type": "git", + "subDir": null, + "scope": "", + "rev": "f3c7bd5061bd81b4480295c524d4f245c8b7e4e2", + "name": "plausible", + "manifestFile": "lake-manifest.json", + "inputRev": "main", + "inherited": true, + "configFile": "lakefile.toml"}, + {"url": "https://github.com/acmepjz/md4lean", + "type": "git", + "subDir": null, + "scope": "", + "rev": "6a3fb240133bcb7e1a066fdc784b3fdc304e3fc5", + "name": "MD4Lean", + "manifestFile": "lake-manifest.json", + "inputRev": "main", + "inherited": true, + "configFile": "lakefile.lean"}, + {"url": "https://github.com/leanprover/subverso", + "type": "git", + "subDir": null, + "scope": "", + "rev": "0bd508e8362f56d4a05cbf63614d4c97db954041", + "name": "subverso", + "manifestFile": "lake-manifest.json", + "inputRev": "main", + "inherited": true, + "configFile": "lakefile.lean"}], + "name": "«literate-config-test»", + "lakeDir": ".lake", + "fixedToolchain": false} diff --git a/test-projects/literate-multi-root/lake-manifest.json b/test-projects/literate-multi-root/lake-manifest.json index 6f58999b9..03f1f6431 100644 --- a/test-projects/literate-multi-root/lake-manifest.json +++ b/test-projects/literate-multi-root/lake-manifest.json @@ -1,66 +1,53 @@ -{ - "version": "1.2.0", - "packagesDir": ".lake/packages", - "packages": [ - { - "type": "path", - "scope": "", - "name": "verso", - "manifestFile": "lake-manifest.json", - "inherited": false, - "dir": "../..", - "configFile": "lakefile.lean" - }, - { - "url": "https://github.com/leanprover/illuminate", - "type": "git", - "subDir": null, - "scope": "", - "rev": "08da3f6f41c075e0c18d37eb0fd417c10ed77b6e", - "name": "illuminate", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.lean" - }, - { - "url": "https://github.com/leanprover-community/plausible", - "type": "git", - "subDir": null, - "scope": "", - "rev": "d575be693add4fe9cb996968968ce42ce75c5ccd", - "name": "plausible", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/acmepjz/md4lean", - "type": "git", - "subDir": null, - "scope": "", - "rev": "6a3fb240133bcb7e1a066fdc784b3fdc304e3fc5", - "name": "MD4Lean", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.lean" - }, - { - "url": "https://github.com/leanprover/subverso", - "type": "git", - "subDir": null, - "scope": "", - "rev": "0bd508e8362f56d4a05cbf63614d4c97db954041", - "name": "subverso", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.lean" - } - ], - "name": "«literate-multi-root-test»", - "lakeDir": ".lake", - "fixedToolchain": false -} +{"version": "1.2.0", + "packagesDir": ".lake/packages", + "packages": + [{"type": "path", + "scope": "", + "name": "verso", + "manifestFile": "lake-manifest.json", + "inherited": false, + "dir": "../..", + "configFile": "lakefile.lean"}, + {"url": "https://github.com/leanprover/illuminate", + "type": "git", + "subDir": null, + "scope": "", + "rev": "ae95e7e7d01c072421732d0b84cf63ff903f4f0e", + "name": "illuminate", + "manifestFile": "lake-manifest.json", + "inputRev": "main", + "inherited": true, + "configFile": "lakefile.lean"}, + {"url": "https://github.com/leanprover-community/plausible", + "type": "git", + "subDir": null, + "scope": "", + "rev": "f3c7bd5061bd81b4480295c524d4f245c8b7e4e2", + "name": "plausible", + "manifestFile": "lake-manifest.json", + "inputRev": "main", + "inherited": true, + "configFile": "lakefile.toml"}, + {"url": "https://github.com/acmepjz/md4lean", + "type": "git", + "subDir": null, + "scope": "", + "rev": "6a3fb240133bcb7e1a066fdc784b3fdc304e3fc5", + "name": "MD4Lean", + "manifestFile": "lake-manifest.json", + "inputRev": "main", + "inherited": true, + "configFile": "lakefile.lean"}, + {"url": "https://github.com/leanprover/subverso", + "type": "git", + "subDir": null, + "scope": "", + "rev": "0bd508e8362f56d4a05cbf63614d4c97db954041", + "name": "subverso", + "manifestFile": "lake-manifest.json", + "inputRev": "main", + "inherited": true, + "configFile": "lakefile.lean"}], + "name": "«literate-multi-root-test»", + "lakeDir": ".lake", + "fixedToolchain": false} From a8cb3f02c67c9d02d1d0424d3ad22de63bb12308 Mon Sep 17 00:00:00 2001 From: David Thrane Christiansen <david@davidchristiansen.dk> Date: Thu, 25 Jun 2026 00:05:53 +0200 Subject: [PATCH 07/26] Really the rest --- lakefile.lean | 8 +- lean-upstream-fixes.md | 140 ++++++++++++++++ src/errata/Errata/CompileTime.lean | 24 +-- src/errata/Errata/CompileTime/Helpers.lean | 16 +- src/tests/Tests.lean | 41 ----- src/tests/Tests/Golden.lean | 156 ------------------ src/tests/Tests/Integration.lean | 106 ------------ src/tests/Tests/PorterStemmer.lean | 124 -------------- src/tests/Tests/TeX.lean | 93 ----------- src/tests/Tests/VersoBlog.lean | 107 ------------ src/tests/Tests/VersoManual.lean | 10 -- src/tests/Tests/Zip.lean | 29 ---- .../{Tests => VersoTests}/Arbitrary.lean | 0 src/tests/{Tests => VersoTests}/Basic.lean | 19 ++- src/tests/VersoTests/Blog.lean | 2 +- .../CommentSkipping.lean | 13 +- .../CommentSkipping/Doc.lean | 0 .../CommentSkipping/Doc2.lean | 0 .../DocElabExtensions/Define.lean | 2 +- .../DocElabExtensions/LocalExtension.lean | 0 .../DocElabExtensions/Middle.lean | 2 +- .../DocElabExtensions/Use.lean | 2 +- src/tests/{Tests => VersoTests}/DocTerm.lean | 0 src/tests/{Tests => VersoTests}/Elab.lean | 5 +- .../ExtensionResolution.lean | 63 +++---- .../{Tests => VersoTests}/GenericCode.lean | 7 +- .../HighlightedToTeX.lean | 3 +- src/tests/{Tests => VersoTests}/Html.lean | 13 +- .../{Tests => VersoTests}/HtmlEntities.lean | 15 +- .../InlineStringPositions.lean | 7 +- .../Integration/CodeContent.lean | 0 .../Integration/DiagramDoc.lean | 0 .../Integration/ExtraFilesDoc.lean | 0 .../Integration/FrontMatter.lean | 0 .../Integration/InheritanceDoc.lean | 0 .../Integration/LeanSection.lean | 0 .../Integration/SampleDoc.lean | 0 src/tests/{Tests => VersoTests}/LeanCode.lean | 9 +- src/tests/{Tests => VersoTests}/Linters.lean | 29 ++-- src/tests/VersoTests/LzCompress.lean | 39 +++++ src/tests/{Tests => VersoTests}/Method.lean | 5 +- .../NestedTacticHtml.lean | 3 +- .../ParserRegression.lean | 0 src/tests/{Tests => VersoTests}/Paths.lean | 43 ++--- src/tests/{Tests => VersoTests}/Refs.lean | 33 ++-- src/tests/VersoTests/Serialization.lean | 4 +- .../SerializationGenerators.lean} | 2 +- src/tests/VersoTests/TeX.lean | 148 ++++++++++------- src/tests/VersoTests/TeXGolden.lean | 74 +++++++++ src/tests/{Tests => VersoTests}/TexUnit.lean | 7 +- src/tests/{Tests => VersoTests}/TexUtil.lean | 0 src/tests/VersoTests/VersoManual.lean | 10 ++ .../VersoManual/Html.lean | 3 +- .../VersoManual/Html/SoftHyphenate.lean | 11 +- .../VersoManual/License.lean | 3 +- .../VersoManual/Markdown.lean | 5 +- .../VersoManual/WordCount.lean | 19 ++- src/tests/{Tests => VersoTests}/Z85.lean | 3 +- 58 files changed, 551 insertions(+), 906 deletions(-) create mode 100644 lean-upstream-fixes.md delete mode 100644 src/tests/Tests.lean delete mode 100644 src/tests/Tests/Golden.lean delete mode 100644 src/tests/Tests/Integration.lean delete mode 100644 src/tests/Tests/PorterStemmer.lean delete mode 100644 src/tests/Tests/TeX.lean delete mode 100644 src/tests/Tests/VersoBlog.lean delete mode 100644 src/tests/Tests/VersoManual.lean delete mode 100644 src/tests/Tests/Zip.lean rename src/tests/{Tests => VersoTests}/Arbitrary.lean (100%) rename src/tests/{Tests => VersoTests}/Basic.lean (97%) rename src/tests/{Tests => VersoTests}/CommentSkipping.lean (87%) rename src/tests/{Tests => VersoTests}/CommentSkipping/Doc.lean (100%) rename src/tests/{Tests => VersoTests}/CommentSkipping/Doc2.lean (100%) rename src/tests/{Tests => VersoTests}/DocElabExtensions/Define.lean (95%) rename src/tests/{Tests => VersoTests}/DocElabExtensions/LocalExtension.lean (100%) rename src/tests/{Tests => VersoTests}/DocElabExtensions/Middle.lean (92%) rename src/tests/{Tests => VersoTests}/DocElabExtensions/Use.lean (97%) rename src/tests/{Tests => VersoTests}/DocTerm.lean (100%) rename src/tests/{Tests => VersoTests}/Elab.lean (97%) rename src/tests/{Tests => VersoTests}/ExtensionResolution.lean (95%) rename src/tests/{Tests => VersoTests}/GenericCode.lean (97%) rename src/tests/{Tests => VersoTests}/HighlightedToTeX.lean (92%) rename src/tests/{Tests => VersoTests}/Html.lean (96%) rename src/tests/{Tests => VersoTests}/HtmlEntities.lean (84%) rename src/tests/{Tests => VersoTests}/InlineStringPositions.lean (98%) rename src/tests/{Tests => VersoTests}/Integration/CodeContent.lean (100%) rename src/tests/{Tests => VersoTests}/Integration/DiagramDoc.lean (100%) rename src/tests/{Tests => VersoTests}/Integration/ExtraFilesDoc.lean (100%) rename src/tests/{Tests => VersoTests}/Integration/FrontMatter.lean (100%) rename src/tests/{Tests => VersoTests}/Integration/InheritanceDoc.lean (100%) rename src/tests/{Tests => VersoTests}/Integration/LeanSection.lean (100%) rename src/tests/{Tests => VersoTests}/Integration/SampleDoc.lean (100%) rename src/tests/{Tests => VersoTests}/LeanCode.lean (97%) rename src/tests/{Tests => VersoTests}/Linters.lean (96%) create mode 100644 src/tests/VersoTests/LzCompress.lean rename src/tests/{Tests => VersoTests}/Method.lean (94%) rename src/tests/{Tests => VersoTests}/NestedTacticHtml.lean (99%) rename src/tests/{Tests => VersoTests}/ParserRegression.lean (100%) rename src/tests/{Tests => VersoTests}/Paths.lean (85%) rename src/tests/{Tests => VersoTests}/Refs.lean (93%) rename src/tests/{Tests/Serialization.lean => VersoTests/SerializationGenerators.lean} (99%) create mode 100644 src/tests/VersoTests/TeXGolden.lean rename src/tests/{Tests => VersoTests}/TexUnit.lean (91%) rename src/tests/{Tests => VersoTests}/TexUtil.lean (100%) create mode 100644 src/tests/VersoTests/VersoManual.lean rename src/tests/{Tests => VersoTests}/VersoManual/Html.lean (99%) rename src/tests/{Tests => VersoTests}/VersoManual/Html/SoftHyphenate.lean (93%) rename src/tests/{Tests => VersoTests}/VersoManual/License.lean (94%) rename src/tests/{Tests => VersoTests}/VersoManual/Markdown.lean (98%) rename src/tests/{Tests => VersoTests}/VersoManual/WordCount.lean (85%) rename src/tests/{Tests => VersoTests}/Z85.lean (98%) diff --git a/lakefile.lean b/lakefile.lean index ed59b43fb..a86c0a008 100644 --- a/lakefile.lean +++ b/lakefile.lean @@ -139,7 +139,9 @@ lean_lib ErrataTests where srcDir := "src/errata-tests" roots := #[`ErrataTests] --- Errata ports of the Verso test suite. Submodules are globbed so each feature is discoverable. +-- All test code: Errata test modules, compile-time tests, fixtures, and generators. Submodules are +-- globbed so each is built and every `@[test]` module is discoverable. +@[default_target] lean_lib VersoTests where srcDir := "src/tests" roots := #[`VersoTests] @@ -310,10 +312,6 @@ script «errata-test» (args) do let child ← IO.Process.spawn { cmd := exePath.toString, args := runnerArgs.toArray } child.wait -@[default_target] -lean_lib Tests where - srcDir := "src/tests" - lean_lib UsersGuide where srcDir := "doc" leanOptions := #[⟨`weak.linter.verso.manual.headerTags, true⟩] diff --git a/lean-upstream-fixes.md b/lean-upstream-fixes.md new file mode 100644 index 000000000..c9d60e296 --- /dev/null +++ b/lean-upstream-fixes.md @@ -0,0 +1,140 @@ +# Docstring elaborator fixes needed in Lean + +Issues found while reviewing Verso PR #859 (literate-mode handlers for Verso docstring +extensions). Each needs a change in the `lean4` repository. File and line references are +for `v4.30.0-rc2`. + +## 1. `{option}` role renders `set_option [anonymous]` + +**File:** `src/Lean/Elab/DocString/Builtin.lean`, `option` role, around line 1160. + +When the role is given full `set_option` syntax, as in +`` {option}`set_option maxHeartbeats 1000` ``, the stored display code reads +`set_option [anonymous]` instead of `set_option maxHeartbeats 1000`. + +The role parses the code with the `set_option` command parser: + +``` +"set_option " >> identWithPartialTrailingDot >> ppSpace >> optionValue +``` + +The helper `optionNameAndVal` (line 452) reads the option name from `stx[1]` and the +value from `stx[3]`, and these indices work: the role resolves the option correctly. +But the display code a few lines below uses different, wrong indices: + +```lean +let code := #[ + ("set_option", some .keyword), (" ", none), + (toString stx[1][0].getId, some <| .option optionName decl.declName), (" ", none), + (toString stx[2].getAtomVal, some <| .literal stx[2].getKind none) +] +``` + +`stx[1]` is the ident itself, so `stx[1][0]` is `Syntax.missing` and `getId` returns +`[anonymous]`. `stx[2]` is not the value, so `getAtomVal` returns the empty string. + +**Fix:** build the name from `optionName` (or `stx[1]`) and the value from `stx[3]`. +Note that `stx[3]` can be a string or numeric literal node, where the atom is nested, +or a bare `true`/`false` atom, so `stx[3].getAtomVal` alone is not enough for the +literal cases. Reusing the `val : DataValue` returned by `optionNameAndVal` for the +display string is probably simplest. Test with a numeric, a string, and a Boolean +option value. + +**Why it cannot be fixed downstream:** the broken strings are baked into the +`Data.SetOption` payload when the docstring is elaborated. Consumers such as Verso +receive only the corrupted `DocCode`. + +## 2. `{assert}` and `{assert'}` produce no hover or highlighting information + +**File:** `src/Lean/Elab/DocString/Builtin.lean`, `assert'` at line 1215, `assert` at +line 1233. + +Both roles elaborate their terms but return a bare `.code s.getString`. Compare with +`leanRole` (line 1080), which wraps elaboration in `withSaveInfoContext`, collects the +info trees, and returns a `Data.LeanTerm` payload built with `highlightSyntax`. As a +result, `` {assert}`Nat.zero = Nat.zero` `` renders as plain code with no hovers for +`Nat.zero`, observed in the Verso PR #859 review. + +**Fix:** capture info the same way `leanRole` does and return a `Data.LeanTerm` +payload (or a dedicated `Data.Assert`) when info trees are available. For `assert`, +the parsed term can be passed to `highlightSyntax` directly. For `assert'`, the parsed +null node with `lhs`, `=`, `rhs` works as well. + +## 3. `{assert'}` is not usable once `=` notation exists + +`assert'` exists for the prelude, before the equality type's notation is introduced, +and parses `a = b` itself. After the notation is defined, the role's hand-rolled +parse of `=` cannot be used in practice, so the role cannot be demonstrated or tested +outside the bootstrap. Verso's test fixture now documents it as untested +(`test-projects/literate-config/LitConfig/Builtins.lean`). + +**Fix (agreed direction from the PR #859 discussion):** replace it with a role that +takes the two (or three, with the type) sides as separate code parameters, for +example `` {assert'}[`Nat.zero` `Nat.zero`] ``, so no equality notation is needed. + +## 4. `Data.Atom` is not `public` + +**File:** `src/Lean/Elab/DocString/Builtin/Keywords.lean`, line 26. + +The file uses the module system and `structure Data.Atom` lacks `public`, so its name +is mangled with a private prefix. The `kw` and `kw?` roles put it in `Inline.other` +payloads, so external consumers must dispatch on the mangled name. Verso works around +this by matching the name's suffix (`handleKwAtom` in +`src/verso-literate/VersoLiterate/Basic.lean`, which carries a comment about this). + +**Fix:** mark the structure `public`. The workaround in Verso can then be removed. + +## 5. `{conv}` stores a `Data.Tactic` value in its `Data.ConvTactic` payload + +**File:** `src/Lean/Elab/DocString/Builtin.lean`, `conv` role, around line 1388. + +The role builds its payload as: + +```lean +return .other { + name := ``Data.ConvTactic, val := .mk { name := t : Data.Tactic} + } #[.code s.getString] +``` + +The extension name says `Data.ConvTactic`, but the `Dynamic` value is a `Data.Tactic`, so +`val.get? Data.ConvTactic` fails for consumers that dispatch on the advertised type. The +two structures have the same shape, which hides the mistake. Verso works around it by +accepting both payload types in `handleConvTactic` +(`src/verso-literate/VersoLiterate/Basic.lean`); the workaround can be removed once this +is fixed. + +**Fix:** construct a `Data.ConvTactic` value (`val := .mk { name := t : Data.ConvTactic }`). + +## 6. `{conv}` does not resolve tactics by token, unlike `{tactic}` + +**File:** `src/Lean/Elab/DocString/Builtin.lean`, `conv` role and `getConvTactic`, +around line 1351. + +`{tactic}` resolves its argument against `Tactic.Doc.allTacticDocs`, matching both +internal kind names and user-facing names, so `` {tactic}`rfl` `` works. `getConvTactic` +only matches when the argument is a name suffix of a conv tactic's syntax kind, so +`` {conv}`rfl` `` does not resolve (the kind is `convRfl`). The role then silently falls +back to parsing the string as conv syntax and returns plain `.code`, with no payload and +no metadata for downstream tools. `` {conv}`lhs` `` works only because the kind happens +to be named `Lean.Parser.Tactic.Conv.lhs`. + +**Fix:** resolve conv tactics by first token as well, the way `tactic` does, or at least +document the suffix requirement in the role's docstring. + +## 7. Enhancement: diagnostics in `DocCode` + +`DocCode` segments carry only token highlighting (`DocHighlight`). Messages produced +by commands in a docstring's `lean` code block are instead re-logged as silent info +messages positioned inside the doc comment +(`src/Lean/Elab/DocString/Builtin.lean`, `lean` code block, around line 945). A +consumer that renders the docstring has no direct way to know which part of the code +block a message belongs to. + +Verso now reverse-engineers the placement: the concatenated `DocCode` text reproduces +a region of the source file verbatim, so each doc-comment message is matched to the +occurrence of that text containing the message's range +(`relocateDocMessages` in `src/verso-literate/VersoLiterateMain.lean`). This works, +but a first-class representation of message spans in `DocCode` (or in +`Data.LeanBlock`) would let all consumers place diagnostics without this +reconstruction, and would also cover messages whose positions fall outside any code +block. diff --git a/src/errata/Errata/CompileTime.lean b/src/errata/Errata/CompileTime.lean index 9208a5168..b975b5839 100644 --- a/src/errata/Errata/CompileTime.lean +++ b/src/errata/Errata/CompileTime.lean @@ -36,24 +36,28 @@ syntax (name := testMsgsCmd) (plainDocComment)? "#test_msgs" "in" command : comm meta def elabTestMsgs : Command.CommandElab | `($[$dc?:docComment]? #test_msgs%$tk in $cmd) => do let expected := ((← dc?.mapM (getDocStringText ·)).getD "").trimAscii.copy - -- Elaborate the command, capturing its messages instead of letting them surface. + -- Elaborate the command, capturing its messages instead of letting them surface. Both the + -- synchronous log and the asynchronous snapshot tasks are collected, so messages from linters + -- (which run after elaboration) are included, as `#guard_msgs` does. let saved := (← get).messages modify ({ · with messages := {} }) - try - elabCommand cmd - catch e => - logError (← e.toMessageData.toString) - let produced := (← get).messages - modify ({ · with messages := saved }) + withReader ({ · with snap? := none }) do + elabCommandTopLevel cmd #[] + let produced := (← get).messages ++ + (← get).snapshotTasks.foldl (· ++ ·.get.getAll.foldl (· ++ ·.diagnostics.msgLog) .empty) .empty + modify ({ · with messages := saved, snapshotTasks := #[] }) let visible := produced.toList.filter (!·.isSilent) let strings ← (visible.mapM formatMessage : IO (List String)) - let actual := ("\n".intercalate strings).trimAscii.copy + -- Multiple messages are separated by `---`, matching the block `#guard_msgs` compares against. + let actual := ("---\n".intercalate strings).trimAscii.copy let passed := messagesMatch expected actual - -- Reify the verdict into a discovered test, named after the source position. + -- Reify the verdict into a discovered test, named after the source position. The module name + -- qualifies it so that two modules with a `#test_msgs` at the same position do not collide. let fileMap ← getFileMap let startPos := fileMap.toPosition (tk.getPos?.getD 0) let endPos := fileMap.toPosition (tk.getTailPos?.getD 0) - let declName := Name.mkSimple s!"errataMsgTest_L{startPos.line}_C{startPos.column}" + let declName := `_root_ ++ (← getMainModule) ++ + Name.mkSimple s!"errataMsgTest_L{startPos.line}_C{startPos.column}" let verdict ← if passed then `(Errata.TestResult.pass) diff --git a/src/errata/Errata/CompileTime/Helpers.lean b/src/errata/Errata/CompileTime/Helpers.lean index 756f46948..50f58f870 100644 --- a/src/errata/Errata/CompileTime/Helpers.lean +++ b/src/errata/Errata/CompileTime/Helpers.lean @@ -23,13 +23,17 @@ def formatMessage (msg : Lean.Message) : IO String := do let mut str ← msg.data.toString unless msg.caption == "" do str := msg.caption ++ ":\n" ++ str - let pfx := - if msg.isTrace then "trace:" + -- The severity is followed by a space only when the body stays on the same line, matching the + -- rendering that `#guard_msgs` compares against. + unless str.startsWith "\n" do str := " " ++ str + str := + if msg.isTrace then "trace:" ++ str else match msg.severity with - | .information => "info: " - | .warning => "warning: " - | .error => "error: " - return pfx ++ str + | .information => "info:" ++ str + | .warning => "warning:" ++ str + | .error => "error:" ++ str + unless str.endsWith "\n" do str := str ++ "\n" + return str open Lean.Elab.Tactic.GuardMsgs (WhitespaceMode) in /-- Whether the expected and actual message blocks match, normalizing whitespace as `#guard_msgs` does. -/ diff --git a/src/tests/Tests.lean b/src/tests/Tests.lean deleted file mode 100644 index 1f87a5ac6..000000000 --- a/src/tests/Tests.lean +++ /dev/null @@ -1,41 +0,0 @@ -/- -Copyright (c) 2025-2026 Lean FRO LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Author: David Thrane Christiansen --/ -import Tests.Basic -import Tests.Elab -import Tests.GenericCode -import Tests.Golden -import Tests.CommentSkipping -import Tests.DocElabExtensions.Use -import Tests.DocTerm -import Tests.HighlightedToTeX -import Tests.Html -import Tests.HtmlEntities -import Tests.InlineStringPositions -import Tests.Integration -import Tests.Integration.SampleDoc -import Tests.Integration.CodeContent -import Tests.Integration.ExtraFilesDoc -import Tests.LeanCode -import Tests.Linters -import Tests.Integration.InheritanceDoc -import Tests.Integration.FrontMatter -import Tests.Integration.LeanSection -import Tests.Integration.DiagramDoc -import Tests.Method -import Tests.NestedTacticHtml -import Tests.ParserRegression -import Tests.Paths -import Tests.PorterStemmer -import Tests.Refs -import Tests.ExtensionResolution -import Tests.Serialization -import Tests.TeX -import Tests.TexUnit -import Tests.TexUtil -import Tests.VersoBlog -import Tests.VersoManual -import Tests.Z85 -import Tests.Zip diff --git a/src/tests/Tests/Golden.lean b/src/tests/Tests/Golden.lean deleted file mode 100644 index eae20b219..000000000 --- a/src/tests/Tests/Golden.lean +++ /dev/null @@ -1,156 +0,0 @@ -/- -Copyright (c) 2025 Lean FRO LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Author: David Thrane Christiansen --/ -import Lean.Util.Diff - -namespace Verso.GoldenTest - -set_option linter.missingDocs true - -open Lean.Diff - - -/-- Configuration for the test runner -/ -structure Config where - /-- Where are input and expected files located? -/ - testDir : System.FilePath - /-- Should the expected output be replaced with the actual output? -/ - updateExpected : Bool := false - /-- How to test an input file's contents. -/ - runTest : String → IO String - -/-- Result of running a single test. -/ -inductive TestResult where - /-- The test succeeded.-/ - | pass (name : String) : TestResult - /-- The test was a failure. -/ - | fail (name expected actual : String) : TestResult - /-- An error prevented the test from running. -/ - | error (name message : String) : TestResult - -/-- Statistics for a test run. -/ -structure TestStats where - /-- The number of passing tests. -/ - passed : Nat := 0 - /-- The number of failing tests. -/ - failed : Nat := 0 - /-- The number of test that couldn't run. -/ - errors : Nat := 0 - -/-- The total number of tests from a given run. -/ -def TestStats.total (stats : TestStats) : Nat := - stats.passed + stats.failed + stats.errors - -/-- Add a test result to the statistics-/ -def TestStats.add (stats : TestStats) (result : TestResult) : TestStats := - match result with - | .pass _ => { stats with passed := stats.passed + 1 } - | .fail _ _ _ => { stats with failed := stats.failed + 1 } - | .error _ _ => { stats with errors := stats.errors + 1 } - -/-- A single test consists of three paths -/ -structure TestPaths where - /-- The file to parse -/ - input : System.FilePath - /-- The expected result -/ - expected : System.FilePath - /-- The actual result -/ - output : System.FilePath - -/-- Get paths for a test given the input file path -/ -def getTestPaths (testDir : System.FilePath) (testName : String) : TestPaths where - input := testDir / (testName ++ ".input") - expected := testDir / (testName ++ ".expected") - output := testDir / (testName ++ ".output") - -/-- Run a single test -/ -def runSingleTest (config : Config) (testName : String) : IO TestResult := do - let {input, expected, output} := getTestPaths config.testDir testName - - try - let inputString ← IO.FS.readFile input - let outputString ← config.runTest inputString - IO.FS.writeFile output outputString - - if config.updateExpected then - IO.FS.writeFile expected outputString - return TestResult.pass testName - else - if ← System.FilePath.pathExists expected then - let expectedString ← IO.FS.readFile expected - if outputString == expectedString then - return TestResult.pass testName - else - return TestResult.fail testName expectedString outputString - else - return TestResult.error testName s!"Expected file not found: {expected}" - - catch e => - return TestResult.error testName (toString e) - -/-- Find all .input files in the test directory -/ -def findInputFiles (testDir : System.FilePath) : IO (Array String) := do - let entries ← testDir.readDir - return entries.filterMap fun f => - f.fileName.dropSuffix? ".input" <&> (·.toString) - - -/-- Print test result -/ -def TestResult.print (result : TestResult) : IO Unit := do - match result with - | .pass name => - IO.println s!"✓ {name}" - | .fail name expected actual => - IO.println s!"✗ {name}" - IO.println s!" Expected output differs from actual output" - let d := diff (expected.splitToList (· == '\n') |>.toArray) (actual.splitToList (· == '\n') |>.toArray) - IO.println (linesToString d) - | .error name msg => - IO.println s!"✗ {name}" - IO.println s!" Error: {msg}" - -/-- Print final statistics -/ -def printStats (stats : TestStats) : IO Unit := do - let total := stats.total - IO.println "" - IO.println s!"Tests run: {total}" - IO.println s!"Passed: {stats.passed}" - if stats.failed > 0 then - IO.println s!"Failed: {stats.failed}" - if stats.errors > 0 then - IO.println s!"Errors: {stats.errors}" - - if stats.failed == 0 && stats.errors == 0 then - IO.println "All tests passed! ✓" - else - IO.println s!"Some tests failed. ✗" - -/-- Main test runner -/ -def runTests (config : Config) : IO Unit := do - unless ← System.FilePath.pathExists config.testDir do - throw <| .userError s!"Test directory not found: {config.testDir}" - - let inputFiles ← findInputFiles config.testDir - - if inputFiles.isEmpty then - IO.println s!"No .input files found in {config.testDir}" - return - - if config.updateExpected then - IO.println s!"Updating expected outputs in {config.testDir}..." - else - IO.println s!"Running tests in {config.testDir}..." - IO.println "" - - let mut stats : TestStats := {} - for inputFile in inputFiles do - let result ← runSingleTest config inputFile - result.print - stats := stats.add result - - printStats stats - - if stats.failed == 0 && stats.errors == 0 then return - else throw <| .userError s!"Failed with {stats.failed} failures and {stats.errors} errors" diff --git a/src/tests/Tests/Integration.lean b/src/tests/Tests/Integration.lean deleted file mode 100644 index 4b4b44eba..000000000 --- a/src/tests/Tests/Integration.lean +++ /dev/null @@ -1,106 +0,0 @@ -/- -Copyright (c) 2025 Lean FRO LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Author: Jason Reed --/ -import Lean.Util.Diff - -namespace Verso.Integration - -/-- Configuration for the test runner -/ -structure Config where - /-- Where are expected files located? We expect a subdirectory - `expected` and `runTest` should produce files into a subdirectory - `output`. -/ - testDir : System.FilePath - /-- Should the expected output be replaced with the actual output? -/ - updateExpected : Bool := false - /-- How to run the test -/ - runTest : IO Unit - /-- Whether to see if lualatex builds the file -/ - checkTeX : Bool - -/-- -Returns all non-directory filepaths that are children of `root`, which -must be a directory. Returns these as paths relative to `root`. - -This differs from `System.FilePath.walkRoot`, in that the latter returns -absolute paths, and includes subdirectories. --/ -partial def filesBelow (root : System.FilePath) : - IO (Array System.FilePath) := Prod.snd <$> StateT.run (go ".") #[] -where - go (p : System.FilePath) := do - for d in (← (root / p).readDir) do - if ← d.path.isDir then - go (p / d.fileName) - else - modify (·.push (p / d.fileName)) - -/-- -Given an array of pairs `(src, tgt)` of absolute paths, copy every -`src` to every `tgt`, creating directories as necessary. --/ -partial def copyFiles (pairs : Array (System.FilePath × System.FilePath)) : - IO Unit := do - for (src, tgt) in pairs do - if let .some parent := tgt.parent then - IO.FS.createDirAll parent - IO.FS.writeBinFile tgt (← IO.FS.readBinFile src) - -/-- Main test runner -/ -def runTests (config : Config) : IO Unit := do - let outputRoot := config.testDir / "output" - let expectedRoot := config.testDir / "expected" - - if config.updateExpected then - -- Create the test directory if it doesn't exist - unless ← System.FilePath.pathExists config.testDir do - IO.FS.createDirAll config.testDir - unless ← System.FilePath.pathExists outputRoot do - IO.FS.createDirAll outputRoot - config.runTest - let outputFiles := (← filesBelow outputRoot) - IO.println s!"Updating expected outputs in {config.testDir}..." - if ← System.FilePath.pathExists expectedRoot then do - IO.FS.removeDirAll expectedRoot - copyFiles (outputFiles.map (fun p => (outputRoot / p, expectedRoot / p))) - else - unless ← System.FilePath.pathExists config.testDir do - throw <| .userError s!"Test directory not found: {config.testDir}" - unless ← System.FilePath.pathExists expectedRoot do - IO.FS.createDirAll expectedRoot - let expectedFiles := (← filesBelow expectedRoot) - - IO.println s!"Running test in {config.testDir}..." - if ← outputRoot.pathExists then - IO.FS.removeDirAll outputRoot - config.runTest - let outputFiles := (← filesBelow outputRoot) - - if expectedFiles != outputFiles then - IO.println s!"✗ Expected files differ from actual files" - IO.println s!"Expected files in {expectedRoot}:\n {expectedFiles}" - IO.println s!"Actual files in {outputRoot}:\n {outputFiles}" - throw <| .userError s!"Test in {config.testDir} failed" - - for file in expectedFiles do - let expected ← IO.FS.readFile (expectedRoot / file) - let actual ← IO.FS.readFile (outputRoot / file) - if expected != actual then - let d := Lean.Diff.diff (expected.splitToList (· == '\n') |>.toArray) (actual.splitToList (· == '\n') |>.toArray) - IO.println s!"✗ In test {config.testDir}, output file {file}" - IO.println s!" Expected output differs from actual output" - IO.println (Lean.Diff.linesToString d) - throw <| .userError s!"Test in {config.testDir} failed" - - if config.checkTeX then - -- `-shell-escape` is required so that documents using the `svg` LaTeX package can call - -- Inkscape to rasterise SVG attachments emitted by `diagram` code blocks. - discard <| IO.Process.run { - cwd := outputRoot / "tex", - cmd := "lualatex", - args := #["-shell-escape", "-halt-on-error", "-interaction=nonstopmode", "main.tex"] - } - - return diff --git a/src/tests/Tests/PorterStemmer.lean b/src/tests/Tests/PorterStemmer.lean deleted file mode 100644 index 65be9a63a..000000000 --- a/src/tests/Tests/PorterStemmer.lean +++ /dev/null @@ -1,124 +0,0 @@ -/- -Copyright (c) 2026 Lean FRO LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Author: David Thrane Christiansen --/ -module -meta import all VersoSearch.PorterStemmer - -namespace Verso.Tests.PorterStemmer - -open Verso.Search.Stemmer.Porter - -/-! ## Tests for measure function -/ - -/-- info: 0 -/ -#guard_msgs in -#eval measure "tr".toSlice -/-- info: 0 -/ -#guard_msgs in -#eval measure "ee".toSlice -/-- info: 0 -/ -#guard_msgs in -#eval measure "tree".toSlice - -/-- info: 2 -/ -#guard_msgs in -#eval measure "private".toSlice - -/-! ## Tests for step1a -/ - -/-- info: "abiliti" -/ -#guard_msgs in -#eval step1a "abilities".toSlice |>.copy - -/-! ## Tests for step1b -/ - -/-- info: "abiliti" -/ -#guard_msgs in -#eval step1b "abiliti".toSlice |>.copy - -/-- info: "caress" -/ -#guard_msgs in -#eval step1b (step1a "caresses".toSlice) |>.copy -/-- info: "poni" -/ -#guard_msgs in -#eval step1b (step1a "ponies".toSlice) |>.copy -/-- info: "ti" -/ -#guard_msgs in -#eval step1b (step1a "ties".toSlice) |>.copy -/-- info: "caress" -/ -#guard_msgs in -#eval step1b (step1a "caress".toSlice) |>.copy -/-- info: "cat" -/ -#guard_msgs in -#eval step1b (step1a "cats".toSlice) |>.copy - -/-- info: "feed" -/ -#guard_msgs in -#eval step1b (step1a "feed".toSlice) |>.copy -/-- info: "agree" -/ -#guard_msgs in -#eval step1b (step1a "agreed".toSlice) |>.copy -/-- info: "disable" -/ -#guard_msgs in -#eval step1b (step1a "disabled".toSlice) |>.copy - -/-- info: "mat" -/ -#guard_msgs in -#eval step1b (step1a "matting".toSlice) |>.copy -/-- info: "mate" -/ -#guard_msgs in -#eval step1b (step1a "mating".toSlice) |>.copy -/-- info: "meet" -/ -#guard_msgs in -#eval step1b (step1a "meeting".toSlice) |>.copy -/-- info: "mill" -/ -#guard_msgs in -#eval step1b (step1a "milling".toSlice) |>.copy -/-- info: "mess" -/ -#guard_msgs in -#eval step1b (step1a "messing".toSlice) |>.copy - -/-- info: "meet" -/ -#guard_msgs in -#eval step1b (step1a "meetings".toSlice) |>.copy - -/-! ## Tests for step1c -/ - -/-- info: "happi" -/ -#guard_msgs in -#eval step1c "happy".toSlice |>.copy - -/-- info: "abiliti" -/ -#guard_msgs in -#eval step1c "abiliti".toSlice |>.copy - -/-! ## Tests for step2 -/ - -/-- info: "sensible" -/ -#guard_msgs in -#eval step2 "sensibiliti".toSlice |>.copy - -/-- info: "abiliti" -/ -#guard_msgs in -#eval step2 "abiliti".toSlice |>.copy - -/-! ## Tests for step3 -/ - -/-- info: "form" -/ -#guard_msgs in -#eval step3 "formative".toSlice |>.copy - -/-- info: "able" -/ -#guard_msgs in -#eval step3 "able".toSlice |>.copy - -/-! ## Tests for step5b -/ - -/-- info: "control" -/ -#guard_msgs in -#eval step5b "controll".toSlice |>.copy -/-- info: "roll" -/ -#guard_msgs in -#eval step5b "roll".toSlice |>.copy diff --git a/src/tests/Tests/TeX.lean b/src/tests/Tests/TeX.lean deleted file mode 100644 index ea49ae72a..000000000 --- a/src/tests/Tests/TeX.lean +++ /dev/null @@ -1,93 +0,0 @@ -/- -Copyright (c) 2026 Lean FRO LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Author: David Thrane Christiansen --/ -import Verso.Doc.TeX -import Verso.Output.TeX - -namespace Verso.Tests.TeX - -open Verso.Doc.TeX -open Verso.Output.TeX - -/-! ## Tests for escapeForVerbatim -/ - -/-- info: "\\symbol{123}\\symbol{124}\\symbol{125}\\symbol{92}" -/ -#guard_msgs in -#eval escapeForVerbatim "{|}\\" - --- Tests for lineBreaks functionality -/-- info: "Nat.\\allowbreak{}add\\-One" -/ -#guard_msgs in -#eval escapeForVerbatim "Nat.addOne" (lineBreaks := true) - -/-- info: "List.\\allowbreak{}map2\\-Fun" -/ -#guard_msgs in -#eval escapeForVerbatim "List.map2Fun" (lineBreaks := true) - -/-- info: "x2\\-y" -/ -#guard_msgs in -#eval escapeForVerbatim "x2y" (lineBreaks := true) - -/-- info: "Foo123" -/ -#guard_msgs in -#eval escapeForVerbatim "Foo123" (lineBreaks := true) -- no break before digits - -/-- info: "a..\\allowbreak{}b" -/ -#guard_msgs in -#eval escapeForVerbatim "a..b" (lineBreaks := true) -- only one break after dot sequence - -/-- info: "\\symbol{123}foo\\-Bar" -/ -#guard_msgs in -#eval escapeForVerbatim "{fooBar" (lineBreaks := true) -- escaping + line breaks - -/-- info: "plain" -/ -#guard_msgs in -#eval escapeForVerbatim "plain" (lineBreaks := true) -- no transitions - -/-- info: "Nat.addOne" -/ -#guard_msgs in -#eval escapeForVerbatim "Nat.addOne" -- lineBreaks := false (default), no breaks - -end Verso.Tests.TeX - -/-! ## Tests for TeX syntax macros -/ - -open scoped Verso.Output.TeX - -/-- info: Verso.Output.TeX.seq #[] -/ -#guard_msgs in -#eval IO.println <| (repr <| \TeX{}).pretty 80 - -/-- info: Verso.Output.TeX.text "Hello, world!" -/ -#guard_msgs in -#eval IO.println <| (repr <| \TeX{"Hello, world!"}).pretty 80 - -/-- -info: Verso.Output.TeX.command - "hyperlink" - #[] - #[Verso.Output.TeX.raw "foo", Verso.Output.TeX.text ""] --/ -#guard_msgs in -#eval IO.println <| (repr<| \TeX{\hyperlink{\Lean{.raw "foo" }}{\Lean{""}}}).pretty 80 - -/-- -info: Verso.Output.TeX.seq - #[Verso.Output.TeX.text "Hello, ", - Verso.Output.TeX.command "textbf" #[] #[Verso.Output.TeX.text "world"]] --/ -#guard_msgs in -#eval IO.println <| (repr <| \TeX{"Hello, " \textbf{"world"}}).pretty 80 - -/-- -info: Verso.Output.TeX.environment - "Verbatim" - #[] - #[Verso.Output.TeX.raw "commandChars=\\\\"] - #[Verso.Output.TeX.text "Hello, ", - Verso.Output.TeX.command "textbf" #[] #[Verso.Output.TeX.text "world"]] --/ -#guard_msgs in -#eval IO.println <| (repr <| \TeX{\begin{Verbatim}{s!"commandChars=\\\\"}"Hello, " \textbf{"world"}\end{Verbatim}}).pretty 80 diff --git a/src/tests/Tests/VersoBlog.lean b/src/tests/Tests/VersoBlog.lean deleted file mode 100644 index 49fd7bc67..000000000 --- a/src/tests/Tests/VersoBlog.lean +++ /dev/null @@ -1,107 +0,0 @@ -/- -Copyright (c) 2026 Lean FRO LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Author: David Thrane Christiansen --/ -import Plausible -import Plausible.ArbitraryFueled -import VersoBlog -import VersoBlog.LiterateLeanPage -import Tests.Arbitrary - -open Lean -open Verso Genre Blog -open Verso.Multi -open Verso.NameMap -open Plausible Gen Arbitrary - -/-! ## Tests for NameSuffixMap -/ - -/-- info: #[(`a.b.c, 1), (`a.c, 4), (`b.c, 6), (`c, 3)] -/ -#guard_msgs in -#eval NameSuffixMap.empty |>.insert `a.b.c 1 |>.insert `b.c 2 |>.insert `c 3 |>.insert `a.c 4 |>.insert `a.b 5 |>.insert `b.c 6 |>.get `c - -def freshIdOk (hint : LetterString) (path : Path) (howMany : Nat) : Bool := Id.run do - let mut st : TraverseState := { remoteContent := {} } - let mut ids := #[] - for _ in 0...howMany do - let i := st.freshId path hint.sluggify - st := { st with usedIds := st.usedIds.alter path (fun used? => used?.getD {} |>.insert i) } - ids := ids.push i - ids.size == howMany && ids.all (ids.count · == 1) - -def freshId_first_is_hint (hint : LetterString) (path : Path) : Bool := Id.run do - let st : TraverseState := { remoteContent := {} } - let i := st.freshId path hint.sluggify - hint.isEmpty || i == hint.sluggify - -def freshId_second_is_hint_with_1 (hint : LetterString) (path : Path) : Bool := Id.run do - let mut st : TraverseState := { remoteContent := {} } - let i := st.freshId path hint.sluggify - st := { st with usedIds := st.usedIds.alter path (fun used? => used?.getD {} |>.insert i) } - let i' := st.freshId path hint.sluggify - i != i' && (hint.isEmpty || (i == hint.sluggify && i' == (s!"{hint}1").sluggify)) - -open scoped Plausible.Decorations in -private def testProp - (p : Prop) (cfg : Configuration := {}) - (p' : Decorations.DecorationsOf p := by mk_decorations) [Testable p'] : - IO (TestResult p') := - Testable.checkIO p' (cfg := cfg) - -def blogTests : List (Name × (Σ p, IO <| TestResult p)) := [ - (`freshIdOk, ⟨_, testProp <| ∀ h p n, freshIdOk h p n⟩), - (`freshId_first_is_hint, ⟨_, testProp <| ∀ h p, freshId_first_is_hint h p⟩), - (`freshId_second_is_hint_with_1, ⟨_, testProp <| ∀ h p, freshId_second_is_hint_with_1 h p⟩), -] - -def runBlogTests : IO Nat := do - let mut failures := 0 - for (name, test) in blogTests do - IO.print s!"{name}: " - let res ← test.2 - IO.println res - unless res matches .success .. do - failures := failures + 1 - return failures - --- Regression test for hidden blog Lean blocks. -#doc (Post) "Hidden Lean Block Flags" => -```leanInit post -``` - -```lean post -show -def base : Nat := 40 -``` - -```lean post -keep -def scratch : Nat := base + 2 -``` - -```lean post -example : base = 40 := rfl -``` - -```lean post +error -#check scratch -``` - --- Regression test for inline Lean role naming in Blog: --- canonical `{lean}` works without warnings. -#docs (Post) inlineLeanRoleNames "Inline Lean Role Names" := -```leanInit post -``` - -Canonical role: {lean post}`Nat.succ 1`. - -/-- -warning: `{leanInline}` is deprecated; use `{lean}` instead. --/ -#docs (Post) inlineLeanRoleNamesDeprecated "Inline Lean Role Names (deprecated alias)" := -```leanInit post2 -``` - -Legacy role: {lean post2}`Nat.succ 1`. - -#guard inlineLeanRoleNames.toPart.content.size > 0 -#guard inlineLeanRoleNamesDeprecated.toPart.content.size > 0 diff --git a/src/tests/Tests/VersoManual.lean b/src/tests/Tests/VersoManual.lean deleted file mode 100644 index 07c67f033..000000000 --- a/src/tests/Tests/VersoManual.lean +++ /dev/null @@ -1,10 +0,0 @@ -/- -Copyright (c) 2025 Lean FRO LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Author: David Thrane Christiansen --/ -import Tests.VersoManual.Html -import Tests.VersoManual.Html.SoftHyphenate -import Tests.VersoManual.License -import Tests.VersoManual.Markdown -import Tests.VersoManual.WordCount diff --git a/src/tests/Tests/Zip.lean b/src/tests/Tests/Zip.lean deleted file mode 100644 index 2d3834d52..000000000 --- a/src/tests/Tests/Zip.lean +++ /dev/null @@ -1,29 +0,0 @@ -/- -Copyright (c) 2025 Lean FRO LLC. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Author: David Thrane Christiansen --/ - -import VersoUtil.Zip - -open Verso.Zip - -def testExtract (files : Array (String × ByteArray)) (method : CompressionMethod) : IO Unit := do - IO.FS.withTempDir fun dir => do - let extra ← IO.monoMsNow - let dir := dir / s!"{extra}" - IO.FS.createDirAll dir - let file := dir / "out.zip" - - zipToFile file files method - let out ← IO.Process.output {cmd := "unzip", args := #["-u", file.toString, "-d", dir.toString]} - -- unzip returns 1 on empty archives, 2 on corrupt archives - if out.exitCode == 0 || (files.isEmpty && out.exitCode == 1) then - for (f, contents) in files do - let found ← IO.FS.readBinFile (dir / f) - if found != contents then - throw <| .userError s!"Mismatched file contents of {f}. Expected {contents}, got {found}" - else - throw <| IO.userError s!"process 'unzip' exited with code {out.exitCode}\ - \nstderr:\ - \n{out.stderr}" diff --git a/src/tests/Tests/Arbitrary.lean b/src/tests/VersoTests/Arbitrary.lean similarity index 100% rename from src/tests/Tests/Arbitrary.lean rename to src/tests/VersoTests/Arbitrary.lean diff --git a/src/tests/Tests/Basic.lean b/src/tests/VersoTests/Basic.lean similarity index 97% rename from src/tests/Tests/Basic.lean rename to src/tests/VersoTests/Basic.lean index 597aef80b..cb27067eb 100644 --- a/src/tests/Tests/Basic.lean +++ b/src/tests/VersoTests/Basic.lean @@ -3,6 +3,7 @@ Copyright (c) 2023 Lean FRO LLC. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Author: David Thrane Christiansen -/ +import Errata import Verso namespace Verso.BasicTest set_option guard_msgs.diff true @@ -15,7 +16,7 @@ set_option pp.rawOnError true ::::::: ::::::: /-- info: Verso.Doc.Part.mk #[Verso.Doc.Inline.text "Nothing"] "Nothing" none #[] #[] -/ -#guard_msgs in +#test_msgs in #eval noDoc.toPart @@ -35,7 +36,7 @@ info: Verso.Doc.Part.mk #[Verso.Doc.Block.para #[Verso.Doc.Inline.text "Hello, I'm a paragraph. Yes I am!"]] #[] -/ -#guard_msgs in +#test_msgs in #eval littleParagraph.toPart @@ -55,7 +56,7 @@ info: Verso.Doc.Part.mk #[Verso.Doc.Block.ul #[{ contents := #[Verso.Doc.Block.para #[Verso.Doc.Inline.text "Just a list with one item"]] }]] #[] -/ -#guard_msgs in +#test_msgs in #eval listOneItem.toPart @@ -82,7 +83,7 @@ info: Verso.Doc.Part.mk #[Verso.Doc.Block.para #[Verso.Doc.Inline.text "a paragraph"]] #[]] -/ -#guard_msgs in +#test_msgs in #eval sectionAndPara.toPart @@ -127,7 +128,7 @@ info: Verso.Doc.Part.mk #[{ contents := #[Verso.Doc.Block.para #[Verso.Doc.Inline.text "and nested"]] }]] }]] #[]]] -/ -#guard_msgs in +#test_msgs in #eval nestedDoc1.toPart @@ -172,7 +173,7 @@ info: Verso.Doc.Part.mk Verso.Doc.Block.ul #[{ contents := #[Verso.Doc.Block.para #[Verso.Doc.Inline.text "and nested"]] }]] #[]]] -/ -#guard_msgs in +#test_msgs in #eval nestedDoc2.toPart @@ -222,7 +223,7 @@ info: Verso.Doc.Part.mk #[{ contents := #[Verso.Doc.Block.para #[Verso.Doc.Inline.text "and nested"]] }]] }]] #[]]] -/ -#guard_msgs in +#test_msgs in #eval nestedDoc3.toPart @@ -259,7 +260,7 @@ info: Verso.Doc.Part.mk Verso.Doc.Block.para #[Verso.Doc.Inline.text "Also, 2 > 3."]] #[]] -/ -#guard_msgs in +#test_msgs in #eval nestedDoc4.toPart @@ -267,7 +268,7 @@ info: Verso.Doc.Part.mk -- https://github.com/leanprover/verso/pull/541 /-- error: Wrong header nesting - got #### but expected at most ### -/ -#guard_msgs in +#test_msgs in #docs (.none) h "Bad nesting" := ::::::: diff --git a/src/tests/VersoTests/Blog.lean b/src/tests/VersoTests/Blog.lean index 4cf4050e9..f8d9d8079 100644 --- a/src/tests/VersoTests/Blog.lean +++ b/src/tests/VersoTests/Blog.lean @@ -8,7 +8,7 @@ itself is not part of the module system; the Errata runner imports it through it -/ import VersoBlog import VersoBlog.LiterateLeanPage -import Tests.Arbitrary +import VersoTests.Arbitrary import Errata open Lean diff --git a/src/tests/Tests/CommentSkipping.lean b/src/tests/VersoTests/CommentSkipping.lean similarity index 87% rename from src/tests/Tests/CommentSkipping.lean rename to src/tests/VersoTests/CommentSkipping.lean index 847fda6fd..3b140d783 100644 --- a/src/tests/Tests/CommentSkipping.lean +++ b/src/tests/VersoTests/CommentSkipping.lean @@ -3,8 +3,9 @@ Copyright (c) 2026 Lean FRO LLC. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Author: David Thrane Christiansen -/ -import Tests.CommentSkipping.Doc -import Tests.CommentSkipping.Doc2 +import Errata +import VersoTests.CommentSkipping.Doc +import VersoTests.CommentSkipping.Doc2 /-! This test ensures that Lean's parser doesn't skip Lean comment syntax while parsing Verso blocks as @@ -26,8 +27,8 @@ info: Verso.Doc.Part.mk Verso.Doc.Block.para #[Verso.Doc.Inline.text "def", Verso.Doc.Inline.linebreak "\n"]] #[] -/ -#guard_msgs in -#eval %doc Tests.CommentSkipping.Doc +#test_msgs in +#eval %doc VersoTests.CommentSkipping.Doc /-- info: Verso.Doc.Part.mk @@ -40,5 +41,5 @@ info: Verso.Doc.Part.mk Verso.Doc.Block.blockquote #[(Verso.Doc.Block.para #[Verso.Doc.Inline.text "C", Verso.Doc.Inline.linebreak "\n"])]] #[] -/ -#guard_msgs in -#eval %doc Tests.CommentSkipping.Doc2 +#test_msgs in +#eval %doc VersoTests.CommentSkipping.Doc2 diff --git a/src/tests/Tests/CommentSkipping/Doc.lean b/src/tests/VersoTests/CommentSkipping/Doc.lean similarity index 100% rename from src/tests/Tests/CommentSkipping/Doc.lean rename to src/tests/VersoTests/CommentSkipping/Doc.lean diff --git a/src/tests/Tests/CommentSkipping/Doc2.lean b/src/tests/VersoTests/CommentSkipping/Doc2.lean similarity index 100% rename from src/tests/Tests/CommentSkipping/Doc2.lean rename to src/tests/VersoTests/CommentSkipping/Doc2.lean diff --git a/src/tests/Tests/DocElabExtensions/Define.lean b/src/tests/VersoTests/DocElabExtensions/Define.lean similarity index 95% rename from src/tests/Tests/DocElabExtensions/Define.lean rename to src/tests/VersoTests/DocElabExtensions/Define.lean index f4915af1a..5532c0b13 100644 --- a/src/tests/Tests/DocElabExtensions/Define.lean +++ b/src/tests/VersoTests/DocElabExtensions/Define.lean @@ -3,7 +3,7 @@ Copyright (c) 2026 Lean FRO LLC. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Author: Emilio Jesus Gallego Arias -/ -import Tests.DocElabExtensions.LocalExtension +import VersoTests.DocElabExtensions.LocalExtension import VersoManual namespace Verso.Tests.DocElabExtensions diff --git a/src/tests/Tests/DocElabExtensions/LocalExtension.lean b/src/tests/VersoTests/DocElabExtensions/LocalExtension.lean similarity index 100% rename from src/tests/Tests/DocElabExtensions/LocalExtension.lean rename to src/tests/VersoTests/DocElabExtensions/LocalExtension.lean diff --git a/src/tests/Tests/DocElabExtensions/Middle.lean b/src/tests/VersoTests/DocElabExtensions/Middle.lean similarity index 92% rename from src/tests/Tests/DocElabExtensions/Middle.lean rename to src/tests/VersoTests/DocElabExtensions/Middle.lean index 54fc85e29..e89ab15a4 100644 --- a/src/tests/Tests/DocElabExtensions/Middle.lean +++ b/src/tests/VersoTests/DocElabExtensions/Middle.lean @@ -3,7 +3,7 @@ Copyright (c) 2026 Lean FRO LLC. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Author: Emilio Jesus Gallego Arias -/ -import Tests.DocElabExtensions.Define +import VersoTests.DocElabExtensions.Define namespace Verso.Tests.DocElabExtensions diff --git a/src/tests/Tests/DocElabExtensions/Use.lean b/src/tests/VersoTests/DocElabExtensions/Use.lean similarity index 97% rename from src/tests/Tests/DocElabExtensions/Use.lean rename to src/tests/VersoTests/DocElabExtensions/Use.lean index 74e66ff07..1641cedeb 100644 --- a/src/tests/Tests/DocElabExtensions/Use.lean +++ b/src/tests/VersoTests/DocElabExtensions/Use.lean @@ -3,7 +3,7 @@ Copyright (c) 2026 Lean FRO LLC. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Author: Emilio Jesus Gallego Arias -/ -import Tests.DocElabExtensions.Middle +import VersoTests.DocElabExtensions.Middle namespace Verso.Tests.DocElabExtensions diff --git a/src/tests/Tests/DocTerm.lean b/src/tests/VersoTests/DocTerm.lean similarity index 100% rename from src/tests/Tests/DocTerm.lean rename to src/tests/VersoTests/DocTerm.lean diff --git a/src/tests/Tests/Elab.lean b/src/tests/VersoTests/Elab.lean similarity index 97% rename from src/tests/Tests/Elab.lean rename to src/tests/VersoTests/Elab.lean index dc6f85760..72af1873c 100644 --- a/src/tests/Tests/Elab.lean +++ b/src/tests/VersoTests/Elab.lean @@ -3,6 +3,7 @@ Copyright (c) 2025 Lean FRO LLC. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Author: Rob Simmons -/ +import Errata import Verso import VersoManual namespace Verso.BlocksTest @@ -45,14 +46,14 @@ context: docReconstInBlock✝ : Doc.DocReconstruction ⊢ Doc.Inline Doc.Genre.none -/ -#guard_msgs in +#test_msgs in #docs (.none) var8 "My title here" := ::::::: Attempting to insert something {totallyUndefined}[] ::::::: end -#guard_msgs in +#test_msgs in #docs (Manual) novar "My title here" := ::::::: A variable like {lean +error}`x`. diff --git a/src/tests/Tests/ExtensionResolution.lean b/src/tests/VersoTests/ExtensionResolution.lean similarity index 95% rename from src/tests/Tests/ExtensionResolution.lean rename to src/tests/VersoTests/ExtensionResolution.lean index da3cc288e..e7f446bde 100644 --- a/src/tests/Tests/ExtensionResolution.lean +++ b/src/tests/VersoTests/ExtensionResolution.lean @@ -3,6 +3,7 @@ Copyright (c) 2026 Lean FRO LLC. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Author: Emilio J. Gallego Arias -/ +import Errata import Verso namespace Verso.ExtensionResolutionTest @@ -32,7 +33,7 @@ def registered : RoleExpanderOf Unit ::::::: /-- info: #[Verso.Doc.Block.para #[Verso.Doc.Inline.text "registered-role"]] -/ -#guard_msgs in +#test_msgs in #eval roleRegistered.toPart.content @[role_expander legacyRegistered] @@ -46,7 +47,7 @@ def legacyRegistered : RoleExpander ::::::: /-- info: #[Verso.Doc.Block.para #[Verso.Doc.Inline.text "legacy-role"]] -/ -#guard_msgs in +#test_msgs in #eval roleLegacyRegistered.toPart.content def unregistered : RoleExpander @@ -56,7 +57,7 @@ def unregistered : RoleExpander /-- error: Declaration `unregistered` can be used as a role expander but is not registered as a role. Register it with `@[role]`. -/ -#guard_msgs in +#test_msgs in #docs (.none) roleUnregistered "Unregistered role" := ::::::: {unregistered}[] @@ -67,7 +68,7 @@ def wrongType : Nat := 7 /-- error: Declaration `wrongType` was found but is not registered as a role. -/ -#guard_msgs in +#test_msgs in #docs (.none) roleWrongType "Wrong role type" := ::::::: {wrongType}[] @@ -79,7 +80,7 @@ error: No registered role `registred`. Hint: Did you mean role `registered`? registe̲red -/ -#guard_msgs in +#test_msgs in #docs (.none) roleTypo "Role typo" := ::::::: {registred}[] @@ -91,7 +92,7 @@ error: No registered role `legacyRegistred`. Hint: Did you mean role `legacyRegistered`? legacyRegiste̲red -/ -#guard_msgs in +#test_msgs in #docs (.none) roleLegacyTypo "Legacy role typo" := ::::::: {legacyRegistred}[] @@ -100,7 +101,7 @@ Hint: Did you mean role `legacyRegistered`? /-- error: No registered role `nothereatallzzzz`. -/ -#guard_msgs in +#test_msgs in #docs (.none) roleNoCloseMatch "No close role match" := ::::::: {nothereatallzzzz}[] @@ -123,7 +124,7 @@ because any single-character role is within distance 1 of any single-character t /-- error: No registered role `q`. -/ -#guard_msgs in +#test_msgs in #docs (.none) oneCharDistanceNoMatch "One-character distance no match" := ::::::: {q}[] @@ -175,7 +176,7 @@ error: No registered role `q`. Hint: Did you mean role `r`? q̵r̲ -/ -#guard_msgs in +#test_msgs in #docs (.none) oneCharDistanceMatch "One-character distance match" := ::::::: {q}[] @@ -187,7 +188,7 @@ error: No registered role `ac`. Hint: Did you mean role `ab`? ac̵b̲ -/ -#guard_msgs in +#test_msgs in #docs (.none) shortDistanceMatch "Short distance match" := ::::::: {ac}[] @@ -196,7 +197,7 @@ Hint: Did you mean role `ab`? /-- error: No registered role `zz`. -/ -#guard_msgs in +#test_msgs in #docs (.none) shortDistanceNoMatch "Short distance no match" := ::::::: {zz}[] @@ -208,7 +209,7 @@ error: No registered role `vww`. Hint: Did you mean role `vvv`? vw̵w̵v̲v̲ -/ -#guard_msgs in +#test_msgs in #docs (.none) threeCharDistanceMatch "Three-character distance match" := ::::::: {vww}[] @@ -217,7 +218,7 @@ Hint: Did you mean role `vvv`? /-- error: No registered role `www`. -/ -#guard_msgs in +#test_msgs in #docs (.none) threeCharDistanceNoMatch "Three-character distance no match" := ::::::: {www}[] @@ -229,7 +230,7 @@ error: No registered role `yyyxx`. Hint: Did you mean role `yyyyy`? yyyx̵x̵y̲y̲ -/ -#guard_msgs in +#test_msgs in #docs (.none) middleDistanceMatch "Middle distance match" := ::::::: {yyyxx}[] @@ -238,7 +239,7 @@ Hint: Did you mean role `yyyyy`? /-- error: No registered role `yyxxx`. -/ -#guard_msgs in +#test_msgs in #docs (.none) middleDistanceNoMatch "Middle distance no match" := ::::::: {yyxxx}[] @@ -250,7 +251,7 @@ error: No registered role `zzzaaa`. Hint: Did you mean role `zzzzzz`? zzza̵a̵a̵z̲z̲z̲ -/ -#guard_msgs in +#test_msgs in #docs (.none) longBoundaryDistanceMatch "Long boundary distance match" := ::::::: {zzzaaa}[] @@ -259,7 +260,7 @@ Hint: Did you mean role `zzzzzz`? /-- error: No registered role `zzaaaa`. -/ -#guard_msgs in +#test_msgs in #docs (.none) longBoundaryDistanceNoMatch "Long boundary distance no match" := ::::::: {zzaaaa}[] @@ -272,7 +273,7 @@ Hint: Did you mean role `multiAlpha`? • multiAlphx̵a̲ • multiAlphx̵i̲ -/ -#guard_msgs in +#test_msgs in #docs (.none) multiDistanceSuggestions "Multiple distance suggestions" := ::::::: {multiAlphx}[] @@ -284,7 +285,7 @@ error: No registered role `distanceRegistred`. Hint: Did you mean role `distanceRegistered`? distanceRegiste̲red -/ -#guard_msgs in +#test_msgs in #docs (.none) longDistanceMatch "Long distance match" := ::::::: {distanceRegistred}[] @@ -293,7 +294,7 @@ Hint: Did you mean role `distanceRegistered`? /-- error: No registered role `distanceNoMatchzzzz`. -/ -#guard_msgs in +#test_msgs in #docs (.none) longDistanceNoMatch "Long distance no match" := ::::::: {distanceNoMatchzzzz}[] @@ -325,7 +326,7 @@ error: No registered role `ShadowSource.shadowedRegistred`. Hint: Did you mean role `ShadowSource.shadowedRegistered`? ShadowSource.shadowedRegiste̲red -/ -#guard_msgs in +#test_msgs in #docs (.none) roleShadowedSuggestion "Shadowed role suggestion" := ::::::: {ShadowSource.shadowedRegistred}[] @@ -337,7 +338,7 @@ error: No registered role `shadowedRegistred`. Hint: Did you mean role `ShadowSource.shadowedRegistered`? s̵h̵a̵d̵o̵w̵e̵d̵R̵e̵g̵i̵s̵t̵r̵e̵d̵S̲h̲a̲d̲o̲w̲S̲o̲u̲r̲c̲e̲.̲s̲h̲a̲d̲o̲w̲e̲d̲R̲e̲g̲i̲s̲t̲e̲r̲e̲d̲ -/ -#guard_msgs in +#test_msgs in #docs (.none) roleUnqualifiedShadowedSuggestion "Unqualified shadowed role suggestion" := ::::::: {shadowedRegistred}[] @@ -366,7 +367,7 @@ def unregisteredBlock : CodeBlockExpanderOf Unit /-- error: Declaration `unregisteredBlock` can be used as a code block expander but is not registered as a code block. Register it with `@[code_block]`. -/ -#guard_msgs in +#test_msgs in #docs (.none) codeBlockUnregistered "Unregistered code block" := ::::::: ```unregisteredBlock @@ -379,7 +380,7 @@ def wrongBlockType : Nat := 7 /-- error: Declaration `wrongBlockType` was found but is not registered as a code block. -/ -#guard_msgs in +#test_msgs in #docs (.none) codeBlockWrongType "Wrong code block type" := ::::::: ```wrongBlockType @@ -393,7 +394,7 @@ error: No registered code block `registeredBlok`. Hint: Did you mean code block `registeredBlock`? registeredBloc̲k -/ -#guard_msgs in +#test_msgs in #docs (.none) codeBlockTypo "Code block typo" := ::::::: ```registeredBlok @@ -426,7 +427,7 @@ def unregisteredDirective : DirectiveExpanderOf Unit /-- error: Declaration `unregisteredDirective` can be used as a directive expander but is not registered as a directive. Register it with `@[directive]`. -/ -#guard_msgs in +#test_msgs in #docs (.none) directiveUnregistered "Unregistered directive" := ::::::: :::unregisteredDirective @@ -439,7 +440,7 @@ def wrongDirectiveType : Nat := 7 /-- error: Declaration `wrongDirectiveType` was found but is not registered as a directive. -/ -#guard_msgs in +#test_msgs in #docs (.none) directiveWrongType "Wrong directive type" := ::::::: :::wrongDirectiveType @@ -453,7 +454,7 @@ error: No registered directive `registeredDirektive`. Hint: Did you mean directive `registeredDirective`? registeredDirek̵c̲tive -/ -#guard_msgs in +#test_msgs in #docs (.none) directiveTypo "Directive typo" := ::::::: :::registeredDirektive @@ -476,7 +477,7 @@ def registeredCommand : BlockCommandOf Unit ::::::: /-- info: #[Verso.Doc.Block.concat #[(Verso.Doc.Block.para #[Verso.Doc.Inline.text "registered-command"])]] -/ -#guard_msgs in +#test_msgs in #eval blockCommandRegistered.toPart.content def fallbackCommand : Verso.Doc.Block Verso.Doc.Genre.none := @@ -488,7 +489,7 @@ def fallbackCommand : Verso.Doc.Block Verso.Doc.Genre.none := ::::::: /-- info: #[Verso.Doc.Block.para #[Verso.Doc.Inline.text "fallback-command"]] -/ -#guard_msgs in +#test_msgs in #eval blockCommandFallback.toPart.content /-- @@ -497,7 +498,7 @@ error: No registered block command `registeredComand`. Hint: Did you mean block command `registeredCommand`? registeredComm̲and -/ -#guard_msgs in +#test_msgs in #docs (.none) blockCommandTypo "Block command typo" := ::::::: {registeredComand} diff --git a/src/tests/Tests/GenericCode.lean b/src/tests/VersoTests/GenericCode.lean similarity index 97% rename from src/tests/Tests/GenericCode.lean rename to src/tests/VersoTests/GenericCode.lean index ff21d5512..44f395989 100644 --- a/src/tests/Tests/GenericCode.lean +++ b/src/tests/VersoTests/GenericCode.lean @@ -3,6 +3,7 @@ Copyright (c) 2023 Lean FRO LLC. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Author: David Thrane Christiansen -/ +import Errata import Verso namespace Verso.GenericCodeTest set_option guard_msgs.diff true @@ -38,7 +39,7 @@ info: Verso.Doc.Part.mk Verso.Doc.Block.code "(define (zero f z) z)\n(define (succ n) (lambda (f x) (f (n f z))))\n"] #[]] -/ -#guard_msgs in +#test_msgs in #eval code1.toPart /-- info: Verso.Output.Html.tag @@ -57,7 +58,7 @@ info: Verso.Output.Html.tag #[] (Verso.Output.Html.text true "(define (zero f z) z)\n(define (succ n) (lambda (f x) (f (n f z))))\n")])]) -/ -#guard_msgs in +#test_msgs in #eval Doc.Genre.none.toHtml (m := Id) {} () () {} {} {} code1.toPart |>.run .empty |>.fst @@ -91,5 +92,5 @@ info: Verso.Doc.Part.mk Verso.Doc.Block.code "(define (zero f z) z)\n(define (succ n) (lambda (f x) (f (n f z))))\n"] #[]] -/ -#guard_msgs in +#test_msgs in #eval code2.toPart diff --git a/src/tests/Tests/HighlightedToTeX.lean b/src/tests/VersoTests/HighlightedToTeX.lean similarity index 92% rename from src/tests/Tests/HighlightedToTeX.lean rename to src/tests/VersoTests/HighlightedToTeX.lean index dba4aa078..e223f48c4 100644 --- a/src/tests/Tests/HighlightedToTeX.lean +++ b/src/tests/VersoTests/HighlightedToTeX.lean @@ -4,11 +4,12 @@ Released under Apache 2.0 license as described in the file LICENSE. Author: Jason Reed -/ module +import Errata meta import all Verso.Code.HighlightedToTex open Verso.Doc.TeX (escapeForVerbatim) open SubVerso.Highlighting /-- info: "\\symbol{123}\\symbol{124}\\symbol{125}\\symbol{92}" -/ -#guard_msgs in +#test_msgs in #eval escapeForVerbatim "{|}\\" diff --git a/src/tests/Tests/Html.lean b/src/tests/VersoTests/Html.lean similarity index 96% rename from src/tests/Tests/Html.lean rename to src/tests/VersoTests/Html.lean index 4a1ef0de6..f1fe35a0f 100644 --- a/src/tests/Tests/Html.lean +++ b/src/tests/VersoTests/Html.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Author: David Thrane Christiansen -/ module +import Errata meta import all Verso.Output.Html namespace Verso.Tests.Html @@ -21,7 +22,7 @@ info: Verso.Output.Html.tag #[("charset", "UTF-8"), ("charset", "UTF-8"), ("a", "b"), ("a-b-c", "44"), ("x", "y")] (Verso.Output.Html.seq #[]) -/ -#guard_msgs in +#test_msgs in #eval testAttrs private def testAttrsAntiquotes := @@ -33,7 +34,7 @@ info: Verso.Output.Html.tag #[("charset", "UTF-8"), ("charset", "UTF-8"), ("a", "b"), ("a-b-c", "44"), ("x", "y")] (Verso.Output.Html.seq #[]) -/ -#guard_msgs in +#test_msgs in #eval testAttrsAntiquotes private def test : Html := {{ @@ -73,7 +74,7 @@ info: Verso.Output.Html.tag #[Verso.Output.Html.text true "foo bar", Verso.Output.Html.tag "br" #[] (Verso.Output.Html.seq #[]), Verso.Output.Html.text true "hey"])])]) -/ -#guard_msgs in +#test_msgs in #eval test private def leanKwTest : Html := {{ @@ -81,7 +82,7 @@ private def leanKwTest : Html := {{ }} /-- info: Verso.Output.Html.tag "label" #[("for", "foo")] (Verso.Output.Html.text true "Blah") -/ -#guard_msgs in +#test_msgs in #eval leanKwTest @@ -91,7 +92,7 @@ error: `<br>` doesn't allow contents Hint: Remove contents <̵b̵r̵>̵"̵f̵o̵o̵"̵ ̵"̵f̵o̵o̵"̵<̵/̵b̵r̵>̵<̲b̲r̲/̲>̲ -/ -#guard_msgs in +#test_msgs in #eval show Html from {{ <br>"foo" "foo"</br> }} /-- @@ -107,5 +108,5 @@ info: | </body> </html> -/ -#guard_msgs in +#test_msgs in #eval IO.println <| "|\n" ++ test.asString diff --git a/src/tests/Tests/HtmlEntities.lean b/src/tests/VersoTests/HtmlEntities.lean similarity index 84% rename from src/tests/Tests/HtmlEntities.lean rename to src/tests/VersoTests/HtmlEntities.lean index 1825c47e9..06aada427 100644 --- a/src/tests/Tests/HtmlEntities.lean +++ b/src/tests/VersoTests/HtmlEntities.lean @@ -3,34 +3,35 @@ Copyright (c) 2025 Lean FRO LLC. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Author: David Thrane Christiansen -/ +import Errata import Verso.Output.Html.Entities open Verso.Output.Html /-- info: some "&" -/ -#guard_msgs in +#test_msgs in #eval decodeEntity? "&" /-- info: some "&" -/ -#guard_msgs in +#test_msgs in #eval decodeEntity? "&" /-- info: some #["&", "&", "&", "&"] -/ -#guard_msgs in +#test_msgs in #eval namedEntity? '&' |>.map (·.toArray |>.qsort) /-- info: some " " -/ -#guard_msgs in +#test_msgs in #eval decodeEntity? " " /-- info: some " " -/ -#guard_msgs in +#test_msgs in #eval decodeEntity? " " /-- info: none -/ -#guard_msgs in +#test_msgs in #eval decodeEntity? "&#;" /-- info: none -/ -#guard_msgs in +#test_msgs in #eval decodeEntity? "&blah;" diff --git a/src/tests/Tests/InlineStringPositions.lean b/src/tests/VersoTests/InlineStringPositions.lean similarity index 98% rename from src/tests/Tests/InlineStringPositions.lean rename to src/tests/VersoTests/InlineStringPositions.lean index 8732986dd..b2b404d36 100644 --- a/src/tests/Tests/InlineStringPositions.lean +++ b/src/tests/VersoTests/InlineStringPositions.lean @@ -3,6 +3,7 @@ Copyright (c) 2023-2026 Lean FRO LLC. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Author: David Thrane Christiansen -/ +import Errata import Verso import Verso.Doc.Concrete.InlineString @@ -15,13 +16,13 @@ set_option pp.rawOnError true /-- info: Inline.concat #[Inline.text "Hello, ", Inline.emph #[Inline.bold #[Inline.text "emph"]]] : Inline Genre.none -/ -#guard_msgs in +#test_msgs in #check (inlines!"Hello, _*emph*_" : Inline .none) /-- info: Block.concat #[Block.para #[Inline.text "Hello, ", Inline.emph #[Inline.bold #[Inline.text "emph"]]]] : Block Genre.none -/ -#guard_msgs in +#test_msgs in #check (blocks!"Hello, _*emph*_" : Block .none) /-- @@ -77,5 +78,5 @@ info: Inline.concat #[Inline.text "a", Inline.linebreak "\n", Inline.text "b ", Inline.emph #[Inline.bold #[Inline.text "c"]]] : Inline Genre.none -/ -#guard_msgs in +#test_msgs in #check (inlines!"a\nb _*c*_" : Inline .none) diff --git a/src/tests/Tests/Integration/CodeContent.lean b/src/tests/VersoTests/Integration/CodeContent.lean similarity index 100% rename from src/tests/Tests/Integration/CodeContent.lean rename to src/tests/VersoTests/Integration/CodeContent.lean diff --git a/src/tests/Tests/Integration/DiagramDoc.lean b/src/tests/VersoTests/Integration/DiagramDoc.lean similarity index 100% rename from src/tests/Tests/Integration/DiagramDoc.lean rename to src/tests/VersoTests/Integration/DiagramDoc.lean diff --git a/src/tests/Tests/Integration/ExtraFilesDoc.lean b/src/tests/VersoTests/Integration/ExtraFilesDoc.lean similarity index 100% rename from src/tests/Tests/Integration/ExtraFilesDoc.lean rename to src/tests/VersoTests/Integration/ExtraFilesDoc.lean diff --git a/src/tests/Tests/Integration/FrontMatter.lean b/src/tests/VersoTests/Integration/FrontMatter.lean similarity index 100% rename from src/tests/Tests/Integration/FrontMatter.lean rename to src/tests/VersoTests/Integration/FrontMatter.lean diff --git a/src/tests/Tests/Integration/InheritanceDoc.lean b/src/tests/VersoTests/Integration/InheritanceDoc.lean similarity index 100% rename from src/tests/Tests/Integration/InheritanceDoc.lean rename to src/tests/VersoTests/Integration/InheritanceDoc.lean diff --git a/src/tests/Tests/Integration/LeanSection.lean b/src/tests/VersoTests/Integration/LeanSection.lean similarity index 100% rename from src/tests/Tests/Integration/LeanSection.lean rename to src/tests/VersoTests/Integration/LeanSection.lean diff --git a/src/tests/Tests/Integration/SampleDoc.lean b/src/tests/VersoTests/Integration/SampleDoc.lean similarity index 100% rename from src/tests/Tests/Integration/SampleDoc.lean rename to src/tests/VersoTests/Integration/SampleDoc.lean diff --git a/src/tests/Tests/LeanCode.lean b/src/tests/VersoTests/LeanCode.lean similarity index 97% rename from src/tests/Tests/LeanCode.lean rename to src/tests/VersoTests/LeanCode.lean index e431e5802..6a2417863 100644 --- a/src/tests/Tests/LeanCode.lean +++ b/src/tests/VersoTests/LeanCode.lean @@ -3,6 +3,7 @@ Copyright (c) 2025 Lean FRO LLC. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Author: Rob Simmons -/ +import Errata import VersoManual namespace Verso.LeanCodeTest set_option guard_msgs.diff true @@ -40,7 +41,7 @@ error: Unknown identifier `z` --- error: No error expected in code block, one occurred -/ -#guard_msgs in +#test_msgs in #docs (Genre.Manual) fail "Test" := ::::::: {lean}`z` @@ -69,7 +70,7 @@ info: (some (Verso.Genre.Manual.InlineLean.Inline.lean, [{"seq": {"tok": {"kind": {"operator": - {"occurrence": "«term_+_»-827", + {"occurrence": "«term_+_»-840", "name": ["term_+_"], "docs": "`a + b` computes the sum of `a` and `b`.\nThe meaning of this notation is type-dependent. \n\nConventions for notations in identifiers:\n\n * The recommended spelling of `+` in identifiers is `add`."}}, @@ -81,7 +82,7 @@ info: (some (Verso.Genre.Manual.InlineLean.Inline.lean, [{"seq": "content": "3"}}}]}}, []])) -/ -#guard_msgs in +#test_msgs in #eval match inspect.toPart.content[0]! with | .para x => match x[0]! with | .other code _ => Option.some (code.name, code.data) @@ -108,7 +109,7 @@ end -- In term like `(x : Nat) → String`, `x` is a named binder that doesn't appear in the body, -- but the metalanguage's unused variable linter should not re-fire on the info tree pushed -- by leanInline. -#guard_msgs in +#test_msgs in #docs (Genre.Manual) inlineNamedBinderType "Inline Named Binder Type" := ::::::: {lean}`(x : Nat) → String` diff --git a/src/tests/Tests/Linters.lean b/src/tests/VersoTests/Linters.lean similarity index 96% rename from src/tests/Tests/Linters.lean rename to src/tests/VersoTests/Linters.lean index 6c2258137..b26e46361 100644 --- a/src/tests/Tests/Linters.lean +++ b/src/tests/VersoTests/Linters.lean @@ -3,6 +3,7 @@ Copyright (c) 2026 Lean FRO LLC. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Author: David Thrane Christiansen -/ +import Errata import Verso import VersoManual @@ -18,7 +19,7 @@ set_option pp.rawOnError true /-! By default, it is off: straight quotes in text do not result in warnings. -/ -#guard_msgs in +#test_msgs in #docs (.none) quotesDefault "Quotes default" := ::::::: @@ -44,7 +45,7 @@ Hint: Replace with Unicode Note: This linter can be disabled with `set_option linter.typography.quotes false` -/ -#guard_msgs in +#test_msgs in set_option linter.typography.quotes true in #docs (.none) quotesOn "Quotes on" := ::::::: @@ -60,7 +61,7 @@ Say "hello" to the world. /-! By default, it is off: a triple dash in text does not produce a warning. -/ -#guard_msgs in +#test_msgs in #docs (.none) dashesDefault "Dashes default" := ::::::: @@ -79,7 +80,7 @@ Hint: Replace with Unicode Note: This linter can be disabled with `set_option linter.typography.dashes false` -/ -#guard_msgs in +#test_msgs in set_option linter.typography.dashes true in #docs (.none) dashesOn "Dashes on" := ::::::: @@ -102,7 +103,7 @@ Hint: Replace with Unicode Note: This linter can be disabled with `set_option linter.typography.dashes false` -/ -#guard_msgs in +#test_msgs in set_option linter.typography.dashes true in #docs (.none) typoDashesOnlyMixed "Dashes only mixed" := ::::::: @@ -126,7 +127,7 @@ Hint: Replace with Unicode Note: This linter can be disabled with `set_option linter.typography.quotes false` -/ -#guard_msgs in +#test_msgs in set_option linter.typography.quotes true in #docs (.none) typoQuotesOnlyMixed "Quotes only mixed" := ::::::: @@ -150,7 +151,7 @@ Hint: Use the minimal number of '_'s Note: This linter can be disabled with `set_option linter.verso.markup.emph false` -/ -#guard_msgs in +#test_msgs in #docs (.none) emphDefault "Emph default" := ::::::: @@ -161,7 +162,7 @@ This is __emphatic__ text. /-! When it is disabled, redundant `__` does not produce a warning. -/ -#guard_msgs in +#test_msgs in set_option linter.verso.markup.emph false in #docs (.none) emphOff "Emph off" := ::::::: @@ -185,7 +186,7 @@ Hint: Use the minimal number of '`'s Note: This linter can be disabled with `set_option linter.verso.markup.code false` -/ -#guard_msgs in +#test_msgs in #docs (.none) codeDefault "Code default" := ::::::: @@ -196,7 +197,7 @@ See ``foo`` for details. /-! When it is disabled, redundant inline-code backticks do not produce a warning. -/ -#guard_msgs in +#test_msgs in set_option linter.verso.markup.code false in #docs (.none) codeOff "Code off" := ::::::: @@ -222,7 +223,7 @@ Hint: Use the minimal number of '`'s Note: This linter can be disabled with `set_option linter.verso.markup.codeBlock false` -/ -#guard_msgs in +#test_msgs in #docs (.none) codeBlockDefault "Code block default" := ::::::: @@ -235,7 +236,7 @@ foo /-! When it is disabled, redundant code-block backticks do not produce a warning. -/ -#guard_msgs in +#test_msgs in set_option linter.verso.markup.codeBlock false in #docs (.none) codeBlockOff "Code block off" := ::::::: @@ -253,7 +254,7 @@ foo /-! By default, it is off: untagged headers do not produce a warning. -/ -#guard_msgs in +#test_msgs in #docs (Verso.Genre.Manual) headerTagsDefault "Header tags default" := ::::::: @@ -283,7 +284,7 @@ Note: The tag is used as a permanent name for the section or chapter. Writers of Note: This linter can be disabled with `set_option linter.verso.manual.headerTags false` -/ -#guard_msgs in +#test_msgs in set_option linter.verso.manual.headerTags true in #docs (Verso.Genre.Manual) headerTagsOn "Header tags on" := ::::::: diff --git a/src/tests/VersoTests/LzCompress.lean b/src/tests/VersoTests/LzCompress.lean new file mode 100644 index 000000000..b37594231 --- /dev/null +++ b/src/tests/VersoTests/LzCompress.lean @@ -0,0 +1,39 @@ +/- +Copyright (c) 2026 Lean FRO LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Author: David Thrane Christiansen +-/ +module + +public import VersoUtil.LzCompress +import Errata + +open Verso.LzCompress Errata + +/-- The LZ compressor produces the expected encoding for a sample Lean snippet. -/ +@[test] +def compresses : Test := do + let actual := lzCompress r#"import Mathlib.Logic.Basic -- basic facts in logic +-- theorems in Lean's mathematics library + +-- Let P and Q be true-false statements +variable (P Q : Prop) + +-- The following is a basic result in logic +example : ¬ (P ∧ Q) ↔ ¬ P ∨ ¬ Q := by + -- its proof is already in Lean's mathematics library + exact not_and_or + +-- Here is another basic result in logic +example : ¬ (P ∨ Q) ↔ ¬ P ∧ ¬ Q := by + apply? -- we can search for the proof in the library + -- we can also replace `apply?` with its output +"# + let expected := + "JYWwDg9gTgLgBAWQIYwBYBtgCMB0AZCAc2AGMcAhJAZ1LgFo64traAzJEmKuYAOznRFSAKAZw0AU2gSQ3" ++ + "PnDwSkvAOTcQKVDJSlumLFCRQAnsNGNF8AApxlAEzgBFJhPFQArhLrt0VV1RgUGQleLmEANyNgJCx0VwA" ++ + "KG2cALjgrKAgwAEozMQAVLThWCHRBAHc+Qh5uJCYWEjgoCSp3dHh5QWISYQkADyRwOLhUgBq4RLhAciIn" ++ + "LLhAFMI4MZtACiJFp2GAXiZTOHpGYC44MAyIVmrbdCakO2MefkVlNTgNSRfdAWxDE2Fdvo54XgQGAAfXs" ++ + "wOguUYAAkJE1zsogVooHUaA0mi02ncBEJun9Bq5RuMVjN5msbNMxiktlgdrYwGB0MYAPx7OBlVwkZRwPx" ++ + "GEioIrQcSFY4QU5YyQfAxGWlidlwTn8JC+CCNCQMjiuAAGSHpjKZmrZB35B24EHcMDA5uEQA" + assertEq expected actual diff --git a/src/tests/Tests/Method.lean b/src/tests/VersoTests/Method.lean similarity index 94% rename from src/tests/Tests/Method.lean rename to src/tests/VersoTests/Method.lean index df476c17f..3fca9a9e8 100644 --- a/src/tests/Tests/Method.lean +++ b/src/tests/VersoTests/Method.lean @@ -3,6 +3,7 @@ Copyright (c) 2026 Lean FRO LLC. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Author: David Thrane Christiansen -/ +import Errata import Verso.Method /-! ## Tests for defmethod macro -/ @@ -30,11 +31,11 @@ error: 'List' is ambiguous - found: A.B.C.List, _root_.List Please write a more specific namespace. -/ -#guard_msgs in +#test_msgs in defmethod List.wat (xs : List Nat) : Nat := 3 end Other /-- info: { field := 6 } -/ -#guard_msgs in +#test_msgs in #eval (A.B.C.D.mk 3).double diff --git a/src/tests/Tests/NestedTacticHtml.lean b/src/tests/VersoTests/NestedTacticHtml.lean similarity index 99% rename from src/tests/Tests/NestedTacticHtml.lean rename to src/tests/VersoTests/NestedTacticHtml.lean index cd361f572..58004c771 100644 --- a/src/tests/Tests/NestedTacticHtml.lean +++ b/src/tests/VersoTests/NestedTacticHtml.lean @@ -3,6 +3,7 @@ Copyright (c) 2026 Lean FRO LLC. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Author: David Thrane Christiansen -/ +import Errata import Verso import SubVerso.Highlighting.Code @@ -215,5 +216,5 @@ def checkElision : CommandElabM Unit := do if htmlHasRedundant (proofStates (renderBlock raw)) then throwError "the rendered HTML still nests a no-goals region inside a goal-ful one" -#guard_msgs in +#test_msgs in #eval checkElision diff --git a/src/tests/Tests/ParserRegression.lean b/src/tests/VersoTests/ParserRegression.lean similarity index 100% rename from src/tests/Tests/ParserRegression.lean rename to src/tests/VersoTests/ParserRegression.lean diff --git a/src/tests/Tests/Paths.lean b/src/tests/VersoTests/Paths.lean similarity index 85% rename from src/tests/Tests/Paths.lean rename to src/tests/VersoTests/Paths.lean index 3a56063b1..4578f230d 100644 --- a/src/tests/Tests/Paths.lean +++ b/src/tests/VersoTests/Paths.lean @@ -7,6 +7,7 @@ Author: David Thrane Christiansen module +import Errata import MultiVerso.Path set_option doc.verso true @@ -19,78 +20,78 @@ open Path -- TODO: adapt to module system. Right now, non-meta imports work in server, but not command line. /- /-- info: "/" -/ -#guard_msgs in +#test_msgs in #eval link #[] /-- info: "/a/b/" -/ -#guard_msgs in +#test_msgs in #eval link #["a", "b"] /-- info: "/a/b/#c" -/ -#guard_msgs in +#test_msgs in #eval link #["a", "b"] (htmlId := some "c") /- Tests for relativization. -/ /-- info: "a/b/c/" -/ -#guard_msgs in +#test_msgs in #eval Path.relativize #[] "/a/b/c/" /-- info: "a/b/c/#foo" -/ -#guard_msgs in +#test_msgs in #eval Path.relativize #[] "/a/b/c/#foo" /-- info: "a/b/c#foo" -/ -#guard_msgs in +#test_msgs in #eval Path.relativize #[] "/a/b/c#foo" /-- info: "b/c/" -/ -#guard_msgs in +#test_msgs in #eval Path.relativize #["a"] "/a/b/c/" /-- info: "b/c/#foo" -/ -#guard_msgs in +#test_msgs in #eval Path.relativize #["a"] "/a/b/c/#foo" /-- info: "b/c#foo" -/ -#guard_msgs in +#test_msgs in #eval Path.relativize #["a"] "/a/b/c#foo" /-- info: "c/" -/ -#guard_msgs in +#test_msgs in #eval Path.relativize #["a", "b"] "/a/b/c/" /-- info: "c/#foo" -/ -#guard_msgs in +#test_msgs in #eval Path.relativize #["a", "b"] "/a/b/c/#foo" /-- info: "c#foo" -/ -#guard_msgs in +#test_msgs in #eval Path.relativize #["a", "b"] "/a/b/c#foo" /-- info: "../../aa/b/c#foo" -/ -#guard_msgs in +#test_msgs in #eval Path.relativize #["a", "b"] "/aa/b/c#foo" /-- info: "../" -/ -#guard_msgs in +#test_msgs in #eval Path.relativize #["a", "b", "c", "d"] "/a/b/c/" /-- info: "../../c" -/ -#guard_msgs in +#test_msgs in #eval Path.relativize #["a", "b", "c", "d"] "/a/b/c" /-- info: "../#foo" -/ -#guard_msgs in +#test_msgs in #eval Path.relativize #["a", "b", "c", "d"] "/a/b/c/#foo" /-- info: "../../" -/ -#guard_msgs in +#test_msgs in #eval Path.relativize #["a", "b", "c", "d", "e"] "/a/b/c/" /-- info: "../../#foo" -/ -#guard_msgs in +#test_msgs in #eval Path.relativize #["a", "b", "c", "d", "e"] "/a/b/c/#foo" /-- info: "../../../c#foo" -/ -#guard_msgs in +#test_msgs in #eval Path.relativize #["a", "b", "c", "d", "e"] "/a/b/c#foo" /-- info: "../../../c" -/ -#guard_msgs in +#test_msgs in #eval Path.relativize #["a", "b", "c", "d", "e"] "/a/b/c" /-- info: "" -/ -#guard_msgs in +#test_msgs in #eval Path.relativize #[] "/" -/ diff --git a/src/tests/Tests/Refs.lean b/src/tests/VersoTests/Refs.lean similarity index 93% rename from src/tests/Tests/Refs.lean rename to src/tests/VersoTests/Refs.lean index 6da95723c..d6adce14f 100644 --- a/src/tests/Tests/Refs.lean +++ b/src/tests/VersoTests/Refs.lean @@ -3,6 +3,7 @@ Copyright (c) 2023 Lean FRO LLC. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Author: Rob Simmons -/ +import Errata import Verso namespace Verso.RefsTest set_option guard_msgs.diff true @@ -23,7 +24,7 @@ info: Verso.Doc.Part.mk Verso.Doc.Inline.link #[(Verso.Doc.Inline.text "a link")] "http://example.com"]] #[] -/ -#guard_msgs in +#test_msgs in #eval regularLink.toPart @@ -45,7 +46,7 @@ info: Verso.Doc.Part.mk Verso.Doc.Inline.link #[(Verso.Doc.Inline.text "a link")] "http://example.com"]] #[] -/ -#guard_msgs in +#test_msgs in #eval refLink.toPart @@ -67,7 +68,7 @@ info: Verso.Doc.Part.mk Verso.Doc.Inline.footnote "note" #[(Verso.Doc.Inline.text "The footnote text")], Verso.Doc.Inline.text "!"]] #[] -/ -#guard_msgs in +#test_msgs in #eval noteLink.toPart @@ -94,7 +95,7 @@ info: Verso.Doc.Part.mk Verso.Doc.Inline.footnote "note" #[(Verso.Doc.Inline.text "The footnote text")], Verso.Doc.Inline.text "!"]] #[] -/ -#guard_msgs in +#test_msgs in #eval refAndLink.toPart #docs (.none) refAndLink2 "Ref/link ordering" := @@ -123,13 +124,13 @@ Here's [a link][to here][^note]! ::::::: /-- info: true -/ -#guard_msgs in #eval refAndLink.toPart == refAndLink2.toPart +#test_msgs in #eval refAndLink.toPart == refAndLink2.toPart /-- info: true -/ -#guard_msgs in #eval refAndLink.toPart == refAndLink3.toPart +#test_msgs in #eval refAndLink.toPart == refAndLink3.toPart /-- info: true -/ -#guard_msgs in #eval refAndLink.toPart == refAndLink4.toPart +#test_msgs in #eval refAndLink.toPart == refAndLink4.toPart #docs (.none) refAndLinkRecursion "Ref/link recursion" := ::::::: @@ -161,13 +162,13 @@ info: Verso.Doc.Part.mk (Verso.Doc.Inline.text ".")]]] #[] -/ -#guard_msgs in +#test_msgs in #eval refAndLinkRecursion.toPart /-- error: Already defined link [foo] as 'https://example.com' -/ -#guard_msgs in +#test_msgs in #docs (.none) failDupLink "Fail" := ::::::: [foo]: https://example.com @@ -179,7 +180,7 @@ error: Already defined link [foo] as 'https://example.com' /-- error: Already defined footnote [^note] -/ -#guard_msgs in +#test_msgs in #docs (.none) failDupFoot "Fail" := ::::::: [^note]: Note @@ -192,7 +193,7 @@ There are no caveats.[^note] /-- error: Footnote reference [^bar] does not have a definition -/ -#guard_msgs in +#test_msgs in #docs (.none) failForwardRefFootnote "Fail" := ::::::: [^foo]: Disallowing forward reference in footnotes[^bar] @@ -205,7 +206,7 @@ And used[^bar] /-- error: Link reference [bar] does not have a definition -/ -#guard_msgs in +#test_msgs in #docs (.none) failForwardRefLink "Fail" := ::::::: [^foo]: Disallowing [forward reference in footnotes][bar] @@ -221,7 +222,7 @@ warning: Unused footnote [^hidden] --- warning: Unused footnote [^baz] -/ -#guard_msgs in +#test_msgs in #docs (.none) fail4 "Fail" := ::::::: [^baz]: Unused footnote @@ -232,7 +233,7 @@ warning: Unused footnote [^baz] /-- error: No definition for footnote [^caveat] -/ -#guard_msgs in +#test_msgs in #docs (.none) fail "Fail" := ::::::: There's no caveat.[^caveat] @@ -241,7 +242,7 @@ There's no caveat.[^caveat] /-- warning: Unused link [forlorn] -/ -#guard_msgs in +#test_msgs in #docs (.none) warnForlorn "Fail" := ::::::: [forlorn]: http://example.com @@ -250,7 +251,7 @@ warning: Unused link [forlorn] /-- error: No definition for link [fourOhFour] -/ -#guard_msgs in +#test_msgs in #docs (.none) failHangingLink "Fail" := ::::::: There's no [destination][fourOhFour] diff --git a/src/tests/VersoTests/Serialization.lean b/src/tests/VersoTests/Serialization.lean index 99a2aa3f5..10e46e420 100644 --- a/src/tests/VersoTests/Serialization.lean +++ b/src/tests/VersoTests/Serialization.lean @@ -4,13 +4,13 @@ Released under Apache 2.0 license as described in the file LICENSE. Author: David Thrane Christiansen Round-trip property tests for Verso's serialization. The generators and the `roundTripOk`/`isEqOk` -helpers live in `Tests.Serialization`; they construct Verso types whose constructors are private, so +helpers live in `VersoTests.SerializationGenerators`; they construct Verso types whose constructors are private, so they stay module-internal there and are reached here through `import all`. -/ module import Errata -import all Tests.Serialization +import all VersoTests.SerializationGenerators open Lean open Verso Multi diff --git a/src/tests/Tests/Serialization.lean b/src/tests/VersoTests/SerializationGenerators.lean similarity index 99% rename from src/tests/Tests/Serialization.lean rename to src/tests/VersoTests/SerializationGenerators.lean index e4f7eb8ab..d60dbab74 100644 --- a/src/tests/Tests/Serialization.lean +++ b/src/tests/VersoTests/SerializationGenerators.lean @@ -21,7 +21,7 @@ public import MultiVerso.Manifest public import VersoManual.Basic import all VersoManual.Basic import VersoManual.Html.CssFile -public import Tests.Arbitrary +public import VersoTests.Arbitrary open Lean open Plausible Gen Arbitrary diff --git a/src/tests/VersoTests/TeX.lean b/src/tests/VersoTests/TeX.lean index 5c7446a5e..0056720ee 100644 --- a/src/tests/VersoTests/TeX.lean +++ b/src/tests/VersoTests/TeX.lean @@ -2,73 +2,93 @@ Copyright (c) 2026 Lean FRO LLC. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Author: David Thrane Christiansen - -Golden tests for manual-genre TeX generation. This is a non-`module` file because `VersoManual` -and the integration document fixtures are not part of the module system; the Errata runner imports -it through its non-module main. -/ -import VersoManual -import Tests.Integration.SampleDoc -import Tests.Integration.InheritanceDoc -import Tests.Integration.CodeContent -import Tests.Integration.ExtraFilesDoc -import Tests.Integration.FrontMatter -import Tests.Integration.DiagramDoc import Errata +import Verso.Doc.TeX +import Verso.Output.TeX + +namespace Verso.Tests.TeX + +open Verso.Doc.TeX +open Verso.Output.TeX + +/-! ## Tests for escapeForVerbatim -/ + +/-- info: "\\symbol{123}\\symbol{124}\\symbol{125}\\symbol{92}" -/ +#test_msgs in +#eval escapeForVerbatim "{|}\\" + +-- Tests for lineBreaks functionality +/-- info: "Nat.\\allowbreak{}add\\-One" -/ +#test_msgs in +#eval escapeForVerbatim "Nat.addOne" (lineBreaks := true) + +/-- info: "List.\\allowbreak{}map2\\-Fun" -/ +#test_msgs in +#eval escapeForVerbatim "List.map2Fun" (lineBreaks := true) + +/-- info: "x2\\-y" -/ +#test_msgs in +#eval escapeForVerbatim "x2y" (lineBreaks := true) + +/-- info: "Foo123" -/ +#test_msgs in +#eval escapeForVerbatim "Foo123" (lineBreaks := true) -- no break before digits + +/-- info: "a..\\allowbreak{}b" -/ +#test_msgs in +#eval escapeForVerbatim "a..b" (lineBreaks := true) -- only one break after dot sequence + +/-- info: "\\symbol{123}foo\\-Bar" -/ +#test_msgs in +#eval escapeForVerbatim "{fooBar" (lineBreaks := true) -- escaping + line breaks + +/-- info: "plain" -/ +#test_msgs in +#eval escapeForVerbatim "plain" (lineBreaks := true) -- no transitions -open Verso Genre Manual -open Verso.Integration -open Errata +/-- info: "Nat.addOne" -/ +#test_msgs in +#eval escapeForVerbatim "Nat.addOne" -- lineBreaks := false (default), no breaks + +end Verso.Tests.TeX + +/-! ## Tests for TeX syntax macros -/ + +open scoped Verso.Output.TeX + +/-- info: Verso.Output.TeX.seq #[] -/ +#test_msgs in +#eval IO.println <| (repr <| \TeX{}).pretty 80 + +/-- info: Verso.Output.TeX.text "Hello, world!" -/ +#test_msgs in +#eval IO.println <| (repr <| \TeX{"Hello, world!"}).pretty 80 + +/-- +info: Verso.Output.TeX.command + "hyperlink" + #[] + #[Verso.Output.TeX.raw "foo", Verso.Output.TeX.text ""] +-/ +#test_msgs in +#eval IO.println <| (repr<| \TeX{\hyperlink{\Lean{.raw "foo" }}{\Lean{""}}}).pretty 80 + +/-- +info: Verso.Output.TeX.seq + #[Verso.Output.TeX.text "Hello, ", + Verso.Output.TeX.command "textbf" #[] #[Verso.Output.TeX.text "world"]] +-/ +#test_msgs in +#eval IO.println <| (repr <| \TeX{"Hello, " \textbf{"world"}}).pretty 80 /-- -Renders `doc` to TeX under `integration/<dir>/output`, checks the produced tree against the golden -`expected` tree, and, under `--check-tex`, confirms `lualatex` builds the result. The extra-file -lists place additional assets alongside the output, matching the document's expectations. +info: Verso.Output.TeX.environment + "Verbatim" + #[] + #[Verso.Output.TeX.raw "commandChars=\\\\"] + #[Verso.Output.TeX.text "Hello, ", + Verso.Output.TeX.command "textbf" #[] #[Verso.Output.TeX.text "world"]] -/ -def texGolden (dir : System.FilePath) (doc : Verso.Doc.VersoDoc Manual) - (extraFiles extraFilesTeX : List (System.FilePath × String) := []) : Test := do - let base : System.FilePath := "src/tests/integration" / dir - let output := base / "output" - if ← output.pathExists then IO.FS.removeDirAll output - let config : Manual.Config := - { destination := output, emitTeX := true, emitHtmlMulti := .no, extraFiles, extraFilesTeX } - let logger ← Verso.Logger.new - emitTeX config doc.toPart |>.run extension_impls% |>.run logger - goldenDir (base / "expected") output - if ← flag "check-tex" then - -- `-shell-escape` lets the `svg` package call Inkscape to rasterize `diagram` attachments. - let out ← IO.Process.output { - cwd := output / "tex" - cmd := "lualatex" - args := #["-shell-escape", "-halt-on-error", "-interaction=nonstopmode", "main.tex"] - } - unless out.exitCode == 0 do - failHere s!"lualatex exited with code {out.exitCode}" - (detail? := some (out.stdout ++ out.stderr)) - -/-- The sample document renders to its golden TeX. -/ -@[test] -def sampleDoc : Test := texGolden "sample-doc" SampleDoc.doc - -/-- A document using inheritance renders to its golden TeX. -/ -@[test] -def inheritanceDoc : Test := texGolden "inheritance-doc" InheritanceDoc.doc - -/-- A document exercising code content renders to its golden TeX. -/ -@[test] -def codeContentDoc : Test := texGolden "code-content-doc" CodeContent.doc - -/-- A document with extra bundled files renders to its golden TeX. -/ -@[test] -def extraFilesDoc : Test := - texGolden "extra-files-doc" ExtraFilesDoc.doc - (extraFiles := [("src/tests/integration/extra-files-doc/test-data/shared", "shared")]) - (extraFilesTeX := [("src/tests/integration/extra-files-doc/test-data/TeX-only", "TeX-only")]) - -/-- A document with front matter renders to its golden TeX. -/ -@[test] -def frontMatterDoc : Test := texGolden "front-matter-doc" FrontMatter.doc - -/-- A document with diagrams renders to its golden TeX. -/ -@[test] -def diagramDoc : Test := texGolden "diagram-doc" DiagramDoc.doc +#test_msgs in +#eval IO.println <| (repr <| \TeX{\begin{Verbatim}{s!"commandChars=\\\\"}"Hello, " \textbf{"world"}\end{Verbatim}}).pretty 80 diff --git a/src/tests/VersoTests/TeXGolden.lean b/src/tests/VersoTests/TeXGolden.lean new file mode 100644 index 000000000..87e4a985a --- /dev/null +++ b/src/tests/VersoTests/TeXGolden.lean @@ -0,0 +1,74 @@ +/- +Copyright (c) 2026 Lean FRO LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Author: David Thrane Christiansen + +Golden tests for manual-genre TeX generation. This is a non-`module` file because `VersoManual` +and the integration document fixtures are not part of the module system; the Errata runner imports +it through its non-module main. +-/ +import VersoManual +import VersoTests.Integration.SampleDoc +import VersoTests.Integration.InheritanceDoc +import VersoTests.Integration.CodeContent +import VersoTests.Integration.ExtraFilesDoc +import VersoTests.Integration.FrontMatter +import VersoTests.Integration.DiagramDoc +import Errata + +open Verso Genre Manual +open Verso.Integration +open Errata + +/-- +Renders `doc` to TeX under `integration/<dir>/output`, checks the produced tree against the golden +`expected` tree, and, under `--check-tex`, confirms `lualatex` builds the result. The extra-file +lists place additional assets alongside the output, matching the document's expectations. +-/ +def texGolden (dir : System.FilePath) (doc : Verso.Doc.VersoDoc Manual) + (extraFiles extraFilesTeX : List (System.FilePath × String) := []) : Test := do + let base : System.FilePath := "src/tests/integration" / dir + let output := base / "output" + if ← output.pathExists then IO.FS.removeDirAll output + let config : Manual.Config := + { destination := output, emitTeX := true, emitHtmlMulti := .no, extraFiles, extraFilesTeX } + let logger ← Verso.Logger.new + emitTeX config doc.toPart |>.run extension_impls% |>.run logger + goldenDir (base / "expected") output + if ← flag "check-tex" then + -- `-shell-escape` lets the `svg` package call Inkscape to rasterize `diagram` attachments. + let out ← IO.Process.output { + cwd := output / "tex" + cmd := "lualatex" + args := #["-shell-escape", "-halt-on-error", "-interaction=nonstopmode", "main.tex"] + } + unless out.exitCode == 0 do + failHere s!"lualatex exited with code {out.exitCode}" + (detail? := some (out.stdout ++ out.stderr)) + +/-- The sample document renders to its golden TeX. -/ +@[test] +def sampleDoc : Test := texGolden "sample-doc" SampleDoc.doc + +/-- A document using inheritance renders to its golden TeX. -/ +@[test] +def inheritanceDoc : Test := texGolden "inheritance-doc" InheritanceDoc.doc + +/-- A document exercising code content renders to its golden TeX. -/ +@[test] +def codeContentDoc : Test := texGolden "code-content-doc" CodeContent.doc + +/-- A document with extra bundled files renders to its golden TeX. -/ +@[test] +def extraFilesDoc : Test := + texGolden "extra-files-doc" ExtraFilesDoc.doc + (extraFiles := [("src/tests/integration/extra-files-doc/test-data/shared", "shared")]) + (extraFilesTeX := [("src/tests/integration/extra-files-doc/test-data/TeX-only", "TeX-only")]) + +/-- A document with front matter renders to its golden TeX. -/ +@[test] +def frontMatterDoc : Test := texGolden "front-matter-doc" FrontMatter.doc + +/-- A document with diagrams renders to its golden TeX. -/ +@[test] +def diagramDoc : Test := texGolden "diagram-doc" DiagramDoc.doc diff --git a/src/tests/Tests/TexUnit.lean b/src/tests/VersoTests/TexUnit.lean similarity index 91% rename from src/tests/Tests/TexUnit.lean rename to src/tests/VersoTests/TexUnit.lean index 8c508ffc1..7df6361da 100644 --- a/src/tests/Tests/TexUnit.lean +++ b/src/tests/VersoTests/TexUnit.lean @@ -3,7 +3,8 @@ Copyright (c) 2025 Lean FRO LLC. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Author: Jason Reed -/ -import Tests.TexUtil +import Errata +import VersoTests.TexUtil /-! Unit tests covering TeX output given given concrete Verso structures. @@ -12,7 +13,7 @@ Unit tests covering TeX output given given concrete Verso structures. open Verso Genre.Manual /-- info: before\LeanVerb|verb|after -/ -#guard_msgs in +#test_msgs in #eval do let b : Doc.Block Genre.Manual := .concat #[ .para #[ @@ -24,7 +25,7 @@ open Verso Genre.Manual IO.println (← toTex b).asString /-- info: before\LeanVerb|verb|after -/ -#guard_msgs in +#test_msgs in #eval do let b : Doc.Block Genre.Manual := .concat #[ .para #[ diff --git a/src/tests/Tests/TexUtil.lean b/src/tests/VersoTests/TexUtil.lean similarity index 100% rename from src/tests/Tests/TexUtil.lean rename to src/tests/VersoTests/TexUtil.lean diff --git a/src/tests/VersoTests/VersoManual.lean b/src/tests/VersoTests/VersoManual.lean new file mode 100644 index 000000000..1de68a725 --- /dev/null +++ b/src/tests/VersoTests/VersoManual.lean @@ -0,0 +1,10 @@ +/- +Copyright (c) 2025 Lean FRO LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Author: David Thrane Christiansen +-/ +import VersoTests.VersoManual.Html +import VersoTests.VersoManual.Html.SoftHyphenate +import VersoTests.VersoManual.License +import VersoTests.VersoManual.Markdown +import VersoTests.VersoManual.WordCount diff --git a/src/tests/Tests/VersoManual/Html.lean b/src/tests/VersoTests/VersoManual/Html.lean similarity index 99% rename from src/tests/Tests/VersoManual/Html.lean rename to src/tests/VersoTests/VersoManual/Html.lean index d54bc4ae8..32d0797e4 100644 --- a/src/tests/Tests/VersoManual/Html.lean +++ b/src/tests/VersoTests/VersoManual/Html.lean @@ -3,6 +3,7 @@ Copyright (c) 2024-2025 Lean FRO LLC. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Author: David Thrane Christiansen -/ +import Errata import VersoManual.Html namespace Verso.Genre.Manual.Html @@ -95,7 +96,7 @@ Expected #[D], seeing #[D] Next: none Done -/ -#guard_msgs in +#test_msgs in #eval show IO Unit from do let mut here : Zipper := ⟨[], testToc⟩ let spec := testToc.preorder diff --git a/src/tests/Tests/VersoManual/Html/SoftHyphenate.lean b/src/tests/VersoTests/VersoManual/Html/SoftHyphenate.lean similarity index 93% rename from src/tests/Tests/VersoManual/Html/SoftHyphenate.lean rename to src/tests/VersoTests/VersoManual/Html/SoftHyphenate.lean index df1947cf5..4e88ddb3d 100644 --- a/src/tests/Tests/VersoManual/Html/SoftHyphenate.lean +++ b/src/tests/VersoTests/VersoManual/Html/SoftHyphenate.lean @@ -4,30 +4,31 @@ Released under Apache 2.0 license as described in the file LICENSE. Author: David Thrane Christiansen -/ +import Errata import VersoManual.Html.SoftHyphenate open Verso.Genre.Manual /-- info: "blahNotCode<code><a>foo­Bar­Baz</a></code>" -/ -#guard_msgs in +#test_msgs in open Verso.Output Html in #eval softHyphenateIdentifiers {{"blahNotCode"<code><a>"fooBarBaz"</a></code>}} |>.asString /-- info: "<code>abc.<wbr>def.<wbr>ghi.<wbr>jkl</code>" -/ -#guard_msgs in +#test_msgs in open Verso.Output Html in #eval softHyphenateIdentifiers {{<code>"abc.def.ghi.jkl"</code>}} |>.asString /-- info: "<code>ABC.<wbr>DEF</code>" -/ -#guard_msgs in +#test_msgs in open Verso.Output Html in #eval softHyphenateIdentifiers {{<code>"ABC.DEF"</code>}} |>.asString /-- info: "blahNotCode<code><a>fooBa.<wbr>rBaz.<wbr>ab­CD</a></code>" -/ -#guard_msgs in +#test_msgs in open Verso.Output Html in #eval softHyphenateIdentifiers {{"blahNotCode"<code><a>"fooBa.rBaz.abCD"</a></code>}} |>.asString /-- info: "blahNotCode<code><a>fooBa...<wbr>rBaz.<wbr>ab­CD</a></code>" -/ -#guard_msgs in +#test_msgs in open Verso.Output Html in #eval softHyphenateIdentifiers {{"blahNotCode"<code><a>"fooBa...rBaz.abCD"</a></code>}} |>.asString diff --git a/src/tests/Tests/VersoManual/License.lean b/src/tests/VersoTests/VersoManual/License.lean similarity index 94% rename from src/tests/Tests/VersoManual/License.lean rename to src/tests/VersoTests/VersoManual/License.lean index 2f31bd587..c03d7af14 100644 --- a/src/tests/Tests/VersoManual/License.lean +++ b/src/tests/VersoTests/VersoManual/License.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Author: David Thrane Christiansen -/ module +import Errata meta import all VersoManual.License namespace Verso.Tests.VersoManual.License @@ -13,7 +14,7 @@ open Verso.Genre.Manual /-! ## Tests for paragraphed function -/ /-- info: #["One paragraph with lines", "and another", "and more more"] -/ -#guard_msgs in +#test_msgs in #eval paragraphed r#" One paragraph diff --git a/src/tests/Tests/VersoManual/Markdown.lean b/src/tests/VersoTests/VersoManual/Markdown.lean similarity index 98% rename from src/tests/Tests/VersoManual/Markdown.lean rename to src/tests/VersoTests/VersoManual/Markdown.lean index badbae884..e93137656 100644 --- a/src/tests/Tests/VersoManual/Markdown.lean +++ b/src/tests/VersoTests/VersoManual/Markdown.lean @@ -3,6 +3,7 @@ Copyright (c) 2024-2025 Lean FRO LLC. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Author: David Thrane Christiansen -/ +import Errata import VersoManual.Markdown import Verso.Doc.Elab.Monad import Lean.Elab.Term @@ -76,7 +77,7 @@ def markdownPartRangesValid (input : String) : Elab.TermElabM Bool := do return part.partContext.priorParts.all partRangesValid /-- info: true -/ -#guard_msgs in +#test_msgs in #eval markdownPartRangesValid r#" # Acknowledgements ## Contributors @@ -96,7 +97,7 @@ info: # another header ## one more -/ -#guard_msgs in +#test_msgs in /- Exercises how inconsistent Markdown header nesting depth is heuristically fixed. -/ #eval do diff --git a/src/tests/Tests/VersoManual/WordCount.lean b/src/tests/VersoTests/VersoManual/WordCount.lean similarity index 85% rename from src/tests/Tests/VersoManual/WordCount.lean rename to src/tests/VersoTests/VersoManual/WordCount.lean index 48890791a..90679271d 100644 --- a/src/tests/Tests/VersoManual/WordCount.lean +++ b/src/tests/VersoTests/VersoManual/WordCount.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Author: David Thrane Christiansen -/ module +import Errata meta import all VersoManual.WordCount namespace Verso.Tests.VersoManual.WordCount @@ -13,32 +14,32 @@ open Verso.Genre.Manual.WordCount /-! ## Tests for countWords function -/ /-- info: 4 -/ -#guard_msgs in +#test_msgs in #eval countWords (fun _ => false) "a b c d" /-- info: 4 -/ -#guard_msgs in +#test_msgs in #eval countWords (fun _ => false) "a b c d" /-- info: 4 -/ -#guard_msgs in +#test_msgs in #eval countWords (fun _ => false) " a b c d" /-! ## Tests for separatedNumber function -/ /-- info: "0" -/ -#guard_msgs in +#test_msgs in #eval separatedNumber 0 /-- info: "55" -/ -#guard_msgs in +#test_msgs in #eval separatedNumber 55 /-- info: "555" -/ -#guard_msgs in +#test_msgs in #eval separatedNumber 555 /-- info: "51,535" -/ -#guard_msgs in +#test_msgs in #eval separatedNumber 51535 /-- info: "8,813,251,535" -/ -#guard_msgs in +#test_msgs in #eval separatedNumber 8813251535 /-- info: "4,002" -/ -#guard_msgs in +#test_msgs in #eval separatedNumber 4002 diff --git a/src/tests/Tests/Z85.lean b/src/tests/VersoTests/Z85.lean similarity index 98% rename from src/tests/Tests/Z85.lean rename to src/tests/VersoTests/Z85.lean index e5b81156f..a35b63868 100644 --- a/src/tests/Tests/Z85.lean +++ b/src/tests/VersoTests/Z85.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Author: David Thrane Christiansen -/ +import Errata import VersoUtil.BinFiles.Z85 open Verso.BinFiles.Z85 @@ -71,7 +72,7 @@ Encoded: nm=QNzY&b1A+]nf Decoded: [72, 101, 108, 108, 111, 32, 87, 111, 114, 108, 100, 33] Round trip successful: true -/ -#guard_msgs in +#test_msgs in #eval test end Test From bcf4d0d6a4d10d850d35aae425fc41ebca2cd367 Mon Sep 17 00:00:00 2001 From: David Thrane Christiansen <david@davidchristiansen.dk> Date: Thu, 25 Jun 2026 00:22:42 +0200 Subject: [PATCH 08/26] Show on GH --- .github/workflows/ci.yml | 29 ++++++++++++++++++++++++- src/errata-tests/ErrataTests.lean | 12 +++++++++++ src/errata/Errata/Report.lean | 35 +++++++++++++++++++++++++++++++ src/errata/Errata/Runner.lean | 6 ++++++ src/errata/Errata/usage.txt | 1 + 5 files changed, 82 insertions(+), 1 deletion(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 82a9a4976..86e43a589 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -13,6 +13,9 @@ jobs: build: name: Build and test runs-on: nscloud-ubuntu-22.04-amd64-8x16 + permissions: + contents: read + checks: write env: # Used for browser tests. Placing them here allows caching to work right. PLAYWRIGHT_BROWSERS_PATH: ${{ github.workspace }}/.playwright-browsers @@ -90,7 +93,31 @@ jobs: - name: Run tests run: | - lake test -- --verbose --check-tex + lake test -- --verbose --check-tex --junit=errata-report.xml --markdown=errata-summary.md + + - name: Add test results to the job summary + if: always() + run: | + if [ -f errata-summary.md ]; then cat errata-summary.md >> "$GITHUB_STEP_SUMMARY"; fi + + - name: Publish the JUnit test report + if: always() + uses: dorny/test-reporter@v1 + with: + name: Errata tests + path: errata-report.xml + reporter: java-junit + fail-on-error: false + + - name: Upload the raw test reports + if: always() + uses: actions/upload-artifact@v4 + with: + name: errata-test-reports + path: | + errata-report.xml + errata-summary.md + if-no-files-found: ignore - name: Generate the test website run: | diff --git a/src/errata-tests/ErrataTests.lean b/src/errata-tests/ErrataTests.lean index e8a526362..57be99cfd 100644 --- a/src/errata-tests/ErrataTests.lean +++ b/src/errata-tests/ErrataTests.lean @@ -140,3 +140,15 @@ def reportFailureCount : Test := do let fail : Result := { package := "p", moduleName := "M", test := "u", status := .fail { message := "x" } } let err : Result := { package := "p", moduleName := "M", test := "v", status := .error "oops" } assertEq 2 (← humanReport .silent #[pass, fail, err]) + +/-- `markdownReport` gives a tally, an open collapsible per failure, and a per-module table. -/ +@[test] +def reportMarkdown : Test := do + let pass : Result := { package := "p", moduleName := "M", test := "t", status := .pass } + let f : TestFailure := { message := "boom", detail? := some "expected 1\nactual 2" } + let fail : Result := { package := "p", moduleName := "M", test := "u", status := .fail f } + let md := markdownReport #[pass, fail] + assertContains "**1** passed · **1** failed" md + assertContains "<details open><summary>❌ <code>p/M</code> u: boom</summary>" md + assertContains "expected 1\nactual 2" md + assertContains "Summary by module" md diff --git a/src/errata/Errata/Report.lean b/src/errata/Errata/Report.lean index 389b22cc0..2da6f6993 100644 --- a/src/errata/Errata/Report.lean +++ b/src/errata/Errata/Report.lean @@ -240,3 +240,38 @@ instance : FromJson Result where /-- Renders the results as a JSON array of objects. -/ def jsonReport (results : Array Result) : String := (ToJson.toJson results).pretty + +/-- +Renders the results as Markdown for a CI job summary: a headline tally, each failure and error in an +open collapsible block with its location and detail, and a per-module table in a closed one. +-/ +def markdownReport (results : Array Result) : String := Id.run do + let passed := countWhere results (· matches .pass) + let failed := countWhere results (· matches .fail _) + let errored := countWhere results (· matches .error _) + let skipped := countWhere results (· matches .skip _) + let icon := if failed + errored == 0 then "✅" else "❌" + let mut out := s!"## {icon} Errata test results\n\n" + out := out ++ + s!"**{passed}** passed · **{failed}** failed · **{errored}** errored · **{skipped}** skipped\n\n" + for r in results do + let render (mark message : String) (detail? : Option String) : String := Id.run do + let mut s := s!"<details open><summary>{mark} <code>{xmlEscape r.moduleTarget}</code> \ + {xmlEscape r.testName}: {xmlEscape message}</summary>\n\n" + if let .fail f := r.status then + if let some l := f.location? then s := s ++ s!"`{locationText l}`\n\n" + if let some d := detail? then s := s ++ s!"```\n{d}\n```\n\n" + unless r.output.isEmpty do + s := s ++ s!"<details><summary>output</summary>\n\n```\n{r.output.all}\n```\n\n</details>\n\n" + return s ++ "</details>\n\n" + match r.status with + | .fail f => out := out ++ render "❌" f.message f.detail? + | .error m => out := out ++ render "💥" m none + | _ => pure () + out := out ++ "<details><summary>Summary by module</summary>\n\n" + out := out ++ "| Module | ✅ | ❌ | 💥 | ⏭️ |\n| :-- | --: | --: | --: | --: |\n" + for m in results.toList.map suiteOf |>.eraseDups do + let cs := results.filter (suiteOf · == m) + out := out ++ s!"| {m} | {countWhere cs (· matches .pass)} | {countWhere cs (· matches .fail _)} \ + | {countWhere cs (· matches .error _)} | {countWhere cs (· matches .skip _)} |\n" + return out ++ "\n</details>\n" diff --git a/src/errata/Errata/Runner.lean b/src/errata/Errata/Runner.lean index 8eee43a92..707d751bf 100644 --- a/src/errata/Errata/Runner.lean +++ b/src/errata/Errata/Runner.lean @@ -81,6 +81,8 @@ structure Options where junitPath : Option String := none /-- Writes a JSON report to this path. -/ jsonPath : Option String := none + /-- Writes a Markdown report to this path. -/ + markdownPath : Option String := none /-- Project-specific options, as a multi-map so repeated options accumulate. -/ options : OptionMap := {} /-- Prints usage information instead of running the tests. -/ @@ -138,6 +140,9 @@ def parseArgs (args : List String) : Except String Options := do | "json" => if value.isEmpty then throw "--json expects a path" opts := { opts with jsonPath := some value } + | "markdown" => + if value.isEmpty then throw "--markdown expects a path" + opts := { opts with markdownPath := some value } | "help" | "h" => opts := { opts with help := true } | _ => let prev := opts.options.getD name #[] @@ -164,6 +169,7 @@ def runMain (entries : Array TestEntry) (args : List String) : IO UInt32 := do let results ← run cfg entries if let some path := opts.junitPath then IO.FS.writeFile path (junitReport results) if let some path := opts.jsonPath then IO.FS.writeFile path (jsonReport results) + if let some path := opts.markdownPath then IO.FS.writeFile path (markdownReport results) let failures ← humanReport opts.verbosity results -- Warn about options that were supplied but never read by any test (typos, removed flags). let used ← cfg.usedOptions.get diff --git a/src/errata/Errata/usage.txt b/src/errata/Errata/usage.txt index 4b850df28..ac53959a2 100644 --- a/src/errata/Errata/usage.txt +++ b/src/errata/Errata/usage.txt @@ -11,6 +11,7 @@ Modules use Lake target syntax. Runner options: --seed N Seed property tests with N, to reproduce a failure. --junit PATH Write a JUnit XML report to PATH. --json PATH Write a JSON report to PATH. + --markdown PATH Write a Markdown report (for a CI job summary) to PATH. -h, --help Show this help and exit. Any other `--name value` option is passed through to the tests. From fb450c7447f5b185d930fd0383f97d3a6f804981 Mon Sep 17 00:00:00 2001 From: David Thrane Christiansen <david@davidchristiansen.dk> Date: Thu, 25 Jun 2026 01:49:44 +0200 Subject: [PATCH 09/26] invalidation --- .github/workflows/test-imports.yml | 47 ------------------------------ lakefile.lean | 22 ++++++++++---- 2 files changed, 17 insertions(+), 52 deletions(-) delete mode 100644 .github/workflows/test-imports.yml diff --git a/.github/workflows/test-imports.yml b/.github/workflows/test-imports.yml deleted file mode 100644 index 85c778c5c..000000000 --- a/.github/workflows/test-imports.yml +++ /dev/null @@ -1,47 +0,0 @@ -name: All test modules imported - -on: [pull_request, merge_group] - -jobs: - check-test-imports: - name: "Check all test modules are imported" - runs-on: ubuntu-latest - steps: - - uses: actions/checkout@v7 - - - name: Check all test modules are transitively imported - run: | - # Convert file paths to module names and check imports - # e.g., src/tests/Tests/Html.lean -> Tests.Html - MISSING=() - while IFS= read -r -d '' file; do - # Convert path to module name - module=$(echo "$file" | sed 's|^src/tests/||; s|\.lean$||; s|/|.|g') - - # Check if this module is imported (directly or transitively) - # by searching for it in Tests.lean or any intermediate import file - if grep -rq "import $module" src/tests/; then - : # Module is imported, continue - else - # Check if it might be imported via a parent module - # e.g., Tests.VersoManual.Html is imported if Tests.VersoManual imports it - parent_dir=$(dirname "$file") - parent_file="$parent_dir.lean" - - if [ -f "$parent_file" ] && grep -q "import $module" "$parent_file"; then - : # Imported via parent - else - MISSING+=("$module") - fi - fi - done < <(find src/tests/Tests -name "*.lean" -print0 | sort -z) - - if [ ${#MISSING[@]} -gt 0 ]; then - echo "The following test modules are not transitively imported by the test suite:" - printf '%s\n' "${MISSING[@]}" - echo "" - echo "Please add them to src/tests/Tests.lean or an appropriate intermediate import file." - exit 1 - else - echo "All test modules are transitively imported by the test suite." - fi diff --git a/lakefile.lean b/lakefile.lean index a86c0a008..a739d7eef 100644 --- a/lakefile.lean +++ b/lakefile.lean @@ -147,16 +147,24 @@ lean_lib VersoTests where roots := #[`VersoTests] globs := #[Glob.andSubmodules `VersoTests] +-- The selected test set, written by the driver. The generated targets depend on it, so changing +-- the selection changes their trace and Lake rebuilds them rather than relinking a stale object. +input_file errataSelection where + text := true + path := ".lake/errata-runner/selection" + -- The generated discovered-tests module (`allTests`), written by the Errata driver. lean_lib ErrataGenerated where srcDir := ".lake/errata-runner" roots := #[`ErrataDiscovered] + needs := #[errataSelection] -- The generated, discovered test runner. Its source is written by the Errata test driver. lean_exe «errata-runner» where root := `ErrataRunnerMain srcDir := ".lake/errata-runner" supportInterpreter := true + needs := #[errataSelection] /-- Whether a source file introduces Errata tests, by an `@[test]` attribute or a `#test_msgs` command, the only two ways a test enters a module. -/ @@ -179,9 +187,10 @@ private def errataDiscoveredSource (packageName : String) (mods : Array Lean.Nam /-- Generate the non-module main: import the bridge module and the non-module test modules (which a `module` cannot import), then run their combined tests. -/ -private def errataMainSource (packageName : String) (mods : Array Lean.Name) : String := +private def errataMainSource (packageName : String) (mods : Array Lean.Name) (discovered : Lean.Name) : + String := let imports := "\n".intercalate - ("import Errata" :: "import ErrataDiscovered" :: mods.toList.map (s!"import {·}")) + ("import Errata" :: s!"import {discovered}" :: mods.toList.map (s!"import {·}")) let modList := " ".intercalate (mods.toList.map (·.toString)) s!"{imports}\n\n\ def main (args : List String) : IO UInt32 :=\n \ @@ -296,12 +305,15 @@ script «errata-test» (args) do if errataSourceHasTests lines then if errataSourceIsModule lines then moduleMods := moduleMods.push moduleName else nonModuleMods := nonModuleMods.push moduleName - -- Write the two generated sources, only when they change, so the build is reused across runs. + -- Write the generated sources, plus a `selection` file naming the chosen test set. The generated + -- targets depend on that file, so a changed selection invalidates them through Lake's own trace. let dir := ws.root.dir / ".lake" / "errata-runner" IO.FS.createDirAll dir + let selection := "\n".intercalate ((moduleMods ++ nonModuleMods).map (·.toString) |>.qsort (· < ·)).toList for (name, src) in - [("ErrataDiscovered.lean", errataDiscoveredSource ws.root.prettyName moduleMods), - ("ErrataRunnerMain.lean", errataMainSource ws.root.prettyName nonModuleMods)] do + [("selection", selection ++ "\n"), + ("ErrataDiscovered.lean", errataDiscoveredSource ws.root.prettyName moduleMods), + ("ErrataRunnerMain.lean", errataMainSource ws.root.prettyName nonModuleMods `ErrataDiscovered)] do let file := dir / name let changed ← if ← file.pathExists then pure ((← IO.FS.readFile file) != src) else pure true if changed then IO.FS.writeFile file src From 34fe6f6c04dc3ea2a506f23a3d20ab3e3b67e221 Mon Sep 17 00:00:00 2001 From: David Thrane Christiansen <david@davidchristiansen.dk> Date: Thu, 25 Jun 2026 11:02:53 +0200 Subject: [PATCH 10/26] review --- lakefile.lean | 14 +- src/errata/Errata/CompileTime.lean | 56 ++++++++ src/errata/Errata/Context.lean | 4 +- src/errata/Errata/Process.lean | 4 +- src/errata/Errata/Property.lean | 2 +- src/errata/Errata/Report.lean | 14 +- src/errata/Errata/Runner.lean | 12 +- src/errata/Errata/usage.txt | 1 + src/tests/VersoTests/Blog.lean | 51 +++++++ .../VersoTests/DocElabExtensions/Use.lean | 4 +- .../VersoTests/InlineStringPositions.lean | 14 +- src/tests/VersoTests/PorterStemmer.lean | 125 ++++++++++++++++++ src/tests/VersoTests/SetupLiterate.lean | 15 +-- src/tests/VersoTests/TeXGolden.lean | 4 +- src/tests/VersoTests/Zip.lean | 5 +- 15 files changed, 282 insertions(+), 43 deletions(-) create mode 100644 src/tests/VersoTests/PorterStemmer.lean diff --git a/lakefile.lean b/lakefile.lean index a739d7eef..baeda6c65 100644 --- a/lakefile.lean +++ b/lakefile.lean @@ -238,11 +238,11 @@ private def errataModuleOfPath (srcDir path : System.FilePath) : Option Lean.Nam some (".".intercalate comps).toName /-- -Warns about modules that define `@[test]` tests but whose library's globs do not cover them, so -the tests would be silently undiscovered. A module within a library's root that is not matched by -the library's globs, in a file mentioning `@[test]`, is the signal. +Reports modules that define `@[test]` tests but whose library's globs do not cover them, so the +tests would be silently undiscovered, and returns them. A module within a library's root that is not +matched by the library's globs, in a file mentioning `@[test]`, is the signal. -/ -private def errataWarnUncovered (ws : Lake.Workspace) : IO Unit := do +private def errataUncoveredTestModules (ws : Lake.Workspace) : IO (Array Lean.Name) := do let mut missed : Array Lean.Name := #[] for lib in ws.root.leanLibs do if lib.name == `ErrataGenerated then continue @@ -256,11 +256,12 @@ private def errataWarnUncovered (ws : Lake.Workspace) : IO Unit := do if lines.any (fun line => line.trimAsciiStart.copy.startsWith "@[test]") then missed := missed.push mod unless missed.isEmpty do - IO.eprintln "warning: these modules define @[test] tests but their library's globs do not cover \ + IO.eprintln "error: these modules define @[test] tests but their library's globs do not cover \ them, so the tests are not discovered. Widen the library's `globs` \ (e.g. `globs := #[Glob.andSubmodules `Root]`):" for mod in missed do IO.eprintln s!" {mod}" + return missed @[test_driver] script «errata-test» (args) do @@ -294,7 +295,8 @@ script «errata-test» (args) do unless allNames.any (fun n => n.toString == spec || n.toString.startsWith (spec ++ ".")) do IO.eprintln s!"error: no module matches '{spec}'" return 1 - errataWarnUncovered ws + -- Uncovered @[test] modules are a configuration error: fail rather than run an incomplete suite. + unless (← errataUncoveredTestModules ws).isEmpty do return 1 -- A test module is a selected one whose source introduces tests. Module-system test modules go in -- the bridge module (`import all`); non-module ones can only be imported by the non-module main. let mut moduleMods : Array Lean.Name := #[] diff --git a/src/errata/Errata/CompileTime.lean b/src/errata/Errata/CompileTime.lean index b975b5839..b29cab4ca 100644 --- a/src/errata/Errata/CompileTime.lean +++ b/src/errata/Errata/CompileTime.lean @@ -79,3 +79,59 @@ meta def elabTestMsgs : Command.CommandElab else logWarningAt tk (body ++ hint) | _ => throwUnsupportedSyntax + +/-- Checks that a Boolean expression evaluates to {lean}`true`, registering the verdict as a test. -/ +syntax (name := testGuardCmd) "#test_guard" term : command + +@[command_elab testGuardCmd] +meta def elabTestGuard : Command.CommandElab + | `(#test_guard%$tk $e:term) => do + -- Evaluate the expression to a `Bool` at elaboration time, as `#guard` does. + let passed ← Command.liftTermElabM do + let v ← Term.elabTermEnsuringType e (mkConst ``Bool) + Term.synthesizeSyntheticMVarsNoPostponing + let v ← instantiateMVars v + let mvars ← Lean.Meta.getMVars v + if mvars.isEmpty then + unsafe Lean.Meta.evalExpr (checkMeta := false) Bool (mkConst ``Bool) v + else + discard <| Term.logUnassignedUsingErrorInfos mvars + pure false + -- The checked expression's source text and span, for naming, location, and detail. + let fileMap ← getFileMap + let startStr := e.raw.getPos?.getD 0 + let endStr := e.raw.getTailPos?.getD startStr + let source := ({ str := fileMap.source, startPos := startStr, stopPos := endStr } : Substring.Raw).toString + let startPos := fileMap.toPosition startStr + let endPos := fileMap.toPosition endStr + -- Name the test after the first line of the expression, in the current namespace, marking a + -- truncated multi-line expression with an ellipsis and disambiguating against earlier ones. + let lines := source.splitOn "\n" + -- Strip guillemets so an escaped name in the source does not nest inside the test's own name. + let firstLine := (((lines.headD source).trimAscii.copy).replace "«" "").replace "»" "" + let base := + if (lines.drop 1).any (fun l => !l.trimAscii.copy.isEmpty) then firstLine ++ "…" else firstLine + let ns ← getCurrNamespace + let env ← getEnv + let mut name := base + let mut n := 1 + while env.contains (ns ++ Name.mkSimple name) do + n := n + 1 + name := s!"{base} ({n})" + let verdict ← + if passed then + `(Errata.TestResult.pass) + else + `(Errata.TestResult.mismatch "expression did not evaluate to `true`" $(quote source) + $(quote (← getFileName)) + $(quote startPos.line) $(quote startPos.column) + $(quote endPos.line) $(quote endPos.column)) + elabCommand (← `(@[test] def $(mkIdent (Name.mkSimple name)) : Errata.TestResult := $verdict)) + -- Report a failure at build time, as `#test_msgs` does. + unless passed do + let body := m!"Errata #test_guard: the expression did not evaluate to `true`:\n{source}" + if (← getOptions).getBool `Errata.failOnError false then + logErrorAt tk body + else + logWarningAt tk body + | _ => throwUnsupportedSyntax diff --git a/src/errata/Errata/Context.lean b/src/errata/Errata/Context.lean index 9d96e4848..b8f2db2e9 100644 --- a/src/errata/Errata/Context.lean +++ b/src/errata/Errata/Context.lean @@ -29,8 +29,8 @@ structure Context where updateGolden : Bool := false /-- Project-specific options, as a multi-map so repeated options accumulate. -/ options : OptionMap := {} - /-- The seed used for property tests. -/ - seed : Nat := 0 + /-- The seed used for property tests, or {lean}`none` to draw a fresh one. -/ + seed : Option Nat := none /-- The package that defines the running test. -/ package : String := "" /-- The module that defines the running test, as a dotted name. -/ diff --git a/src/errata/Errata/Process.lean b/src/errata/Errata/Process.lean index 5f72f7460..4209e3221 100644 --- a/src/errata/Errata/Process.lean +++ b/src/errata/Errata/Process.lean @@ -15,9 +15,9 @@ set_option doc.verso true namespace Errata -/-- Asserts that a process exited with the expected code, showing its error output otherwise. -/ +/-- Asserts that a process exited with the expected code, showing its output otherwise. -/ def assertExitCode (expected : UInt32) (output : IO.Process.Output) (loc : Location := by exact here%) : TestM Unit := unless output.exitCode == expected do failAt loc s!"process exited with code {output.exitCode}, expected {expected}" - (detail? := some s!"stderr:\n{output.stderr}") + (detail? := some s!"stdout:\n{output.stdout}\nstderr:\n{output.stderr}") diff --git a/src/errata/Errata/Property.lean b/src/errata/Errata/Property.lean index de303c42a..a3999fa2d 100644 --- a/src/errata/Errata/Property.lean +++ b/src/errata/Errata/Property.lean @@ -26,7 +26,7 @@ def property (p : Prop) (cfg : Configuration := {}) (loc : Location := by exact let ctx ← read let cfg := { cfg with quiet := true, - randomSeed := if ctx.seed == 0 then cfg.randomSeed else some ctx.seed } + randomSeed := ctx.seed.orElse (fun _ => cfg.randomSeed) } match ← Testable.checkIO p' (cfg := cfg) with | .success _ => pure () | .gaveUp n => failAt loc s!"property gave up after discarding {n} cases" diff --git a/src/errata/Errata/Report.lean b/src/errata/Errata/Report.lean index 2da6f6993..05e843e66 100644 --- a/src/errata/Errata/Report.lean +++ b/src/errata/Errata/Report.lean @@ -241,6 +241,16 @@ instance : FromJson Result where /-- Renders the results as a JSON array of objects. -/ def jsonReport (results : Array Result) : String := (ToJson.toJson results).pretty +/-- The length of the longest run of consecutive backticks in {name}`s`. -/ +private def longestBacktickRun (s : String) : Nat := + (s.foldl (init := (0, 0)) fun (cur, best) c => + if c == '`' then (cur + 1, Nat.max best (cur + 1)) else (0, best)).2 + +/-- Wraps {name}`body` in a fenced code block whose fence outlasts any backtick run inside it. -/ +private def fencedBlock (body : String) : String := + let fence := String.ofList (List.replicate (Nat.max 3 (longestBacktickRun body + 1)) '`') + s!"{fence}\n{body}\n{fence}" + /-- Renders the results as Markdown for a CI job summary: a headline tally, each failure and error in an open collapsible block with its location and detail, and a per-module table in a closed one. @@ -260,9 +270,9 @@ def markdownReport (results : Array Result) : String := Id.run do {xmlEscape r.testName}: {xmlEscape message}</summary>\n\n" if let .fail f := r.status then if let some l := f.location? then s := s ++ s!"`{locationText l}`\n\n" - if let some d := detail? then s := s ++ s!"```\n{d}\n```\n\n" + if let some d := detail? then s := s ++ s!"{fencedBlock d}\n\n" unless r.output.isEmpty do - s := s ++ s!"<details><summary>output</summary>\n\n```\n{r.output.all}\n```\n\n</details>\n\n" + s := s ++ s!"<details><summary>output</summary>\n\n{fencedBlock r.output.all}\n\n</details>\n\n" return s ++ "</details>\n\n" match r.status with | .fail f => out := out ++ render "❌" f.message f.detail? diff --git a/src/errata/Errata/Runner.lean b/src/errata/Errata/Runner.lean index 707d751bf..c5c495190 100644 --- a/src/errata/Errata/Runner.lean +++ b/src/errata/Errata/Runner.lean @@ -64,7 +64,7 @@ def run (cfg : Context) (entries : Array TestEntry) : IO (Array Result) := do /-- A base context with the given settings and a fresh, empty log. -/ def mkContext (verbosity : Verbosity := .silent) (updateGolden : Bool := false) - (options : OptionMap := {}) (seed : Nat := 0) : IO Context := do + (options : OptionMap := {}) (seed : Option Nat := none) : IO Context := do let log ← IO.mkRef (#[] : Array Result) let usedOptions ← IO.mkRef ({} : Std.HashSet String) return { verbosity, updateGolden, options, seed, log, usedOptions } @@ -93,9 +93,11 @@ structure Options where Parses arguments into {lean}`(name, value)` pairs. -A long option is {lit}`--name`, {lit}`--name=value`, or {lit}`--name value`, taking the next token as -its value unless that token is itself an option. Short options bundle: {lit}`-xyz` is equivalent to -{lit}`--x --y --z`, and the last may take a following value. Any other argument is rejected. +A long option is {lit}`--name`, {lit}`--name=value`, or {lit}`--name value`. The {lit}`--name value` +form takes the next token as the value when that token is an ordinary argument; a token beginning with +{lit}`-` starts the next option instead, so a value beginning with {lit}`-` uses the {lit}`--name=value` +form. Short options bundle: {lit}`-xyz` is equivalent to {lit}`--x --y --z`, and the last may take a +following value. Any other argument is rejected. -/ partial def rawOptions : List String → Except String (List (String × String)) | [] => .ok [] @@ -165,7 +167,7 @@ def runMain (entries : Array TestEntry) (args : List String) : IO UInt32 := do IO.println usage return 0 let cfg ← mkContext (verbosity := opts.verbosity) (updateGolden := opts.updateGolden) - (options := opts.options) (seed := opts.seed.getD 0) + (options := opts.options) (seed := opts.seed) let results ← run cfg entries if let some path := opts.junitPath then IO.FS.writeFile path (junitReport results) if let some path := opts.jsonPath then IO.FS.writeFile path (jsonReport results) diff --git a/src/errata/Errata/usage.txt b/src/errata/Errata/usage.txt index ac53959a2..ca8423b82 100644 --- a/src/errata/Errata/usage.txt +++ b/src/errata/Errata/usage.txt @@ -15,3 +15,4 @@ Modules use Lake target syntax. Runner options: -h, --help Show this help and exit. Any other `--name value` option is passed through to the tests. +Write a value that begins with `-` as `--name=value`. diff --git a/src/tests/VersoTests/Blog.lean b/src/tests/VersoTests/Blog.lean index f8d9d8079..ba7d5e9d3 100644 --- a/src/tests/VersoTests/Blog.lean +++ b/src/tests/VersoTests/Blog.lean @@ -50,3 +50,54 @@ def freshIdFirst : Test := property (∀ h p, freshIdFirstIsHint h p) /-- The second identifier generated for a hint is the hint with `1` appended. -/ @[test] def freshIdSecond : Test := property (∀ h p, freshIdSecondIsHintWith1 h p) + +/-! ## Compile-time regression tests for the blog genre -/ + +/-- info: #[(`a.b.c, 1), (`a.c, 4), (`b.c, 6), (`c, 3)] -/ +#test_msgs in +#eval NameSuffixMap.empty |>.insert `a.b.c 1 |>.insert `b.c 2 |>.insert `c 3 |>.insert `a.c 4 |>.insert `a.b 5 |>.insert `b.c 6 |>.get `c + +-- The deprecated inline Lean role warns. This standalone document asserts the warning, ahead of the +-- streaming blog blocks below that a `#test_msgs` wrapper cannot enclose. +/-- +warning: `{leanInline}` is deprecated; use `{lean}` instead. +-/ +#test_msgs in +#docs (Post) inlineLeanRoleNamesDeprecated "Inline Lean Role Names (deprecated alias)" := +::::::: +```leanInit post2 +``` + +Legacy role: {leanInline post2}`Nat.succ 1`. +::::::: + +-- Hidden blog Lean blocks elaborate with their show/keep/error flags. +#doc (Post) "Hidden Lean Block Flags" => +```leanInit post +``` + +```lean post -show +def base : Nat := 40 +``` + +```lean post -keep +def scratch : Nat := base + 2 +``` + +```lean post +example : base = 40 := rfl +``` + +```lean post +error +#check scratch +``` + +-- The canonical inline Lean role works without warnings. +#docs (Post) inlineLeanRoleNames "Inline Lean Role Names" := +```leanInit post +``` + +Canonical role: {lean post}`Nat.succ 1`. + +#test_guard inlineLeanRoleNames.toPart.content.size > 0 +#test_guard inlineLeanRoleNamesDeprecated.toPart.content.size > 0 diff --git a/src/tests/VersoTests/DocElabExtensions/Use.lean b/src/tests/VersoTests/DocElabExtensions/Use.lean index 1641cedeb..f445aaa9a 100644 --- a/src/tests/VersoTests/DocElabExtensions/Use.lean +++ b/src/tests/VersoTests/DocElabExtensions/Use.lean @@ -46,5 +46,5 @@ Directive body {inheritedCommand} ::::::: -#guard importedThroughMiddle -#guard inheritedDocElabExtensions.toPart.content.size == 4 +#test_guard importedThroughMiddle +#test_guard inheritedDocElabExtensions.toPart.content.size == 4 diff --git a/src/tests/VersoTests/InlineStringPositions.lean b/src/tests/VersoTests/InlineStringPositions.lean index b2b404d36..142dbde94 100644 --- a/src/tests/VersoTests/InlineStringPositions.lean +++ b/src/tests/VersoTests/InlineStringPositions.lean @@ -41,29 +41,29 @@ def checkDecode -- A markup delimiter after an escape maps past the multi-byte source of the escape, not by a -- constant shift: in `"a\n*b*"` the `*` is decoded byte 2 but source byte 4. -#guard checkDecode decodeStrLitWithMap "\"a\\n*b*\"" "a\n*b*" [(1, 2, "\\n"), (2, 3, "*")] +#test_guard checkDecode decodeStrLitWithMap "\"a\\n*b*\"" "a\n*b*" [(1, 2, "\\n"), (2, 3, "*")] -- A unicode escape decodes to a multi-byte character whose source span is the whole `\uHHHH`. -#guard checkDecode decodeStrLitWithMap "\"\\u00e9x\"" "éx" [(0, 2, "\\u00e9"), (2, 3, "x")] +#test_guard checkDecode decodeStrLitWithMap "\"\\u00e9x\"" "éx" [(0, 2, "\\u00e9"), (2, 3, "x")] -- A string gap decodes to nothing; the character after it maps past the whole gap to source byte 6. -#guard checkDecode decodeStrLitWithMap "\"a\\\n b\"" "ab" [(1, 2, "b")] +#test_guard checkDecode decodeStrLitWithMap "\"a\\\n b\"" "ab" [(1, 2, "b")] -- Raw string literals are not escape-decoded: `\n` stays two characters. -#guard checkDecode decodeStrLitWithMap "r\"a\\n*\"" "a\\n*" [(3, 4, "*")] +#test_guard checkDecode decodeStrLitWithMap "r\"a\\n*\"" "a\\n*" [(3, 4, "*")] -- Every character a unicode escape: each decoded character maps to its whole six-byte `\uHHHH`. -#guard checkDecode decodeStrLitWithMap "\"\\u002A\\u0062\\u002A\"" "*b*" +#test_guard checkDecode decodeStrLitWithMap "\"\\u002A\\u0062\\u002A\"" "*b*" [(0, 1, "\\u002A"), (1, 2, "\\u0062"), (2, 3, "\\u002A")] -- A bare content region (no surrounding quotes) decodes the same way; this drives re-parsing escaped -- code spans as Lean. -#guard checkDecode decodeContentWithMap "\\u004E\\u0061\\u0074" "Nat" +#test_guard checkDecode decodeContentWithMap "\\u004E\\u0061\\u0074" "Nat" [(0, 1, "\\u004E"), (1, 2, "\\u0061"), (2, 3, "\\u0074")] -- Remapping reanchors a token's leading and trailing whitespace into the source string, so the -- syntax round-trips, and the token's positions become absolute. -#guard +#test_guard let src := "\"a\\n*b*\"" let (_, m) := decodeStrLitWithMap src ⟨0⟩ src.rawEndPos let leading : Substring.Raw := { str := "a\n*b*", startPos := ⟨2⟩, stopPos := ⟨2⟩ } diff --git a/src/tests/VersoTests/PorterStemmer.lean b/src/tests/VersoTests/PorterStemmer.lean new file mode 100644 index 000000000..7397a173c --- /dev/null +++ b/src/tests/VersoTests/PorterStemmer.lean @@ -0,0 +1,125 @@ +/- +Copyright (c) 2026 Lean FRO LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Author: David Thrane Christiansen +-/ +module +meta import all VersoSearch.PorterStemmer +import Errata + +namespace Verso.Tests.PorterStemmer + +open Verso.Search.Stemmer.Porter + +/-! ## Tests for measure function -/ + +/-- info: 0 -/ +#test_msgs in +#eval measure "tr".toSlice +/-- info: 0 -/ +#test_msgs in +#eval measure "ee".toSlice +/-- info: 0 -/ +#test_msgs in +#eval measure "tree".toSlice + +/-- info: 2 -/ +#test_msgs in +#eval measure "private".toSlice + +/-! ## Tests for step1a -/ + +/-- info: "abiliti" -/ +#test_msgs in +#eval step1a "abilities".toSlice |>.copy + +/-! ## Tests for step1b -/ + +/-- info: "abiliti" -/ +#test_msgs in +#eval step1b "abiliti".toSlice |>.copy + +/-- info: "caress" -/ +#test_msgs in +#eval step1b (step1a "caresses".toSlice) |>.copy +/-- info: "poni" -/ +#test_msgs in +#eval step1b (step1a "ponies".toSlice) |>.copy +/-- info: "ti" -/ +#test_msgs in +#eval step1b (step1a "ties".toSlice) |>.copy +/-- info: "caress" -/ +#test_msgs in +#eval step1b (step1a "caress".toSlice) |>.copy +/-- info: "cat" -/ +#test_msgs in +#eval step1b (step1a "cats".toSlice) |>.copy + +/-- info: "feed" -/ +#test_msgs in +#eval step1b (step1a "feed".toSlice) |>.copy +/-- info: "agree" -/ +#test_msgs in +#eval step1b (step1a "agreed".toSlice) |>.copy +/-- info: "disable" -/ +#test_msgs in +#eval step1b (step1a "disabled".toSlice) |>.copy + +/-- info: "mat" -/ +#test_msgs in +#eval step1b (step1a "matting".toSlice) |>.copy +/-- info: "mate" -/ +#test_msgs in +#eval step1b (step1a "mating".toSlice) |>.copy +/-- info: "meet" -/ +#test_msgs in +#eval step1b (step1a "meeting".toSlice) |>.copy +/-- info: "mill" -/ +#test_msgs in +#eval step1b (step1a "milling".toSlice) |>.copy +/-- info: "mess" -/ +#test_msgs in +#eval step1b (step1a "messing".toSlice) |>.copy + +/-- info: "meet" -/ +#test_msgs in +#eval step1b (step1a "meetings".toSlice) |>.copy + +/-! ## Tests for step1c -/ + +/-- info: "happi" -/ +#test_msgs in +#eval step1c "happy".toSlice |>.copy + +/-- info: "abiliti" -/ +#test_msgs in +#eval step1c "abiliti".toSlice |>.copy + +/-! ## Tests for step2 -/ + +/-- info: "sensible" -/ +#test_msgs in +#eval step2 "sensibiliti".toSlice |>.copy + +/-- info: "abiliti" -/ +#test_msgs in +#eval step2 "abiliti".toSlice |>.copy + +/-! ## Tests for step3 -/ + +/-- info: "form" -/ +#test_msgs in +#eval step3 "formative".toSlice |>.copy + +/-- info: "able" -/ +#test_msgs in +#eval step3 "able".toSlice |>.copy + +/-! ## Tests for step5b -/ + +/-- info: "control" -/ +#test_msgs in +#eval step5b "controll".toSlice |>.copy +/-- info: "roll" -/ +#test_msgs in +#eval step5b "roll".toSlice |>.copy diff --git a/src/tests/VersoTests/SetupLiterate.lean b/src/tests/VersoTests/SetupLiterate.lean index f078dd0ec..fc9e8530f 100644 --- a/src/tests/VersoTests/SetupLiterate.lean +++ b/src/tests/VersoTests/SetupLiterate.lean @@ -27,22 +27,17 @@ def setupLiterate : Test := do let out ← IO.Process.output { cmd := "lake", args := #["exe", "verso", "setup-literate"], cwd := some tmpDir.toString } pure out - let runOk (label cmd : String) (args : Array String) : TestM Unit := do - let out ← IO.Process.output { cmd, args, cwd := some tmpDir.toString } - unless out.exitCode == 0 do - failHere s!"{label} failed (exit {out.exitCode})" (detail? := some (out.stdout ++ out.stderr)) -- A project that depends on the Verso under test. - runOk "git init" "git" #["init", "-q"] + assertExitCode 0 (← IO.Process.output { + cmd := "git", args := #["init", "-q"], cwd := some tmpDir.toString }) IO.FS.writeFile (tmpDir / "lean-toolchain") (← IO.FS.readFile "lean-toolchain") IO.FS.writeFile (tmpDir / "lakefile.toml") s!"name = \"test-project\"\n\n[[require]]\nname = \"verso\"\npath = \"{versoRoot}\"\n" -- Fresh generation writes a workflow with the expected steps. let fresh ← setupLiterate - unless fresh.exitCode == 0 do - failHere s!"setup-literate failed (exit {fresh.exitCode})" - (detail? := some (fresh.stdout ++ fresh.stderr)) + assertExitCode 0 fresh assertFileExists (workflowPath tmpDir) let content ← IO.FS.readFile (workflowPath tmpDir) for needle in ["lake query :literateHtml", "deploy-pages@v", "upload-pages-artifact@v", "lean-action@v"] do @@ -55,9 +50,7 @@ def setupLiterate : Test := do -- Editing the workflow makes the next run back up the old content. IO.FS.writeFile (workflowPath tmpDir) "modified content\n" let updated ← setupLiterate - unless updated.exitCode == 0 do - failHere s!"setup-literate update failed (exit {updated.exitCode})" - (detail? := some (updated.stdout ++ updated.stderr)) + assertExitCode 0 updated let backup := (workflowPath tmpDir).toString ++ ".bak" assertFileExists backup assertContains "modified content" (← IO.FS.readFile backup) diff --git a/src/tests/VersoTests/TeXGolden.lean b/src/tests/VersoTests/TeXGolden.lean index 87e4a985a..d1c464b00 100644 --- a/src/tests/VersoTests/TeXGolden.lean +++ b/src/tests/VersoTests/TeXGolden.lean @@ -42,9 +42,7 @@ def texGolden (dir : System.FilePath) (doc : Verso.Doc.VersoDoc Manual) cmd := "lualatex" args := #["-shell-escape", "-halt-on-error", "-interaction=nonstopmode", "main.tex"] } - unless out.exitCode == 0 do - failHere s!"lualatex exited with code {out.exitCode}" - (detail? := some (out.stdout ++ out.stderr)) + assertExitCode 0 out /-- The sample document renders to its golden TeX. -/ @[test] diff --git a/src/tests/VersoTests/Zip.lean b/src/tests/VersoTests/Zip.lean index 27e5126aa..756dc5df9 100644 --- a/src/tests/VersoTests/Zip.lean +++ b/src/tests/VersoTests/Zip.lean @@ -77,8 +77,9 @@ def zipRandom : Test := do IO.println s!"random seed: {seed}" let count ← IO.rand 0 15 let mut files := #[] - for _ in [0:count] do + for i in [0:count] do let bytes ← IO.getRandomBytes (.ofNat (← IO.rand 0 50000)) - files := files.push (← randName, bytes) + -- A numbered prefix keeps every name distinct even when two random stems collide. + files := files.push (s!"{i + 1}-{← randName}", bytes) for method in [CompressionMethod.store, .deflate] do extractRoundTrips files method From dce73e5e4de8e8640363b848dd7117ecd4354028 Mon Sep 17 00:00:00 2001 From: David Thrane Christiansen <david@davidchristiansen.dk> Date: Thu, 25 Jun 2026 12:36:00 +0200 Subject: [PATCH 11/26] review --- .github/workflows/ci.yml | 2 +- .github/workflows/update-subverso.yml | 2 +- lakefile.lean | 41 +- lean-upstream-fixes.md | 140 ------ src/errata/Errata/Assertions.lean | 12 +- src/errata/Errata/Report.lean | 18 +- src/errata/Errata/Runner.lean | 5 +- src/errata/Errata/usage.txt | 9 +- .../VersoTests/DocElabExtensions/Use.lean | 1 + src/tests/VersoTests/LiterateHtml.lean | 419 +++++++++--------- src/tests/VersoTests/Options.lean | 17 + 11 files changed, 285 insertions(+), 381 deletions(-) delete mode 100644 lean-upstream-fixes.md create mode 100644 src/tests/VersoTests/Options.lean diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 86e43a589..b6fcd8ecd 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -93,7 +93,7 @@ jobs: - name: Run tests run: | - lake test -- --verbose --check-tex --junit=errata-report.xml --markdown=errata-summary.md + lake test -- --test-options --verbose --check-tex --junit=errata-report.xml --markdown=errata-summary.md - name: Add test results to the job summary if: always() diff --git a/.github/workflows/update-subverso.yml b/.github/workflows/update-subverso.yml index 238921ea1..c9102c413 100644 --- a/.github/workflows/update-subverso.yml +++ b/.github/workflows/update-subverso.yml @@ -84,7 +84,7 @@ jobs: - name: Run tests if: steps.check-changes.outputs.changed == 'true' run: | - lake test -- --verbose --check-tex + lake test -- --test-options --verbose --check-tex - name: Create branch and open PR if: steps.check-changes.outputs.changed == 'true' diff --git a/lakefile.lean b/lakefile.lean index baeda6c65..fa0517e93 100644 --- a/lakefile.lean +++ b/lakefile.lean @@ -207,12 +207,21 @@ private def errataModuleSelected (specs : List String) (moduleName : Lean.Name) let n := moduleName.toString n == s || n.startsWith (s ++ ".") -/-- Split driver arguments into module target specs and runner passthrough arguments. -/ -private def errataSplitArgs (args : List String) : List String × List String := - match args.span (· != "--") with - | (before, _ :: after) => (before, after) - | (before, []) => - (before.filter (fun a => !a.startsWith "-"), before.filter (fun a => a.startsWith "-")) +/-- +Splits driver arguments at the `--test-options` marker into module target specs and runner +passthrough arguments. Module specs precede the marker and may not look like options; everything +after the marker goes to the runner. +-/ +private def errataSplitArgs (args : List String) : Except String (List String × List String) := + let (specs, rest) := + match args.span (· != "--test-options") with + | (specs, _ :: after) => (specs, after) + | (specs, []) => (specs, []) + match specs.find? (·.startsWith "-") with + | some opt => + .error s!"unexpected option '{opt}' among module specs; pass runner options after \ + `--test-options` (e.g. `lake test -- --test-options {opt}`)" + | none => .ok (specs, rest) /-- Usage information for `lake test`, shared with `Errata.usage` through one text file. -/ private def errataUsage : String := include_str "src/errata/Errata/usage.txt" @@ -238,9 +247,9 @@ private def errataModuleOfPath (srcDir path : System.FilePath) : Option Lean.Nam some (".".intercalate comps).toName /-- -Reports modules that define `@[test]` tests but whose library's globs do not cover them, so the -tests would be silently undiscovered, and returns them. A module within a library's root that is not -matched by the library's globs, in a file mentioning `@[test]`, is the signal. +Reports modules that define tests but whose library's globs do not cover them, so the tests would be +silently undiscovered, and returns them. A module within a library's root that is not matched by the +library's globs, in a file that introduces tests, is the signal. -/ private def errataUncoveredTestModules (ws : Lake.Workspace) : IO (Array Lean.Name) := do let mut missed : Array Lean.Name := #[] @@ -253,10 +262,10 @@ private def errataUncoveredTestModules (ws : Lake.Workspace) : IO (Array Lean.Na let globbed := lib.config.globs.any (·.matches mod) if withinRoot && !globbed && !missed.contains mod then let lines := (← IO.FS.readFile path).splitOn "\n" - if lines.any (fun line => line.trimAsciiStart.copy.startsWith "@[test]") then + if errataSourceHasTests lines then missed := missed.push mod unless missed.isEmpty do - IO.eprintln "error: these modules define @[test] tests but their library's globs do not cover \ + IO.eprintln "error: these modules define tests but their library's globs do not cover \ them, so the tests are not discovered. Widen the library's `globs` \ (e.g. `globs := #[Glob.andSubmodules `Root]`):" for mod in missed do @@ -266,11 +275,17 @@ private def errataUncoveredTestModules (ws : Lake.Workspace) : IO (Array Lean.Na @[test_driver] script «errata-test» (args) do let ws ← getWorkspace - let (specs, runnerArgs) := errataSplitArgs args -- Answer `--help` before discovering or building anything. - if runnerArgs.any (fun a => a == "--help" || a == "-h") then + if args.any (fun a => a == "--help" || a == "-h") then IO.println errataUsage return 0 + let (specs, runnerArgs) ← + match errataSplitArgs args with + | .ok result => pure result + | .error msg => + IO.eprintln s!"error: {msg}" + IO.eprintln errataUsage + return 1 -- The module is the unit of execution; a test-level selector is rejected, not silently broadened. for spec in specs do if (spec.splitOn "#").length > 1 then diff --git a/lean-upstream-fixes.md b/lean-upstream-fixes.md deleted file mode 100644 index c9d60e296..000000000 --- a/lean-upstream-fixes.md +++ /dev/null @@ -1,140 +0,0 @@ -# Docstring elaborator fixes needed in Lean - -Issues found while reviewing Verso PR #859 (literate-mode handlers for Verso docstring -extensions). Each needs a change in the `lean4` repository. File and line references are -for `v4.30.0-rc2`. - -## 1. `{option}` role renders `set_option [anonymous]` - -**File:** `src/Lean/Elab/DocString/Builtin.lean`, `option` role, around line 1160. - -When the role is given full `set_option` syntax, as in -`` {option}`set_option maxHeartbeats 1000` ``, the stored display code reads -`set_option [anonymous]` instead of `set_option maxHeartbeats 1000`. - -The role parses the code with the `set_option` command parser: - -``` -"set_option " >> identWithPartialTrailingDot >> ppSpace >> optionValue -``` - -The helper `optionNameAndVal` (line 452) reads the option name from `stx[1]` and the -value from `stx[3]`, and these indices work: the role resolves the option correctly. -But the display code a few lines below uses different, wrong indices: - -```lean -let code := #[ - ("set_option", some .keyword), (" ", none), - (toString stx[1][0].getId, some <| .option optionName decl.declName), (" ", none), - (toString stx[2].getAtomVal, some <| .literal stx[2].getKind none) -] -``` - -`stx[1]` is the ident itself, so `stx[1][0]` is `Syntax.missing` and `getId` returns -`[anonymous]`. `stx[2]` is not the value, so `getAtomVal` returns the empty string. - -**Fix:** build the name from `optionName` (or `stx[1]`) and the value from `stx[3]`. -Note that `stx[3]` can be a string or numeric literal node, where the atom is nested, -or a bare `true`/`false` atom, so `stx[3].getAtomVal` alone is not enough for the -literal cases. Reusing the `val : DataValue` returned by `optionNameAndVal` for the -display string is probably simplest. Test with a numeric, a string, and a Boolean -option value. - -**Why it cannot be fixed downstream:** the broken strings are baked into the -`Data.SetOption` payload when the docstring is elaborated. Consumers such as Verso -receive only the corrupted `DocCode`. - -## 2. `{assert}` and `{assert'}` produce no hover or highlighting information - -**File:** `src/Lean/Elab/DocString/Builtin.lean`, `assert'` at line 1215, `assert` at -line 1233. - -Both roles elaborate their terms but return a bare `.code s.getString`. Compare with -`leanRole` (line 1080), which wraps elaboration in `withSaveInfoContext`, collects the -info trees, and returns a `Data.LeanTerm` payload built with `highlightSyntax`. As a -result, `` {assert}`Nat.zero = Nat.zero` `` renders as plain code with no hovers for -`Nat.zero`, observed in the Verso PR #859 review. - -**Fix:** capture info the same way `leanRole` does and return a `Data.LeanTerm` -payload (or a dedicated `Data.Assert`) when info trees are available. For `assert`, -the parsed term can be passed to `highlightSyntax` directly. For `assert'`, the parsed -null node with `lhs`, `=`, `rhs` works as well. - -## 3. `{assert'}` is not usable once `=` notation exists - -`assert'` exists for the prelude, before the equality type's notation is introduced, -and parses `a = b` itself. After the notation is defined, the role's hand-rolled -parse of `=` cannot be used in practice, so the role cannot be demonstrated or tested -outside the bootstrap. Verso's test fixture now documents it as untested -(`test-projects/literate-config/LitConfig/Builtins.lean`). - -**Fix (agreed direction from the PR #859 discussion):** replace it with a role that -takes the two (or three, with the type) sides as separate code parameters, for -example `` {assert'}[`Nat.zero` `Nat.zero`] ``, so no equality notation is needed. - -## 4. `Data.Atom` is not `public` - -**File:** `src/Lean/Elab/DocString/Builtin/Keywords.lean`, line 26. - -The file uses the module system and `structure Data.Atom` lacks `public`, so its name -is mangled with a private prefix. The `kw` and `kw?` roles put it in `Inline.other` -payloads, so external consumers must dispatch on the mangled name. Verso works around -this by matching the name's suffix (`handleKwAtom` in -`src/verso-literate/VersoLiterate/Basic.lean`, which carries a comment about this). - -**Fix:** mark the structure `public`. The workaround in Verso can then be removed. - -## 5. `{conv}` stores a `Data.Tactic` value in its `Data.ConvTactic` payload - -**File:** `src/Lean/Elab/DocString/Builtin.lean`, `conv` role, around line 1388. - -The role builds its payload as: - -```lean -return .other { - name := ``Data.ConvTactic, val := .mk { name := t : Data.Tactic} - } #[.code s.getString] -``` - -The extension name says `Data.ConvTactic`, but the `Dynamic` value is a `Data.Tactic`, so -`val.get? Data.ConvTactic` fails for consumers that dispatch on the advertised type. The -two structures have the same shape, which hides the mistake. Verso works around it by -accepting both payload types in `handleConvTactic` -(`src/verso-literate/VersoLiterate/Basic.lean`); the workaround can be removed once this -is fixed. - -**Fix:** construct a `Data.ConvTactic` value (`val := .mk { name := t : Data.ConvTactic }`). - -## 6. `{conv}` does not resolve tactics by token, unlike `{tactic}` - -**File:** `src/Lean/Elab/DocString/Builtin.lean`, `conv` role and `getConvTactic`, -around line 1351. - -`{tactic}` resolves its argument against `Tactic.Doc.allTacticDocs`, matching both -internal kind names and user-facing names, so `` {tactic}`rfl` `` works. `getConvTactic` -only matches when the argument is a name suffix of a conv tactic's syntax kind, so -`` {conv}`rfl` `` does not resolve (the kind is `convRfl`). The role then silently falls -back to parsing the string as conv syntax and returns plain `.code`, with no payload and -no metadata for downstream tools. `` {conv}`lhs` `` works only because the kind happens -to be named `Lean.Parser.Tactic.Conv.lhs`. - -**Fix:** resolve conv tactics by first token as well, the way `tactic` does, or at least -document the suffix requirement in the role's docstring. - -## 7. Enhancement: diagnostics in `DocCode` - -`DocCode` segments carry only token highlighting (`DocHighlight`). Messages produced -by commands in a docstring's `lean` code block are instead re-logged as silent info -messages positioned inside the doc comment -(`src/Lean/Elab/DocString/Builtin.lean`, `lean` code block, around line 945). A -consumer that renders the docstring has no direct way to know which part of the code -block a message belongs to. - -Verso now reverse-engineers the placement: the concatenated `DocCode` text reproduces -a region of the source file verbatim, so each doc-comment message is matched to the -occurrence of that text containing the message's range -(`relocateDocMessages` in `src/verso-literate/VersoLiterateMain.lean`). This works, -but a first-class representation of message spans in `DocCode` (or in -`Data.LeanBlock`) would let all consumers place diagnostics without this -reconstruction, and would also cover messages whose positions fall outside any code -block. diff --git a/src/errata/Errata/Assertions.lean b/src/errata/Errata/Assertions.lean index 34e6c6bad..8663016d4 100644 --- a/src/errata/Errata/Assertions.lean +++ b/src/errata/Errata/Assertions.lean @@ -33,10 +33,16 @@ def assertNe {α} [BEq α] [Repr α] (unexpected actual : α) failAt loc "values are equal but should differ" (detail? := some s!"both: {repr actual}") /-- Asserts that the actual string contains the expected substring. -/ -def assertContains (expected actual : String) +def assertContains (expected actual : String) (message : String := "substring not found") + (loc : Location := by exact here%) : TestM Unit := do + unless (actual.find? expected).isSome do + failAt loc message (detail? := some s!"expected to contain: {expected}\nactual: {actual}") + +/-- Asserts that the actual string does not contain the unexpected substring. -/ +def assertNotContains (unexpected actual : String) (message : String := "unexpected substring found") (loc : Location := by exact here%) : TestM Unit := - unless (actual.splitOn expected).length > 1 do - failAt loc "substring not found" (detail? := some s!"expected to contain: {expected}\nactual: {actual}") + unless (actual.find? unexpected).isNone do + failAt loc message (detail? := some s!"expected not to contain: {unexpected}\nactual: {actual}") /-- Asserts that a file exists. -/ def assertFileExists (path : System.FilePath) diff --git a/src/errata/Errata/Report.lean b/src/errata/Errata/Report.lean index 05e843e66..7aa446b54 100644 --- a/src/errata/Errata/Report.lean +++ b/src/errata/Errata/Report.lean @@ -7,6 +7,7 @@ module public import Errata.Result public import Lean.Data.Json +import Std.Data.HashMap public section @@ -160,12 +161,20 @@ private def caseOf (r : Result) : String := private def countWhere (results : Array Result) (p : Status → Bool) : Nat := results.foldl (fun n r => if p r.status then n + 1 else n) 0 +/-- Groups results by their module in a single pass, keeping each module's first-seen order. -/ +private def byModule (results : Array Result) : Array (String × Array Result) := Id.run do + let mut order : Array String := #[] + let mut groups : Std.HashMap String (Array Result) := {} + for r in results do + let s := suiteOf r + if !groups.contains s then order := order.push s + groups := groups.insert s ((groups.getD s #[]).push r) + return order.map fun s => (s, groups.getD s #[]) + /-- Renders the results as JUnit XML, grouping by the module path. -/ def junitReport (results : Array Result) : String := Id.run do - let suites := results.toList.map suiteOf |>.eraseDups let mut out := "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<testsuites>\n" - for suite in suites do - let cases := results.filter (fun r => suiteOf r == suite) + for (suite, cases) in byModule results do let pkg := (cases[0]?.map (·.package)).getD "" let failures := countWhere cases (fun s => s matches .fail _) let errors := countWhere cases (fun s => s matches .error _) @@ -280,8 +289,7 @@ def markdownReport (results : Array Result) : String := Id.run do | _ => pure () out := out ++ "<details><summary>Summary by module</summary>\n\n" out := out ++ "| Module | ✅ | ❌ | 💥 | ⏭️ |\n| :-- | --: | --: | --: | --: |\n" - for m in results.toList.map suiteOf |>.eraseDups do - let cs := results.filter (suiteOf · == m) + for (m, cs) in byModule results do out := out ++ s!"| {m} | {countWhere cs (· matches .pass)} | {countWhere cs (· matches .fail _)} \ | {countWhere cs (· matches .error _)} | {countWhere cs (· matches .skip _)} |\n" return out ++ "\n</details>\n" diff --git a/src/errata/Errata/Runner.lean b/src/errata/Errata/Runner.lean index c5c495190..d3faac0f6 100644 --- a/src/errata/Errata/Runner.lean +++ b/src/errata/Errata/Runner.lean @@ -112,10 +112,9 @@ partial def rawOptions : List String → Except String (List (String × String)) if value.startsWith "-" then (((name, "") :: ·)) <$> rawOptions rest else (((name, value) :: ·)) <$> rawOptions rest' | [] => .ok [(name, "")] - | [name, value] => + | name :: valueParts => if name.isEmpty then .error s!"unexpected argument: {arg}" - else (((name, value) :: ·)) <$> rawOptions rest - | _ => .error s!"unexpected argument: {arg}" + else (((name, "=".intercalate valueParts) :: ·)) <$> rawOptions rest else if arg.startsWith "-" && arg.length > 1 then -- Expand bundled short flags: `-xyz` becomes `--x --y --z`. let expanded := (arg.drop 1).copy.toList.map (fun c => "--" ++ toString c) diff --git a/src/errata/Errata/usage.txt b/src/errata/Errata/usage.txt index ca8423b82..72ea27980 100644 --- a/src/errata/Errata/usage.txt +++ b/src/errata/Errata/usage.txt @@ -1,11 +1,12 @@ Errata test runner Usage: - lake test run every test in the package - lake test -- MODULE... run the tests in the given modules - lake test -- MODULE... -- OPTION... pass runner options after a second `--` + lake test run every test in the package + lake test -- MODULE... run the tests in the given modules + lake test -- MODULE... --test-options OPTION... pass runner options after the marker -Modules use Lake target syntax. Runner options: +Runner options go after `--test-options`; tokens before it name modules in Lake target syntax. +Runner options: -v, --verbose Also report passes (truncating each test's results); repeat (-vv) for all. --update-golden Rewrite golden expected files instead of comparing. --seed N Seed property tests with N, to reproduce a failure. diff --git a/src/tests/VersoTests/DocElabExtensions/Use.lean b/src/tests/VersoTests/DocElabExtensions/Use.lean index f445aaa9a..de9c01b08 100644 --- a/src/tests/VersoTests/DocElabExtensions/Use.lean +++ b/src/tests/VersoTests/DocElabExtensions/Use.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Author: Emilio Jesus Gallego Arias -/ import VersoTests.DocElabExtensions.Middle +import Errata namespace Verso.Tests.DocElabExtensions diff --git a/src/tests/VersoTests/LiterateHtml.lean b/src/tests/VersoTests/LiterateHtml.lean index 3bfea31a6..288703644 100644 --- a/src/tests/VersoTests/LiterateHtml.lean +++ b/src/tests/VersoTests/LiterateHtml.lean @@ -13,9 +13,6 @@ namespace VersoTests.LiterateHtml open Errata -private def hasSubstring (s : String) (sub : String) : Bool := - s.find? sub |>.isSome - private def cleanDir (dir : System.FilePath) : IO Unit := do if ← dir.pathExists then IO.FS.removeDirAll dir @@ -170,38 +167,38 @@ private def testDefaultBehavior (data : TestData) : Test := withTestDir data fun fail s!"Expected HTML file not found: {f}" let landingHtml ← IO.FS.readFile (htmlDir / "index.html") - unless hasSubstring landingHtml "LitConfig" do - fail "Landing page does not contain 'LitConfig'" + assertContains "LitConfig" landingHtml + "Landing page does not contain 'LitConfig'" let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") - unless hasSubstring litConfigHtml "<title>LitConfig" do - fail "LitConfig page title is not 'LitConfig'" - unless hasSubstring litConfigHtml "A Test Module" do - fail "LitConfig page does not contain module docstring content 'A Test Module'" - unless hasSubstring litConfigHtml "code-box" do - fail "LitConfig page does not contain any code boxes" - unless hasSubstring litConfigHtml "module-tree" do - fail "LitConfig page does not contain module tree navigation" - unless hasSubstring litConfigHtml "breadcrumbs" do - fail "LitConfig page does not contain breadcrumbs" + assertContains "LitConfig" litConfigHtml + "LitConfig page title is not 'LitConfig'" + assertContains "A Test Module" litConfigHtml + "LitConfig page does not contain module docstring content 'A Test Module'" + assertContains "code-box" litConfigHtml + "LitConfig page does not contain any code boxes" + assertContains "module-tree" litConfigHtml + "LitConfig page does not contain module tree navigation" + assertContains "breadcrumbs" litConfigHtml + "LitConfig page does not contain breadcrumbs" let coreHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "Core" / "index.html") - unless hasSubstring coreHtml "Core Module" do - fail "Core page does not contain module docstring content 'Core Module'" + assertContains "Core Module" coreHtml + "Core page does not contain module docstring content 'Core Module'" let noDocHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "NoDocstrings" / "index.html") - unless hasSubstring noDocHtml "code-box" do - fail "NoDocstrings page does not contain code boxes" + assertContains "code-box" noDocHtml + "NoDocstrings page does not contain code boxes" /-- The `{kw}` docstring role renders keyword atoms in the HTML output. -/ private def testKeywordRole (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ _ => do runLiterateHtml jsonDir htmlDir let coreHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "Core" / "index.html") -- The module docstring contains {kw}`where`, which should render as a keyword-highlighted token - unless hasSubstring coreHtml "where" do - fail "Core page does not contain keyword 'where' from {kw} role" - unless hasSubstring coreHtml "keyword" do - fail "Core page does not contain 'keyword' CSS class for {kw} role" + assertContains "where" coreHtml + "Core page does not contain keyword 'where' from {kw} role" + assertContains "keyword" coreHtml + "Core page does not contain 'keyword' CSS class for {kw} role" /-- Per-module JSON path used by the tests. The literate facet writes @@ -221,11 +218,11 @@ private def testAllBuiltinDocRoles (data : TestData) : Test := withTestDir data unless ← builtinsHtml.pathExists do fail s!"Expected Builtins HTML page at {builtinsHtml}" let jsonContent ← IO.FS.readFile (jsonPath jsonDir "LitConfig.Builtins") - unless hasSubstring jsonContent "\"content\":\"rfl\",\"kind\":{\"keyword\":{\"docs\":\"" do - fail "Builtins JSON has no docs on the `rfl` keyword token. \ + assertContains "\"content\":\"rfl\",\"kind\":{\"keyword\":{\"docs\":\"" jsonContent + "Builtins JSON has no docs on the `rfl` keyword token. \ The tactic handler did not attach the syntax kind's docstring." - unless hasSubstring jsonContent "\"content\":\"lhs\",\"kind\":{\"keyword\":{\"docs\":\"" do - fail "Builtins JSON has no docs on the `lhs` keyword token. \ + assertContains "\"content\":\"lhs\",\"kind\":{\"keyword\":{\"docs\":\"" jsonContent + "Builtins JSON has no docs on the `lhs` keyword token. \ The conv handler did not attach the syntax kind's docstring." /-- @@ -238,18 +235,18 @@ private def testCustomLiterateHandlers (data : TestData) : Test := withTestDir d unless ← jsonFile.pathExists do fail s!"Expected JSON for LitConfig.UserExt at {jsonFile}" let jsonContent ← IO.FS.readFile jsonFile - unless hasSubstring jsonContent "USER-CONST-MARKER" do - fail "UserExt JSON missing USER-CONST-MARKER: `@[inline_to_literate]` handler did not run" - unless hasSubstring jsonContent "USER-LEANBLOCK-MARKER" do - fail "UserExt JSON missing USER-LEANBLOCK-MARKER: `@[block_to_literate]` handler did not run" + assertContains "USER-CONST-MARKER" jsonContent + "UserExt JSON missing USER-CONST-MARKER: `@[inline_to_literate]` handler did not run" + assertContains "USER-LEANBLOCK-MARKER" jsonContent + "UserExt JSON missing USER-LEANBLOCK-MARKER: `@[block_to_literate]` handler did not run" let html ← IO.FS.readFile (htmlDir / "LitConfig" / "UserExt" / "index.html") - unless hasSubstring html "looks like you're defining a const" do - fail "UserExt HTML missing the inline replacement text. The user handler's children weren't rendered." - unless hasSubstring html "Replacement For A Lean Block" do - fail "UserExt HTML missing the block replacement text. The user handler's children weren't rendered." - if hasSubstring html "trivial" then - fail "UserExt HTML contains 'trivial'. The built-in lean code-block handler ran instead of the user handler." + assertContains "looks like you're defining a const" html + "UserExt HTML missing the inline replacement text. The user handler's children weren't rendered." + assertContains "Replacement For A Lean Block" html + "UserExt HTML missing the block replacement text. The user handler's children weren't rendered." + assertNotContains "trivial" html + "UserExt HTML contains 'trivial'. The built-in lean code-block handler ran instead of the user handler." /-- Checks that messages produced by code blocks in docstrings are attached to the rendered code block @@ -265,8 +262,8 @@ private def testDocstringCodeBlockMessages (data : TestData) : Test := do unless ← jsonFile.pathExists do fail s!"Expected JSON for LitConfig.Builtins at {jsonFile}" let jsonContent ← IO.FS.readFile jsonFile - unless hasSubstring jsonContent "\"span\":{\"content\":{\"token\":{\"tok\":{\"content\":\"#eval\"" do - fail "Builtins JSON has no message span on the docstring's `#eval`. \ + assertContains "\"span\":{\"content\":{\"token\":{\"tok\":{\"content\":\"#eval\"" jsonContent + "Builtins JSON has no message span on the docstring's `#eval`. \ Messages from docstring code blocks were not re-attached to the rendered code." let spanCount := (jsonContent.splitOn "\"span\":").length - 1 unless spanCount == 1 do @@ -291,16 +288,16 @@ private def testUnknownExtensionFallback : Test := do } if result.exitCode != 0 then fail s!"lake build :literateHtml failed (exit {result.exitCode}):\nstdout: {result.stdout}\nstderr: {result.stderr}" - unless hasSubstring result.stdout "No inline handler for LitConfig.UserExt.FallbackPayload" do - fail s!"Expected warning about unhandled extension in build output, got stdout: {result.stdout}\nstderr: {result.stderr}" + assertContains "No inline handler for LitConfig.UserExt.FallbackPayload" result.stdout + s!"Expected warning about unhandled extension in build output, got stdout: {result.stdout}\nstderr: {result.stderr}" let htmlFile : System.FilePath := "test-projects/literate-config" / ".lake" / "build" / "literate-html" / "LitConfig" / "UserExt" / "index.html" unless ← htmlFile.pathExists do fail s!"Expected HTML page at {htmlFile}" let html ← IO.FS.readFile htmlFile - unless hasSubstring html "THIS IS THE FALLBACK" do - fail "HTML missing 'THIS IS THE FALLBACK' marker. The conversion's fallback children were not rendered." + assertContains "THIS IS THE FALLBACK" html + "HTML missing 'THIS IS THE FALLBACK' marker. The conversion's fallback children were not rendered." /-- Excluded modules produce no HTML output and are absent from the navbar. -/ private def testExclude (data : TestData) : Test := withTestDir data fun jsonDir htmlDir planFile tomlFile => do @@ -316,8 +313,8 @@ private def testExclude (data : TestData) : Test := withTestDir data fun jsonDir fail "LitConfig.Core should still have HTML output after exclude" let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") let navbarSection := litConfigHtml.splitOn "module-tree" |>.getD 1 "" |>.splitOn "" |>.head! - if hasSubstring navbarSection "NoDocstrings" then - fail "Navbar should not contain excluded module 'NoDocstrings'" + assertNotContains "NoDocstrings" navbarSection + "Navbar should not contain excluded module 'NoDocstrings'" /-- The `order` config controls the ordering of modules in the navbar. -/ private def testNavbarOrder (data : TestData) : Test := withTestDir data fun jsonDir htmlDir planFile tomlFile => do @@ -339,8 +336,8 @@ private def testLandingPage (data : TestData) : Test := withTestDir data fun jso runLiterateHtml jsonDir htmlDir (some planFile) (some tomlFile) let landingHtml ← IO.FS.readFile (htmlDir / "index.html") - unless hasSubstring landingHtml "Core Module" do - fail "Landing page should contain 'Core Module' content from the configured landing module" + assertContains "Core Module" landingHtml + "Landing page should contain 'Core Module' content from the configured landing module" unless ← (htmlDir / "LitConfig" / "Core" / "index.html").pathExists do fail "Core module should still exist at its normal location" @@ -354,8 +351,8 @@ private def testHtmlLandingPageNotFound (data : TestData) : Test := withTestDir let (exitCode, _, stderr) ← runLiterateHtmlCapture jsonDir htmlDir (some planFile) (some tomlFile) if exitCode == 0 then fail "HTML landing_page not found: should have failed with non-zero exit code" - unless hasSubstring stderr "not found" do - fail "HTML landing_page not found: stderr should mention 'not found'" + assertContains "not found" stderr + "HTML landing_page not found: stderr should mention 'not found'" /-- Excluding a parent module also removes all its children from the output. -/ private def testRecursiveExclusion (data : TestData) : Test := withTestDir data fun jsonDir htmlDir planFile tomlFile => do @@ -480,10 +477,10 @@ private def testHideCommands (data : TestData) : Test := withTestDir data fun js runLiterateHtml jsonDir htmlDir (configFile := some tomlFile) let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") - if hasSubstring litConfigHtml "set_option" then - fail "hide_commands: LitConfig page should not contain 'set_option' text" - unless hasSubstring litConfigHtml "hello" do - fail "hide_commands: LitConfig page should still contain 'hello'" + assertNotContains "set_option" litConfigHtml + "hide_commands: LitConfig page should not contain 'set_option' text" + assertContains "hello" litConfigHtml + "hide_commands: LitConfig page should still contain 'hello'" /-- The metadata title appears in the landing page and module page `` tags. -/ private def testMetadataTitle (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ tomlFile => do @@ -491,13 +488,13 @@ private def testMetadataTitle (data : TestData) : Test := withTestDir data fun j runLiterateHtml jsonDir htmlDir (configFile := some tomlFile) let landingHtml ← IO.FS.readFile (htmlDir / "index.html") - unless hasSubstring landingHtml "<title>Test Site" do - fail "metadata title: landing page should contain 'Test Site'" + assertContains "<title>Test Site" landingHtml + "metadata title: landing page should contain 'Test Site'" let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") - unless hasSubstring litConfigHtml "LitConfig" do - fail "metadata title: module page should still contain module name 'LitConfig'" - unless hasSubstring litConfigHtml "Test Site" do - fail "metadata title: module page title should contain 'Test Site'" + assertContains "LitConfig" litConfigHtml + "metadata title: module page should still contain module name 'LitConfig'" + assertContains "Test Site" litConfigHtml + "metadata title: module page title should contain 'Test Site'" /-- Extra CSS files are copied to the output directory and linked in the HTML head. -/ private def testExtraCss (data : TestData) : Test := IO.FS.withTempDir fun tmpDir => do @@ -512,8 +509,8 @@ private def testExtraCss (data : TestData) : Test := IO.FS.withTempDir fun tmpDi unless ← (htmlDir / "custom-test.css").pathExists do fail "extra CSS: custom-test.css was not copied to output" let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") - unless hasSubstring litConfigHtml "custom-test.css" do - fail "extra CSS: HTML does not reference custom-test.css" + assertContains "custom-test.css" litConfigHtml + "extra CSS: HTML does not reference custom-test.css" /-- Declaration docstrings are hidden globally while module docstrings remain visible. -/ private def testShowDocstringsFalse (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ tomlFile => do @@ -521,10 +518,10 @@ private def testShowDocstringsFalse (data : TestData) : Test := withTestDir data runLiterateHtml jsonDir htmlDir (configFile := some tomlFile) let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") - if hasSubstring litConfigHtml "A greeting message" then - fail "show_docstrings=false: declaration docstring 'A greeting message' should be hidden" - unless hasSubstring litConfigHtml "A Test Module" do - fail "show_docstrings=false: module docstring 'A Test Module' should still appear" + assertNotContains "A greeting message" litConfigHtml + "show_docstrings=false: declaration docstring 'A greeting message' should be hidden" + assertContains "A Test Module" litConfigHtml + "show_docstrings=false: module docstring 'A Test Module' should still appear" /-- `show_imports = false` hides the imports list. -/ private def testShowImportsFalse (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ tomlFile => do @@ -532,18 +529,18 @@ private def testShowImportsFalse (data : TestData) : Test := withTestDir data fu runLiterateHtml jsonDir htmlDir (configFile := some tomlFile) let coreHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "Core" / "index.html") - if hasSubstring coreHtml "imports-list" then - fail "show_imports=false: page should not contain 'imports-list'" + assertNotContains "imports-list" coreHtml + "show_imports=false: page should not contain 'imports-list'" /-- Default config shows imports in a collapsible details element. -/ private def testShowImportsDefault (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ _ => do runLiterateHtml jsonDir htmlDir let coreHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "Core" / "index.html") - unless hasSubstring coreHtml "imports-list" do - fail "show_imports default: Core page should contain 'imports-list'" - unless hasSubstring coreHtml "<details" do - fail "show_imports default: imports should be in a collapsible <details> element" + assertContains "imports-list" coreHtml + "show_imports default: Core page should contain 'imports-list'" + assertContains "<details" coreHtml + "show_imports default: imports should be in a collapsible <details> element" /-- Default config renders output blocks for #eval commands. -/ private def testShowOutput (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ _ => do @@ -551,8 +548,8 @@ private def testShowOutput (data : TestData) : Test := withTestDir data fun json let coreHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "Core" / "index.html") -- Check for an actual lean-output element (class on a <pre> tag), not just the CSS rules - unless hasSubstring coreHtml "class=\"hl lean lean-output" do - fail "show_output default: Core page should contain output block elements for #eval commands" + assertContains "class=\"hl lean lean-output" coreHtml + "show_output default: Core page should contain output block elements for #eval commands" /-- `show_output = []` suppresses all output blocks. -/ private def testShowOutputEmpty (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ tomlFile => do @@ -561,8 +558,8 @@ private def testShowOutputEmpty (data : TestData) : Test := withTestDir data fun let coreHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "Core" / "index.html") -- Check that no actual lean-output elements exist (CSS rules in `<style>` don't count) - if hasSubstring coreHtml "class=\"hl lean lean-output" then - fail "show_output=[]: Core page should not contain output block elements" + assertNotContains "class=\"hl lean lean-output" coreHtml + "show_output=[]: Core page should not contain output block elements" /-- Docstrings are hidden for specific named declarations while other content remains. -/ private def testHideDocstringsFor (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ tomlFile => do @@ -570,10 +567,10 @@ private def testHideDocstringsFor (data : TestData) : Test := withTestDir data f runLiterateHtml jsonDir htmlDir (configFile := some tomlFile) let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") - if hasSubstring litConfigHtml "A greeting message" then - fail "hide_docstrings_for: 'A greeting message' should be hidden for 'hello'" - unless hasSubstring litConfigHtml "A Test Module" do - fail "hide_docstrings_for: module docstring 'A Test Module' should still appear" + assertNotContains "A greeting message" litConfigHtml + "hide_docstrings_for: 'A greeting message' should be hidden for 'hello'" + assertContains "A Test Module" litConfigHtml + "hide_docstrings_for: module docstring 'A Test Module' should still appear" /-- Favicon is copied to the output directory and linked in the HTML. -/ private def testFavicon (data : TestData) : Test := IO.FS.withTempDir fun tmpDir => do @@ -588,8 +585,8 @@ private def testFavicon (data : TestData) : Test := IO.FS.withTempDir fun tmpDir unless ← (htmlDir / "test-favicon.png").pathExists do fail "favicon: test-favicon.png was not copied to output" let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") - unless hasSubstring litConfigHtml "test-favicon.png" do - fail "favicon: HTML does not reference test-favicon.png" + assertContains "test-favicon.png" litConfigHtml + "favicon: HTML does not reference test-favicon.png" /-- Extra JS files are copied to the output directory and linked in the HTML. -/ private def testExtraJs (data : TestData) : Test := IO.FS.withTempDir fun tmpDir => do @@ -604,8 +601,8 @@ private def testExtraJs (data : TestData) : Test := IO.FS.withTempDir fun tmpDir unless ← (htmlDir / "custom-test.js").pathExists do fail "extra JS: custom-test.js was not copied to output" let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") - unless hasSubstring litConfigHtml "custom-test.js" do - fail "extra JS: HTML does not reference custom-test.js" + assertContains "custom-test.js" litConfigHtml + "extra JS: HTML does not reference custom-test.js" /-- Targets + exclude: exclusion narrows the target set. -/ private def testTargetsPlusExclude (data : TestData) : Test := withTestDir data fun jsonDir htmlDir planFile tomlFile => do @@ -626,12 +623,12 @@ private def testShowDocstringsForExceptions (data : TestData) : Test := withTest runLiterateHtml jsonDir htmlDir (configFile := some tomlFile) let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") - unless hasSubstring litConfigHtml "A greeting message" do - fail "show_docstrings_for exception: 'A greeting message' should be visible for 'hello'" + assertContains "A greeting message" litConfigHtml + "show_docstrings_for exception: 'A greeting message' should be visible for 'hello'" -- Other declaration docstrings should be hidden (e.g., in Core module) let coreHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "Core" / "index.html") - if hasSubstring coreHtml "Doubles a natural number" then - fail "show_docstrings_for exception: 'Doubles a natural number' should be hidden" + assertNotContains "Doubles a natural number" coreHtml + "show_docstrings_for exception: 'Doubles a natural number' should be hidden" /-- Metadata description appears as a meta tag in the HTML. -/ private def testMetadataDescription (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ tomlFile => do @@ -639,10 +636,10 @@ private def testMetadataDescription (data : TestData) : Test := withTestDir data runLiterateHtml jsonDir htmlDir (configFile := some tomlFile) let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") - unless hasSubstring litConfigHtml "A test description" do - fail "metadata description: HTML should contain 'A test description'" - unless hasSubstring litConfigHtml "meta" do - fail "metadata description: HTML should contain a meta tag" + assertContains "A test description" litConfigHtml + "metadata description: HTML should contain 'A test description'" + assertContains "meta" litConfigHtml + "metadata description: HTML should contain a meta tag" /-- The current page is highlighted in the navbar with the 'current' class. -/ private def testCurrentPageHighlighting (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ _ => do @@ -651,8 +648,8 @@ private def testCurrentPageHighlighting (data : TestData) : Test := withTestDir let coreHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "Core" / "index.html") let navbarSection := coreHtml.splitOn "module-tree" |>.getD 1 "" |>.splitOn "</nav>" |>.head! -- The Core entry should have a 'current' class - unless hasSubstring navbarSection "current" do - fail "current page highlighting: navbar should contain 'current' class" + assertContains "current" navbarSection + "current page highlighting: navbar should contain 'current' class" /-- Plan with targets + exclude combined produces the correct reduced module set. -/ private def testPlanTargetsPlusExclude (data : TestData) : Test := IO.FS.withTempDir fun tmpDir => do @@ -677,8 +674,8 @@ private def testPlanLandingPageNotInSet (data : TestData) : Test := IO.FS.withTe let (exitCode, _, stderr) ← runLiteratePlanCapture data.moduleListFile planFile (some tomlFile) if exitCode == 0 then fail "plan landing_page validation: should have failed with non-zero exit code" - unless hasSubstring stderr "landing_page" do - fail "plan landing_page validation: stderr should mention 'landing_page'" + assertContains "landing_page" stderr + "plan landing_page validation: stderr should mention 'landing_page'" /-- Plan fails with error when all modules are excluded (empty module set). -/ private def testPlanEmptyModuleSet (data : TestData) : Test := IO.FS.withTempDir fun tmpDir => do @@ -688,8 +685,8 @@ private def testPlanEmptyModuleSet (data : TestData) : Test := IO.FS.withTempDir let (exitCode, _, stderr) ← runLiteratePlanCapture data.moduleListFile planFile (some tomlFile) if exitCode == 0 then fail "plan empty module set: should have failed with non-zero exit code" - unless hasSubstring stderr "no modules" do - fail "plan empty module set: stderr should mention 'no modules'" + assertContains "no modules" stderr + "plan empty module set: stderr should mention 'no modules'" /-- Plan succeeds with a warning when an ordered module does not exist. -/ private def testPlanOrderWarning (data : TestData) : Test := IO.FS.withTempDir fun tmpDir => do @@ -699,10 +696,10 @@ private def testPlanOrderWarning (data : TestData) : Test := IO.FS.withTempDir f let (exitCode, _, stderr) ← runLiteratePlanCapture data.moduleListFile planFile (some tomlFile) if exitCode != 0 then fail "plan order warning: should succeed (warning only, not error)" - unless hasSubstring stderr "Warning" do - fail "plan order warning: stderr should contain a warning" - unless hasSubstring stderr "NonExistent.Module" do - fail "plan order warning: stderr should mention 'NonExistent.Module'" + assertContains "Warning" stderr + "plan order warning: stderr should contain a warning" + assertContains "NonExistent.Module" stderr + "plan order warning: stderr should mention 'NonExistent.Module'" /-- HTML generation fails when hide_docstrings_for names a nonexistent declaration. -/ private def testHtmlInvalidDocstringFor (data : TestData) : Test := IO.FS.withTempDir fun tmpDir => do @@ -713,8 +710,8 @@ private def testHtmlInvalidDocstringFor (data : TestData) : Test := IO.FS.withTe let (exitCode, _, stderr) ← runLiterateHtmlCapture data.jsonDir htmlDir (configFile := some tomlFile) if exitCode == 0 then fail "HTML invalid docstring_for: should have failed with non-zero exit code" - unless hasSubstring stderr "nonexistent_decl" do - fail "HTML invalid docstring_for: stderr should mention 'nonexistent_decl'" + assertContains "nonexistent_decl" stderr + "HTML invalid docstring_for: stderr should mention 'nonexistent_decl'" /-- Theme CSS file is generated and linked when theme overrides are present. -/ private def testThemeCss (data : TestData) : Test := IO.FS.withTempDir fun tmpDir => do @@ -735,19 +732,19 @@ private def testThemeCss (data : TestData) : Test := IO.FS.withTempDir fun tmpDi unless ← (htmlDir / "literate-theme.css").pathExists do fail "theme: literate-theme.css was not generated" let themeCss ← IO.FS.readFile (htmlDir / "literate-theme.css") - unless hasSubstring themeCss "--verso-code-box-background-color" do - fail "theme: literate-theme.css does not contain code box variable" - unless hasSubstring themeCss "#f0f0f0" do - fail "theme: literate-theme.css does not contain light value" - unless hasSubstring themeCss "prefers-color-scheme: dark" do - fail "theme: literate-theme.css does not contain dark media query" - unless hasSubstring themeCss "#ddd" do - fail "theme: literate-theme.css does not contain dark value" - unless hasSubstring themeCss "data-theme" do - fail "theme: literate-theme.css does not contain data-theme selector" + assertContains "--verso-code-box-background-color" themeCss + "theme: literate-theme.css does not contain code box variable" + assertContains "#f0f0f0" themeCss + "theme: literate-theme.css does not contain light value" + assertContains "prefers-color-scheme: dark" themeCss + "theme: literate-theme.css does not contain dark media query" + assertContains "#ddd" themeCss + "theme: literate-theme.css does not contain dark value" + assertContains "data-theme" themeCss + "theme: literate-theme.css does not contain data-theme selector" let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") - unless hasSubstring litConfigHtml "literate-theme.css" do - fail "theme: HTML does not link literate-theme.css" + assertContains "literate-theme.css" litConfigHtml + "theme: HTML does not link literate-theme.css" /-- No theme CSS file is generated when theme is empty. -/ private def testThemeCssEmpty (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ _ => do @@ -755,8 +752,8 @@ private def testThemeCssEmpty (data : TestData) : Test := withTestDir data fun j if ← (htmlDir / "literate-theme.css").pathExists then fail "theme empty: literate-theme.css should not exist with default config" let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") - if hasSubstring litConfigHtml "literate-theme.css" then - fail "theme empty: HTML should not link literate-theme.css when no theme is set" + assertNotContains "literate-theme.css" litConfigHtml + "theme empty: HTML should not link literate-theme.css when no theme is set" /-- Per-module hide_commands overrides global config. -/ private def testPerModuleHideCommands (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ tomlFile => do @@ -768,12 +765,12 @@ private def testPerModuleHideCommands (data : TestData) : Test := withTestDir da runLiterateHtml jsonDir htmlDir (configFile := some tomlFile) let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") - if hasSubstring litConfigHtml "set_option" then - fail "per-module hide_commands: LitConfig should not contain 'set_option'" + assertNotContains "set_option" litConfigHtml + "per-module hide_commands: LitConfig should not contain 'set_option'" -- Core should NOT be affected (no module config) let coreHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "Core" / "index.html") - unless hasSubstring coreHtml "code-box" do - fail "per-module hide_commands: Core should still have code boxes" + assertContains "code-box" coreHtml + "per-module hide_commands: Core should still have code boxes" /-- Per-module title appears in the page title and navbar. -/ private def testPerModuleTitle (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ tomlFile => do @@ -785,13 +782,13 @@ private def testPerModuleTitle (data : TestData) : Test := withTestDir data fun runLiterateHtml jsonDir htmlDir (configFile := some tomlFile) let coreHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "Core" / "index.html") - unless hasSubstring coreHtml "Core Library" do - fail "per-module title: page should contain 'Core Library'" + assertContains "Core Library" coreHtml + "per-module title: page should contain 'Core Library'" -- Check navbar let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") let navbarSection := litConfigHtml.splitOn "module-tree" |>.getD 1 "" |>.splitOn "</nav>" |>.head! - unless hasSubstring navbarSection "Core Library" do - fail "per-module title: navbar should contain 'Core Library'" + assertContains "Core Library" navbarSection + "per-module title: navbar should contain 'Core Library'" /-- Per-module title appears in breadcrumbs without code formatting. -/ private def testPerModuleTitleBreadcrumbs (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ tomlFile => do @@ -806,21 +803,21 @@ private def testPerModuleTitleBreadcrumbs (data : TestData) : Test := withTestDi let coreHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "Core" / "index.html") let breadcrumbSection := coreHtml.splitOn "breadcrumbs" |>.getD 1 "" |>.splitOn "</ol>" |>.head! -- Custom title should appear without <code> wrapping - unless hasSubstring breadcrumbSection "Core Library" do - fail "title breadcrumbs: should display custom title 'Core Library'" - if hasSubstring breadcrumbSection "<code>Core Library</code>" then - fail "title breadcrumbs: custom title should not be wrapped in <code>" + assertContains "Core Library" breadcrumbSection + "title breadcrumbs: should display custom title 'Core Library'" + assertNotContains "<code>Core Library</code>" breadcrumbSection + "title breadcrumbs: custom title should not be wrapped in <code>" -- On a child page, the ancestor breadcrumb should show "Core Library" as a link let basicHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "Core" / "Basic" / "index.html") let childBcSection := basicHtml.splitOn "breadcrumbs" |>.getD 1 "" |>.splitOn "</ol>" |>.head! - unless hasSubstring childBcSection "Core Library" do - fail "title breadcrumbs: child page should show ancestor custom title 'Core Library'" + assertContains "Core Library" childBcSection + "title breadcrumbs: child page should show ancestor custom title 'Core Library'" -- The ancestor link with custom title should not use <code> - if hasSubstring childBcSection "<code>Core Library</code>" then - fail "title breadcrumbs: ancestor custom title should not be wrapped in <code>" + assertNotContains "<code>Core Library</code>" childBcSection + "title breadcrumbs: ancestor custom title should not be wrapped in <code>" -- But the "LitConfig" ancestor should still use <code> (no custom title) - unless hasSubstring childBcSection "<code>LitConfig</code>" do - fail "title breadcrumbs: module name ancestor should be in <code>" + assertContains "<code>LitConfig</code>" childBcSection + "title breadcrumbs: module name ancestor should be in <code>" /-- Per-module URL override places the HTML at the custom path and updates navbar links. -/ private def testPerModuleUrl (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ tomlFile => do @@ -839,26 +836,26 @@ private def testPerModuleUrl (data : TestData) : Test := withTestDir data fun js -- Navbar should link to the custom URL let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") let navbarSection := litConfigHtml.splitOn "module-tree" |>.getD 1 "" |>.splitOn "</nav>" |>.head! - unless hasSubstring navbarSection "core-docs/" do - fail "per-module url: navbar should link to 'core-docs/'" + assertContains "core-docs/" navbarSection + "per-module url: navbar should link to 'core-docs/'" -- Base href should reflect custom URL depth (1 segment = "../"), not module name depth let coreDocsHtml ← IO.FS.readFile (htmlDir / "core-docs" / "index.html") - unless hasSubstring coreDocsHtml "base href=\"../\"" do - fail "per-module url: base href should be '../' (depth 1), not '../../../' (depth 3)" + assertContains "base href=\"../\"" coreDocsHtml + "per-module url: base href should be '../' (depth 1), not '../../../' (depth 3)" -- Breadcrumbs should show module name labels (not URL segments) let breadcrumbSection := coreDocsHtml.splitOn "breadcrumbs" |>.getD 1 "" |>.splitOn "</ol>" |>.head! -- The breadcrumb should display "Core" (module name), not "core-docs" (URL segment) - unless hasSubstring breadcrumbSection ">Core<" do - fail "per-module url: breadcrumb should display module name 'Core'" + assertContains ">Core<" breadcrumbSection + "per-module url: breadcrumb should display module name 'Core'" -- The ancestor breadcrumb should link to LitConfig/ - unless hasSubstring breadcrumbSection "href=\"LitConfig/\"" do - fail "per-module url: ancestor breadcrumb should link to 'LitConfig/'" + assertContains "href=\"LitConfig/\"" breadcrumbSection + "per-module url: ancestor breadcrumb should link to 'LitConfig/'" -- Landing page should link to custom URL let landingHtml ← IO.FS.readFile (htmlDir / "index.html") - unless hasSubstring landingHtml "core-docs/" do - fail "per-module url: landing page should link to 'core-docs/'" - if hasSubstring (landingHtml.splitOn "module-toc" |>.getD 1 "" |>.splitOn "</ul>" |>.head!) "LitConfig/Core/" then - fail "per-module url: landing page should not link to 'LitConfig/Core/'" + assertContains "core-docs/" landingHtml + "per-module url: landing page should link to 'core-docs/'" + assertNotContains "LitConfig/Core/" (landingHtml.splitOn "module-toc" |>.getD 1 "" |>.splitOn "</ul>" |>.head!) + "per-module url: landing page should not link to 'LitConfig/Core/'" /-- URL overrides on a parent module propagate to children via relative append. -/ private def testPerModuleUrlInheritance (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ tomlFile => do @@ -876,12 +873,12 @@ private def testPerModuleUrlInheritance (data : TestData) : Test := withTestDir fail "url inheritance: HTML should not exist at default path LitConfig/Core/Basic/" -- Base href for child should reflect depth 2 (core-docs/Basic) let childHtml ← IO.FS.readFile (htmlDir / "core-docs" / "Basic" / "index.html") - unless hasSubstring childHtml "base href=\"../../\"" do - fail "url inheritance: child base href should be '../../' (depth 2)" + assertContains "base href=\"../../\"" childHtml + "url inheritance: child base href should be '../../' (depth 2)" -- Navbar should link to the child at core-docs/Basic/ let navbarSection := childHtml.splitOn "module-tree" |>.getD 1 "" |>.splitOn "</nav>" |>.head! - unless hasSubstring navbarSection "core-docs/Basic/" do - fail "url inheritance: navbar should link to 'core-docs/Basic/'" + assertContains "core-docs/Basic/" navbarSection + "url inheritance: navbar should link to 'core-docs/Basic/'" /-- Plan fails when two modules resolve to the same URL. -/ private def testPlanDuplicateUrl (data : TestData) : Test := IO.FS.withTempDir fun tmpDir => do @@ -897,8 +894,8 @@ private def testPlanDuplicateUrl (data : TestData) : Test := IO.FS.withTempDir f let (exitCode, _, stderr) ← runLiteratePlanCapture data.moduleListFile planFile (some tomlFile) if exitCode == 0 then fail "plan duplicate url: should have failed with non-zero exit code" - unless hasSubstring stderr "same URL" do - fail s!"plan duplicate url: stderr should mention 'same URL', got: {stderr}" + assertContains "same URL" stderr + s!"plan duplicate url: stderr should mention 'same URL', got: {stderr}" /-- URLs that differ only by a trailing slash are detected as duplicates. -/ private def testPlanDuplicateUrlTrailingSlash (data : TestData) : Test := IO.FS.withTempDir fun tmpDir => do @@ -912,8 +909,8 @@ private def testPlanDuplicateUrlTrailingSlash (data : TestData) : Test := IO.FS. let (exitCode, _, stderr) ← runLiteratePlanCapture data.moduleListFile planFile (some tomlFile) if exitCode == 0 then fail "plan duplicate url trailing slash: should have failed with non-zero exit code" - unless hasSubstring stderr "same URL" do - fail s!"plan duplicate url trailing slash: stderr should mention 'same URL', got: {stderr}" + assertContains "same URL" stderr + s!"plan duplicate url trailing slash: stderr should mention 'same URL', got: {stderr}" /-- URLs that differ only in case are detected as duplicates. -/ private def testPlanDuplicateUrlCase (data : TestData) : Test := IO.FS.withTempDir fun tmpDir => do @@ -929,42 +926,42 @@ private def testPlanDuplicateUrlCase (data : TestData) : Test := IO.FS.withTempD let (exitCode, _, stderr) ← runLiteratePlanCapture data.moduleListFile planFile (some tomlFile) if exitCode == 0 then fail "plan duplicate url case: should have failed with non-zero exit code" - unless hasSubstring stderr "differ only in case" do - fail s!"plan duplicate url case: stderr should mention 'differ only in case', got: {stderr}" + assertContains "differ only in case" stderr + s!"plan duplicate url case: stderr should mention 'differ only in case', got: {stderr}" /-- CSS contains focus-visible indicators. -/ private def testAccessibilityFocusVisible (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ _ => do runLiterateHtml jsonDir htmlDir let css ← IO.FS.readFile (htmlDir / "literate.css") - unless hasSubstring css "focus-visible" do - fail "accessibility: literate.css does not contain focus-visible rules" + assertContains "focus-visible" css + "accessibility: literate.css does not contain focus-visible rules" /-- CSS contains prefers-reduced-motion rules. -/ private def testAccessibilityReducedMotion (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ _ => do runLiterateHtml jsonDir htmlDir let css ← IO.FS.readFile (htmlDir / "literate.css") - unless hasSubstring css "prefers-reduced-motion" do - fail "accessibility: literate.css does not contain prefers-reduced-motion" + assertContains "prefers-reduced-motion" css + "accessibility: literate.css does not contain prefers-reduced-motion" /-- Hamburger menu has ARIA attributes. -/ private def testAccessibilityAria (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ _ => do runLiterateHtml jsonDir htmlDir let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") - unless hasSubstring litConfigHtml "aria-label=\"Menu\"" do - fail "accessibility: hamburger input missing aria-label" - unless hasSubstring litConfigHtml "aria-label=\"Toggle navigation\"" do - fail "accessibility: hamburger label missing aria-label" + assertContains "aria-label=\"Menu\"" litConfigHtml + "accessibility: hamburger input missing aria-label" + assertContains "aria-label=\"Toggle navigation\"" litConfigHtml + "accessibility: hamburger label missing aria-label" /-- LitConfig root module (with headings) gets a page ToC. -/ private def testPageToc (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ _ => do runLiterateHtml jsonDir htmlDir let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") - unless hasSubstring litConfigHtml "page-toc" do - fail "page ToC: LitConfig page should contain page-toc" - unless hasSubstring litConfigHtml "Page table of contents" do - fail "page ToC: page-toc should have aria-label" - unless hasSubstring litConfigHtml "On this page" do - fail "page ToC: page-toc should contain 'On this page' title" + assertContains "page-toc" litConfigHtml + "page ToC: LitConfig page should contain page-toc" + assertContains "Page table of contents" litConfigHtml + "page ToC: page-toc should have aria-label" + assertContains "On this page" litConfigHtml + "page ToC: page-toc should contain 'On this page' title" /-- Page ToC entries for headings in the same modDoc block have distinct anchors. -/ private def testPageTocDistinctAnchors (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ _ => do @@ -985,16 +982,16 @@ private def testPageTocDistinctAnchors (data : TestData) : Test := withTestDir d for href in hrefs do let parts := href.splitOn "#" if let _ :: anchor :: _ := parts then - unless hasSubstring litConfigHtml s!"id=\"{anchor}\"" do - fail s!"page ToC distinct anchors: anchor '{anchor}' not found as an id in the HTML" + assertContains s!"id=\"{anchor}\"" litConfigHtml + s!"page ToC distinct anchors: anchor '{anchor}' not found as an id in the HTML" /-- Nested Verso sections produce distinct ToC entries at each level. -/ private def testPageTocNestedSections (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ _ => do runLiterateHtml jsonDir htmlDir let coreHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "Core" / "index.html") -- Should have a page ToC - unless hasSubstring coreHtml "page-toc" do - fail "nested ToC: Core page should have a page-toc" + assertContains "page-toc" coreHtml + "nested ToC: Core page should have a page-toc" let tocSection := coreHtml.splitOn "<nav class=\"page-toc\"" |>.getD 1 "" |>.splitOn "</nav>" |>.head! let hrefs := tocSection.splitOn "href=\"" |>.drop 1 |>.map fun s => s.splitOn "\"" |>.head! -- Should have at least 3 headings (Core Module, Natural Number Utilities, Doubling) @@ -1008,22 +1005,22 @@ private def testPageTocNestedSections (data : TestData) : Test := withTestDir da for href in hrefs do let parts := href.splitOn "#" if let _ :: anchor :: _ := parts then - unless hasSubstring coreHtml s!"id=\"{anchor}\"" do - fail s!"nested ToC: anchor '{anchor}' not found as id in HTML" + assertContains s!"id=\"{anchor}\"" coreHtml + s!"nested ToC: anchor '{anchor}' not found as id in HTML" /-- NoDocstrings module (no headings) should not get a page ToC. -/ private def testPageTocAbsent (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ _ => do runLiterateHtml jsonDir htmlDir let noDocHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "NoDocstrings" / "index.html") - if hasSubstring noDocHtml "page-toc" then - fail "page ToC absent: NoDocstrings page should not have a page-toc" + assertNotContains "page-toc" noDocHtml + "page ToC absent: NoDocstrings page should not have a page-toc" /-- CSS contains dark mode defaults. -/ private def testCssDarkMode (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ _ => do runLiterateHtml jsonDir htmlDir let css ← IO.FS.readFile (htmlDir / "literate.css") - unless hasSubstring css "prefers-color-scheme: dark" do - fail "dark mode: literate.css does not contain dark mode media query" + assertContains "prefers-color-scheme: dark" css + "dark mode: literate.css does not contain dark mode media query" /-- Images referenced in module docstrings are copied to the output and their URLs are rewritten. -/ private def testImageCopying (data : TestData) (projectDir : System.FilePath) : Test := IO.FS.withTempDir fun tmpDir => do @@ -1045,13 +1042,13 @@ private def testImageCopying (data : TestData) (projectDir : System.FilePath) : -- Verify the HTML references the rewritten URL let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") - unless hasSubstring litConfigHtml "-verso-images/LitConfig--test-diagram.png" do - fail "image copying: HTML should reference rewritten image URL '-verso-images/LitConfig--test-diagram.png'" + assertContains "-verso-images/LitConfig--test-diagram.png" litConfigHtml + "image copying: HTML should reference rewritten image URL '-verso-images/LitConfig--test-diagram.png'" -- Verify the raw source-relative path does NOT appear as an unprocessed img src let srcAttrRaw := "src=\"images/test-diagram.png\"" - if hasSubstring litConfigHtml srcAttrRaw then - fail s!"image copying: HTML should not contain unprocessed '{srcAttrRaw}'" + assertNotContains srcAttrRaw litConfigHtml + s!"image copying: HTML should not contain unprocessed '{srcAttrRaw}'" /-- Image paths with '..' are resolved correctly and copied into the flat output directory. -/ private def testImagePathTraversal : Test := IO.FS.withTempDir fun tmpDir => do @@ -1089,12 +1086,12 @@ private def testSingleRootNavFlattening (data : TestData) : Test := withTestDir let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") let navbarSection := litConfigHtml.splitOn "module-tree" |>.getD 1 "" |>.splitOn "</nav>" |>.head! -- Should have a nav-title div for the single root - unless hasSubstring navbarSection "nav-title" do - fail "single-root nav: navbar should contain 'nav-title' class" + assertContains "nav-title" navbarSection + "single-root nav: navbar should contain 'nav-title' class" -- The top-level children should be direct leaves/details, not nested inside a root <details> -- Check that LitConfig appears in a nav-title, not in a <summary> - unless hasSubstring navbarSection "<div class=\"nav-title" do - fail "single-root nav: root entry should be a nav-title div, not a collapsible details" + assertContains "<div class=\"nav-title" navbarSection + "single-root nav: root entry should be a nav-title div, not a collapsible details" /-- `docstrings_as_text = true` renders declaration docstrings as prose (mod-doc class). -/ private def testDocstringsAsText (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ tomlFile => do @@ -1103,10 +1100,10 @@ private def testDocstringsAsText (data : TestData) : Test := withTestDir data fu let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") -- "A greeting message" docstring should appear as prose with mod-doc class - unless hasSubstring litConfigHtml "A greeting message" do - fail "docstrings_as_text: 'A greeting message' should still appear" - unless hasSubstring litConfigHtml "mod-doc" do - fail "docstrings_as_text: page should contain 'mod-doc' class for declaration docstrings" + assertContains "A greeting message" litConfigHtml + "docstrings_as_text: 'A greeting message' should still appear" + assertContains "mod-doc" litConfigHtml + "docstrings_as_text: page should contain 'mod-doc' class for declaration docstrings" /-- `docstrings_as_text` defaults to false: declaration docstrings render inside code boxes. -/ private def testDocstringsAsTextDefault (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ _ => do @@ -1114,8 +1111,8 @@ private def testDocstringsAsTextDefault (data : TestData) : Test := withTestDir let litConfigHtml ← IO.FS.readFile (htmlDir / "LitConfig" / "index.html") -- "A greeting message" should appear but NOT with mod-doc class on the declaration docstring div - unless hasSubstring litConfigHtml "A greeting message" do - fail "docstrings_as_text default: 'A greeting message' should appear" + assertContains "A greeting message" litConfigHtml + "docstrings_as_text default: 'A greeting message' should appear" -- The declaration docstring should be in a verso-text or md-text div WITHOUT mod-doc -- Check that the docstring text is not in a mod-doc div let parts := litConfigHtml.splitOn "A greeting message" @@ -1132,14 +1129,14 @@ private def testDocstringsAsTextDefault (data : TestData) : Test := withTestDir private def testCssCustomProperties (data : TestData) : Test := withTestDir data fun jsonDir htmlDir _ _ => do runLiterateHtml jsonDir htmlDir let css ← IO.FS.readFile (htmlDir / "literate.css") - unless hasSubstring css "--verso-text-color" do - fail "CSS vars: literate.css does not define --verso-text-color" - unless hasSubstring css "--verso-background-color" do - fail "CSS vars: literate.css does not define --verso-background-color" - unless hasSubstring css "--verso-link-color" do - fail "CSS vars: literate.css does not define --verso-link-color" - unless hasSubstring css "var(--verso-text-color)" do - fail "CSS vars: literate.css does not use var(--verso-text-color)" + assertContains "--verso-text-color" css + "CSS vars: literate.css does not define --verso-text-color" + assertContains "--verso-background-color" css + "CSS vars: literate.css does not define --verso-background-color" + assertContains "--verso-link-color" css + "CSS vars: literate.css does not define --verso-link-color" + assertContains "var(--verso-text-color)" css + "CSS vars: literate.css does not use var(--verso-text-color)" -- ===== Test runner ===== @@ -1268,16 +1265,16 @@ private def testMultiRootNavTree (data : TestData) : Test := withTestDir data fu let libAHtml ← IO.FS.readFile (htmlDir / "LibA" / "index.html") let navbarSection := libAHtml.splitOn "module-tree" |>.getD 1 "" |>.splitOn "</nav>" |>.head! -- Should NOT have nav-title (that's for single-root only) - if hasSubstring navbarSection "nav-title" then - fail "multi-root nav: navbar should not contain 'nav-title' class" + assertNotContains "nav-title" navbarSection + "multi-root nav: navbar should not contain 'nav-title' class" -- Should have both LibA and LibB as collapsible details - unless hasSubstring navbarSection "LibA" do - fail "multi-root nav: navbar should contain 'LibA'" - unless hasSubstring navbarSection "LibB" do - fail "multi-root nav: navbar should contain 'LibB'" + assertContains "LibA" navbarSection + "multi-root nav: navbar should contain 'LibA'" + assertContains "LibB" navbarSection + "multi-root nav: navbar should contain 'LibB'" -- Should use <details> for top-level entries - unless hasSubstring navbarSection "<details" do - fail "multi-root nav: navbar should use <details> for top-level entries" + assertContains "<details" navbarSection + "multi-root nav: navbar should use <details> for top-level entries" private def multiRootHtmlTests (data : TestData) : List (String × Test) := [ ("multi-root nav tree", testMultiRootNavTree data) diff --git a/src/tests/VersoTests/Options.lean b/src/tests/VersoTests/Options.lean new file mode 100644 index 000000000..f337cad25 --- /dev/null +++ b/src/tests/VersoTests/Options.lean @@ -0,0 +1,17 @@ +/- +Copyright (c) 2026 Lean FRO LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Author: David Thrane Christiansen +-/ +import Errata + +open Errata + +/-- +Reads the `check-tex` option so the runner counts it as recognized on every run. The runner warns +about options it never reads, and `check-tex` is otherwise read only by the TeX golden tests, which a +partial run can leave out. +-/ +@[test] +def checkTexRecognized : Test := do + let _ ← flag "check-tex" From ceaa78eb40e9899105ff7221da47c9945356ac24 Mon Sep 17 00:00:00 2001 From: David Thrane Christiansen <david@davidchristiansen.dk> Date: Thu, 25 Jun 2026 15:01:11 +0200 Subject: [PATCH 12/26] stx and exit --- lakefile.lean | 121 ++++++++++++++++++---------------- src/errata/Errata/Runner.lean | 4 +- src/errata/Errata/usage.txt | 7 +- 3 files changed, 73 insertions(+), 59 deletions(-) diff --git a/lakefile.lean b/lakefile.lean index fa0517e93..39e6880d2 100644 --- a/lakefile.lean +++ b/lakefile.lean @@ -166,16 +166,22 @@ lean_exe «errata-runner» where supportInterpreter := true needs := #[errataSelection] -/-- Whether a source file introduces Errata tests, by an `@[test]` attribute or a `#test_msgs` -command, the only two ways a test enters a module. -/ +/-- Whether a source file introduces Errata tests, by an `@[test]` attribute, a `#test_msgs` +command, or a `#test_guard` command. This drives the glob-coverage check, which reads source files +before anything is built; test discovery itself reads the compiled modules. -/ private def errataSourceHasTests (lines : List String) : Bool := lines.any fun line => let t := line.trimAsciiStart.copy - t.startsWith "@[test]" || t.startsWith "#test_msgs" + t.startsWith "@[test]" || t.startsWith "#test_msgs" || t.startsWith "#test_guard" -/-- Whether a source file participates in the module system: it leads with a `module` declaration. -/ -private def errataSourceIsModule (lines : List String) : Bool := - lines.any fun line => line.trimAscii.copy == "module" +/-- Reads a built module's `.olean` header: whether it participates in the module system, and whether +it records any `@[test]` (including those generated by `#test_msgs` and `#test_guard`). -/ +private def errataModuleInfo (oleanFile : System.FilePath) : IO (Bool × Bool) := do + let (data, region) ← Lean.readModuleData oleanFile + let hasTests := data.entries.any fun (name, entries) => name == `Errata.test && entries.size > 0 + let isModule := data.isModule + unsafe region.free + return (isModule, hasTests) /-- Generate the bridge module: `import all` the module-system test modules so their private tests are reachable, gathering them into `allTests` through `getAllTests%`. -/ @@ -196,32 +202,21 @@ private def errataMainSource (packageName : String) (mods : Array Lean.Name) (di def main (args : List String) : IO UInt32 :=\n \ Errata.runMain (allTests ++ getAllTests% \"{packageName}\" {modList}) args\n" -/-- The module a target spec `[package/]module[#test]` selects (the unit of execution). -/ -private def errataSpecModule (s : String) : String := - let afterPkg := match s.splitOn "/" with | [_, rest] => rest | _ => s - (afterPkg.splitOn "#").headD afterPkg - -/-- Whether a module is selected by the given target specs (empty selects everything). -/ -private def errataModuleSelected (specs : List String) (moduleName : Lean.Name) : Bool := - specs.isEmpty || specs.any fun s => - let n := moduleName.toString - n == s || n.startsWith (s ++ ".") - /-- -Splits driver arguments at the `--test-options` marker into module target specs and runner -passthrough arguments. Module specs precede the marker and may not look like options; everything -after the marker goes to the runner. +Splits driver arguments at the `--test-options` marker into library names and runner passthrough +arguments. Library names precede the marker and may not look like options; everything after the +marker goes to the runner. -/ private def errataSplitArgs (args : List String) : Except String (List String × List String) := - let (specs, rest) := + let (names, rest) := match args.span (· != "--test-options") with - | (specs, _ :: after) => (specs, after) - | (specs, []) => (specs, []) - match specs.find? (·.startsWith "-") with + | (names, _ :: after) => (names, after) + | (names, []) => (names, []) + match names.find? (·.startsWith "-") with | some opt => - .error s!"unexpected option '{opt}' among module specs; pass runner options after \ + .error s!"unexpected option '{opt}' among library names; pass runner options after \ `--test-options` (e.g. `lake test -- --test-options {opt}`)" - | none => .ok (specs, rest) + | none => .ok (names, rest) /-- Usage information for `lake test`, shared with `Errata.usage` through one text file. -/ private def errataUsage : String := include_str "src/errata/Errata/usage.txt" @@ -279,48 +274,64 @@ script «errata-test» (args) do if args.any (fun a => a == "--help" || a == "-h") then IO.println errataUsage return 0 - let (specs, runnerArgs) ← + let (libNames, runnerArgs) ← match errataSplitArgs args with | .ok result => pure result | .error msg => IO.eprintln s!"error: {msg}" IO.eprintln errataUsage return 1 - -- The module is the unit of execution; a test-level selector is rejected, not silently broadened. - for spec in specs do - if (spec.splitOn "#").length > 1 then - IO.eprintln s!"error: Errata runs whole modules; '{spec}' names a test. \ - Select the module '{errataSpecModule spec}' instead." - return 1 - let moduleSpecs := specs.map errataSpecModule - -- Gather the built modules and their source files. The module set is authoritative (it respects - -- each library's globs), so no annotated test is silently dropped. + -- Search the named libraries, or every library in the package by default. A name may be a bare + -- `Library` in this package or a `package/Library` reaching into a dependency, following Lake's + -- target syntax. The generated runner lib has no source until this script writes it, and no tests. + let candidates := ws.root.leanLibs.filter (·.name != `ErrataGenerated) + let libs ← + if libNames.isEmpty then pure candidates + else do + let mut chosen : Array Lake.LeanLib := #[] + for spec in libNames do + let lib? ← + match spec.splitOn "/" with + | [libName] => pure (candidates.find? (·.name == libName.toName)) + | [pkgName, libName] => + let pkgName := if pkgName.startsWith "@" then pkgName.drop 1 else pkgName + let pkg? := if pkgName.isEmpty then some ws.root else ws.findPackageByName? pkgName.toName + match pkg? with + | some pkg => pure (pkg.findLeanLib? libName.toName) + | none => + IO.eprintln s!"error: no package named '{pkgName}'" + return 1 + | _ => + IO.eprintln s!"error: invalid library spec '{spec}' (expected `Library` or `package/Library`)" + return 1 + match lib? with + | some lib => chosen := chosen.push lib + | none => + IO.eprintln s!"error: no library matches '{spec}'" + return 1 + pure chosen + -- Uncovered @[test] modules are a configuration error: fail rather than run an incomplete suite. + unless (← errataUncoveredTestModules ws).isEmpty do return 1 + -- Build every module in the selected libraries; their compiled `.olean` headers are authoritative + -- on which modules carry tests, so no test is dropped by a source-level heuristic. let modInfos ← runBuild do + let mut oleanJobs := #[] let mut infos : Array (Lean.Name × System.FilePath) := #[] - for lib in ws.root.leanLibs do - -- The generated runner lib has no source until this script writes it, and it holds no tests. - if lib.name == `ErrataGenerated then continue + for lib in libs do let mods ← (← lib.modules.fetch).await for m in mods do - infos := infos.push (m.name, m.leanFile) + oleanJobs := oleanJobs.push (← m.olean.fetch) + infos := infos.push (m.name, m.oleanFile) + let _ ← (Job.collectArray oleanJobs).await pure (Job.pure infos) - let allNames := modInfos.map (·.1) - -- Every selector must name a real module. - for spec in moduleSpecs do - unless allNames.any (fun n => n.toString == spec || n.toString.startsWith (spec ++ ".")) do - IO.eprintln s!"error: no module matches '{spec}'" - return 1 - -- Uncovered @[test] modules are a configuration error: fail rather than run an incomplete suite. - unless (← errataUncoveredTestModules ws).isEmpty do return 1 - -- A test module is a selected one whose source introduces tests. Module-system test modules go in - -- the bridge module (`import all`); non-module ones can only be imported by the non-module main. + -- A test module is one whose `.olean` records a test. Module-system test modules go in the bridge + -- module (`import all`); non-module ones can only be imported by the non-module main. let mut moduleMods : Array Lean.Name := #[] let mut nonModuleMods : Array Lean.Name := #[] - for (moduleName, path) in modInfos do - unless errataModuleSelected moduleSpecs moduleName do continue - let lines := (← IO.FS.readFile path).splitOn "\n" - if errataSourceHasTests lines then - if errataSourceIsModule lines then moduleMods := moduleMods.push moduleName + for (moduleName, oleanFile) in modInfos do + let (isModule, hasTests) ← errataModuleInfo oleanFile + if hasTests then + if isModule then moduleMods := moduleMods.push moduleName else nonModuleMods := nonModuleMods.push moduleName -- Write the generated sources, plus a `selection` file naming the chosen test set. The generated -- targets depend on that file, so a changed selection invalidates them through Lake's own trace. diff --git a/src/errata/Errata/Runner.lean b/src/errata/Errata/Runner.lean index d3faac0f6..20c9302d7 100644 --- a/src/errata/Errata/Runner.lean +++ b/src/errata/Errata/Runner.lean @@ -177,4 +177,6 @@ def runMain (entries : Array TestEntry) (args : List String) : IO UInt32 := do let unused := opts.options.toList.filterMap fun (k, _) => if used.contains k then none else some k unless unused.isEmpty do IO.eprintln s!"warning: option(s) provided but never read: {", ".intercalate unused}" - return UInt32.ofNat failures + -- A process exit status keeps only its low 8 bits, so report a failing run as 1 rather than the + -- count, which a multiple of 256 would otherwise wrap to 0. + return if failures == 0 then 0 else 1 diff --git a/src/errata/Errata/usage.txt b/src/errata/Errata/usage.txt index 72ea27980..f5b292966 100644 --- a/src/errata/Errata/usage.txt +++ b/src/errata/Errata/usage.txt @@ -2,10 +2,11 @@ Errata test runner Usage: lake test run every test in the package - lake test -- MODULE... run the tests in the given modules - lake test -- MODULE... --test-options OPTION... pass runner options after the marker + lake test -- LIBRARY... run the tests in the given libraries + lake test -- LIBRARY... --test-options OPTION... pass runner options after the marker -Runner options go after `--test-options`; tokens before it name modules in Lake target syntax. +Runner options go after `--test-options`; tokens before it name libraries. A library is a bare +`Library` in this package or a `package/Library` reaching into a dependency. Runner options: -v, --verbose Also report passes (truncating each test's results); repeat (-vv) for all. --update-golden Rewrite golden expected files instead of comparing. From db8432da156e1f3b4fd822d7428538708d6b5303 Mon Sep 17 00:00:00 2001 From: David Thrane Christiansen <david@davidchristiansen.dk> Date: Tue, 30 Jun 2026 11:08:52 +0200 Subject: [PATCH 13/26] widget better --- .github/workflows/ci.yml | 6 + lakefile.lean | 13 +- src/errata-tests/ErrataTests.lean | 66 ++- src/errata/Errata.lean | 2 + src/errata/Errata/Context.lean | 5 + src/errata/Errata/Discovery.lean | 82 +++ src/errata/Errata/NameJson.lean | 38 ++ src/errata/Errata/Report.lean | 24 +- src/errata/Errata/RunOne.lean | 117 +++++ src/errata/Errata/TestM.lean | 32 +- src/errata/Errata/Widget.lean | 268 ++++++++++ src/errata/Errata/widget/jsconfig.json | 8 + src/errata/Errata/widget/run_test_widget.js | 490 ++++++++++++++++++ .../Errata/widget/widget-externals.d.ts | 16 + src/errata/ErrataRunOne.lean | 84 +++ 15 files changed, 1227 insertions(+), 24 deletions(-) create mode 100644 src/errata/Errata/NameJson.lean create mode 100644 src/errata/Errata/RunOne.lean create mode 100644 src/errata/Errata/Widget.lean create mode 100644 src/errata/Errata/widget/jsconfig.json create mode 100644 src/errata/Errata/widget/run_test_widget.js create mode 100644 src/errata/Errata/widget/widget-externals.d.ts create mode 100644 src/errata/ErrataRunOne.lean diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index b6fcd8ecd..45dc54156 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -174,6 +174,12 @@ jobs: npx tsc --noEmit -p jsconfig.json popd + - name: Type check the run-test widget JS code + run: | + pushd src/errata/Errata/widget + npx tsc --noEmit -p jsconfig.json + popd + - name: Check the ToC width storage key stays in sync run: | # toc-resize.js and toc-resize-preload.js must agree on the localStorage diff --git a/lakefile.lean b/lakefile.lean index 39e6880d2..6c4c11685 100644 --- a/lakefile.lean +++ b/lakefile.lean @@ -129,10 +129,21 @@ input_file errataUsageFile where text := true path := "src/errata/Errata/usage.txt" +input_file errataRunTestWidgetJs where + text := true + path := "src/errata/Errata/widget/run_test_widget.js" + lean_lib Errata where srcDir := "src/errata" roots := #[`Errata] - needs := #[errataUsageFile] + needs := #[errataUsageFile, errataRunTestWidgetJs] + +-- Runs one test in a fresh process so the widget can stream its output and kill it on cancel. +@[default_target] +lean_exe «errata-run-one» where + srcDir := "src/errata" + root := `ErrataRunOne + supportInterpreter := true -- Tests that exercise Errata using Errata itself. lean_lib ErrataTests where diff --git a/src/errata-tests/ErrataTests.lean b/src/errata-tests/ErrataTests.lean index 57be99cfd..3a37ba317 100644 --- a/src/errata-tests/ErrataTests.lean +++ b/src/errata-tests/ErrataTests.lean @@ -111,7 +111,7 @@ def reportSilent : Test := do let fail : Result := { package := "p", moduleName := "M", test := "u", status := .fail { message := "boom" } } let out ← captureOutput do discard <| humanReport .silent #[pass, fail] assertContains "FAIL p/M u: boom" out.stdout - assertContains "1 passed, 1 failed, 0 errored, 0 skipped" out.stdout + assertContains "1 passed, 1 failed, 0 errors, 0 skipped" out.stdout assertEq 1 (out.stdout.splitOn "ok ").length /-- At verbose verbosity the report shows passes too. -/ @@ -152,3 +152,67 @@ def reportMarkdown : Test := do assertContains "<details open><summary>❌ <code>p/M</code> u: boom</summary>" md assertContains "expected 1\nactual 2" md assertContains "Summary by module" md + +/-- `runValue` reports a passing value as passed. -/ +@[test] +def runOnePasses : Test := do + let o ← runValue default (pure () : Test) + assertEq "passed" o.status + +/-- `runValue` reports a failing value as failed and carries its message. -/ +@[test] +def runOneFails : Test := do + let o ← runValue default (TestResult.fail { message := "boom" }) + assertEq "failed" o.status + assertEq (some "boom") o.message? + +/-- `runValue` reports a skipped value as skipped. -/ +@[test] +def runOneSkips : Test := do + let o ← runValue default (TestResult.skip "later") + assertEq "skipped" o.status + +/-- A failing run surfaces its captured output in the outcome. -/ +@[test] +def runOneCapturesOutput : Test := do + let o ← runValue default (do IO.println "trace line"; failHere "nope" : Test) + assertEq "failed" o.status + assertEq 1 o.output.size + assertEq "stdout" o.output[0]!.stream + assertContains "trace line" o.output[0]!.text + +/-- An outcome takes the most severe verdict among several named results. -/ +@[test] +def runOneAggregates : Test := do + let o ← runValue default (do result "a" (pure ()); result "b" (failHere "bad") : Test) + assertEq "failed" o.status + +/-- A passing run still surfaces its captured output. -/ +@[test] +def runOnePassOutput : Test := do + let o ← runValue default (do IO.println "printed"; return true : IO Bool) + assertEq "passed" o.status + assertEq 1 o.output.size + assertEq "stdout" o.output[0]!.stream + assertContains "printed" o.output[0]!.text + +/-- Captured output keeps stdout and stderr distinct and interleaved in order. -/ +@[test] +def runOneStreams : Test := do + let o ← runValue default (do + IO.println "out one" + IO.eprintln "err one" + IO.println "out two" + return true : IO Bool) + assertEq "passed" o.status + assertEq 3 o.output.size + assertEq "stdout" o.output[0]!.stream + assertEq "stderr" o.output[1]!.stream + assertEq "stdout" o.output[2]!.stream +/-- `failure` from the `Alternative` instance fails a test. -/ +@[test] +def alternativeFailure : Test := expectFail failure + +/-- `<|>` recovers from an assertion failure by running the alternative. -/ +@[test] +def alternativeOrElse : Test := failure <|> assertEq 1 1 \ No newline at end of file diff --git a/src/errata/Errata.lean b/src/errata/Errata.lean index 1760f91cd..aa5358daf 100644 --- a/src/errata/Errata.lean +++ b/src/errata/Errata.lean @@ -15,6 +15,8 @@ public import Errata.Process public import Errata.Golden public import Errata.Report public import Errata.Runner +public import Errata.NameJson +public import Errata.RunOne public import Errata.Discovery public import Errata.CompileTime public import Errata.Property diff --git a/src/errata/Errata/Context.lean b/src/errata/Errata/Context.lean index b8f2db2e9..ff137f47a 100644 --- a/src/errata/Errata/Context.lean +++ b/src/errata/Errata/Context.lean @@ -48,3 +48,8 @@ structure Context where log : IO.Ref (Array Result) /-- The option names read during the run, shared across all tests, for reporting unused options. -/ usedOptions : IO.Ref (HashSet String) + /-- + Receives each captured output fragment as it is written, in order. The default discards them; a + live runner sets it to stream output as the test produces it. + -/ + writeOutput : Output → IO Unit := fun _ => pure () diff --git a/src/errata/Errata/Discovery.lean b/src/errata/Errata/Discovery.lean index d1057d7c2..41971f7a2 100644 --- a/src/errata/Errata/Discovery.lean +++ b/src/errata/Errata/Discovery.lean @@ -9,6 +9,8 @@ public import Errata.IsTest public import Errata.Runner public import Lean public meta import Lean +public meta import Errata.NameJson +public meta import Errata.Widget open Lean Meta Elab Term @@ -63,6 +65,70 @@ meta def recordTest (decl : Name) : AttrM Unit := do (checkIsTest decl).run' modifyEnv (testExt.addEntry · { name := decl, file := ← getFileName }) +/-- A synthetic syntax carrying the given source range, used to position the widget. -/ +meta def rangeSyntax [Monad m] [MonadFileMap m] + (startPos stopPos : String.Pos.Raw) : m Syntax := do + let str := (← getFileMap).source + let leading : Substring.Raw := { str, startPos, stopPos := startPos } + let trailing : Substring.Raw := { str, startPos := stopPos, stopPos } + return Syntax.atom (.original leading startPos trailing stopPos) "" + +/-- The text of line {lean}`i`, trimmed of surrounding whitespace. -/ +private meta def lineText (lines : Array String) (i : Nat) : String := + ((lines[i]?).getD "").trimAscii.copy + +/-- The first non-blank line at or above {lean}`i`, or {lean}`none` if all are blank up to the top. -/ +private meta partial def firstNonBlankUp (lines : Array String) (i : Nat) : Option Nat := + if (lineText lines i).isEmpty then + if i == 0 then none else firstNonBlankUp lines (i - 1) + else some i + +/-- Scanning up from {lean}`i`, the line that opens a doc comment, stopping at a non-comment line. -/ +private meta partial def docOpenLine (lines : Array String) (i : Nat) : Option Nat := + if (lineText lines i).startsWith "/--" then some i + else if (lineText lines i).startsWith "/-" then none + else if i == 0 then none + else docOpenLine lines (i - 1) + +/-- +The 0-based start line of a doc comment immediately above {lean}`markerLineIdx`, if any. To avoid +mistaking an unrelated trailing comment for one, the comment must be a single-line doc comment or +have its closing delimiter on its own line opened by a doc-comment line. +-/ +private meta def docStartLine? (lines : Array String) (markerLineIdx : Nat) : Option Nat := do + guard (markerLineIdx > 0) + let endLine ← firstNonBlankUp lines (markerLineIdx - 1) + let t := lineText lines endLine + if t.startsWith "/--" && t.endsWith "-/" then return endLine + guard (t == "-/" && endLine > 0) + docOpenLine lines (endLine - 1) + +/-- +The source range to show the test's widget over: the whole declaration. When the attribute is applied +separately (as in {lit}`attribute [test] foo`), the declaration's range is already recorded. When it +is applied inline (as in {lit}`@[test] def foo`), that range is not yet available, so the command is +re-parsed from the start of the marker's line to recover it. Falls back to the marker itself. +-/ +meta def widgetRangeSyntax (decl : Name) (attrStx : Syntax) : AttrM Syntax := do + let fileMap ← getFileMap + if let some ranges ← findDeclarationRanges? decl then + let stx ← rangeSyntax (fileMap.ofPosition ranges.range.pos) (fileMap.ofPosition ranges.range.endPos) + return stx + let some attrPos := attrStx.getPos? | return attrStx + let lineStart := fileMap.ofPosition ⟨(fileMap.toPosition attrPos).line, 0⟩ + let inputCtx := Parser.mkInputContext fileMap.source (← getFileName) + let pmctx : Parser.ParserModuleContext := { env := ← getEnv, options := ← getOptions } + let (cmdStx, _, _) := Parser.parseCommand inputCtx pmctx { pos := lineStart } {} + match cmdStx.getRange? with + | some range => + -- Extend the span up over a doc comment immediately above the marker, when there is one. + let lines := (fileMap.source.splitOn "\n").toArray + let startPos := match docStartLine? lines ((fileMap.toPosition attrPos).line - 1) with + | some docIdx => fileMap.ofPosition ⟨docIdx + 1, 0⟩ + | none => range.start + rangeSyntax startPos range.stop + | none => return attrStx + /-- Marks a definition as a test, discovered and run by the Errata test runner. -/ meta initialize registerBuiltinAttribute { @@ -74,6 +140,22 @@ meta initialize Attribute.Builtin.ensureNoArgs stx unless kind == AttributeKind.global do throwAttrMustBeGlobal `test kind recordTest decl + -- Show the widget when the cursor is anywhere on the declaration, not just on the marker. + let widgetStx ← widgetRangeSyntax decl stx + -- A hash of the test's source, so a run is invalidated when the test is edited. + let source := (← getFileMap).source + let version := match widgetStx.getRange? with + | some range => + let sub : Substring.Raw := { str := source, startPos := range.start, stopPos := range.stop } + toString sub.toString.hash + | none => "" + let props := pure <| json% { + decl: $(Errata.nameToJson decl), + module: $(toString (← getMainModule)), + name: $(toString (privateToUserName decl)), + version: $version + } + Lean.Widget.savePanelWidgetInfo Errata.Widget.runTestWidget.javascriptHash.val props widgetStx } /-- The test's name below its module: the declaration's components past the module prefix, dotted. -/ diff --git a/src/errata/Errata/NameJson.lean b/src/errata/Errata/NameJson.lean new file mode 100644 index 000000000..f92207028 --- /dev/null +++ b/src/errata/Errata/NameJson.lean @@ -0,0 +1,38 @@ +/- +Copyright (c) 2026 Lean FRO LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Author: David Thrane Christiansen +-/ +module + +public import Lean.Data.Json + +public section + +set_option linter.missingDocs true +set_option doc.verso true + +namespace Errata + +open Lean + +/-- +Encodes a {name}`Lean.Name` structurally, preserving the numeric and hygienic components that the +standard string form does not round-trip. The widget and the single-test runner exchange test names +this way. +-/ +def nameToJson : Name → Json + | .anonymous => .null + | .str p s => Json.mkObj [("str", .arr #[nameToJson p, .str s])] + | .num p n => Json.mkObj [("num", .arr #[nameToJson p, .num n])] + +/-- Decodes a {name}`Lean.Name` written by {name}`nameToJson`. -/ +partial def nameOfJson? (j : Json) : Except String Name := do + if j.isNull then return .anonymous + if let .ok arr := j.getObjVal? "str" then + let #[p, s] := (← fromJson? arr : Array Json) | .error "malformed name component" + return .str (← nameOfJson? p) (← fromJson? s) + if let .ok arr := j.getObjVal? "num" then + let #[p, n] := (← fromJson? arr : Array Json) | .error "malformed name component" + return .num (← nameOfJson? p) (← fromJson? n) + .error "expected an encoded `Name`" diff --git a/src/errata/Errata/Report.lean b/src/errata/Errata/Report.lean index 7aa446b54..42842239b 100644 --- a/src/errata/Errata/Report.lean +++ b/src/errata/Errata/Report.lean @@ -18,7 +18,7 @@ set_option doc.verso true namespace Errata -/-- The number of failed or errored results. -/ +/-- The number of results that did not pass. -/ def failureCount (results : Array Result) : Nat := results.foldl (fun n r => if r.status.isSuccess then n else n + 1) 0 @@ -48,25 +48,25 @@ private def printResult (r : Result) : IO Unit := do private structure Suppressed where passed : Nat := 0 failed : Nat := 0 - errored : Nat := 0 + errors : Nat := 0 skipped : Nat := 0 /-- Counts one more suppressed result. -/ private def Suppressed.add (s : Suppressed) : Status → Suppressed | .pass => { s with passed := s.passed + 1 } | .fail _ => { s with failed := s.failed + 1 } - | .error _ => { s with errored := s.errored + 1 } + | .error _ => { s with errors := s.errors + 1 } | .skip _ => { s with skipped := s.skipped + 1 } /-- The number of suppressed results. -/ private def Suppressed.total (s : Suppressed) : Nat := - s.passed + s.failed + s.errored + s.skipped + s.passed + s.failed + s.errors + s.skipped /-- Prints the truncation summary for a test whose results were capped, if any were suppressed. -/ private def printSuppressed (s : Suppressed) : IO Unit := do if s.total > 0 then let parts := #[s!"{s.passed} more passed", s!"{s.failed} more failed"] - ++ (if s.errored > 0 then #[s!"{s.errored} more errored"] else #[]) + ++ (if s.errors > 0 then #[s!"{s.errors} more errors"] else #[]) ++ (if s.skipped > 0 then #[s!"{s.skipped} more skipped"] else #[]) IO.println s!" (... and {", ".intercalate parts.toList})" @@ -79,7 +79,7 @@ def humanReport (verbosity : Verbosity) (results : Array Result) : IO Nat := do let cap := 50 let mut passed := 0 let mut failed := 0 - let mut errored := 0 + let mut errors := 0 let mut skipped := 0 let mut curKey : Option (String × String) := none let mut shown := 0 @@ -88,7 +88,7 @@ def humanReport (verbosity : Verbosity) (results : Array Result) : IO Nat := do match r.status with | .pass => passed := passed + 1 | .fail _ => failed := failed + 1 - | .error _ => errored := errored + 1 + | .error _ => errors := errors + 1 | .skip _ => skipped := skipped + 1 -- Results of one test are contiguous; truncation is per test (its data-driven sub-results). let key := (r.moduleTarget, r.test) @@ -108,8 +108,8 @@ def humanReport (verbosity : Verbosity) (results : Array Result) : IO Nat := do printResult r shown := shown + 1 printSuppressed more - IO.println s!"{passed} passed, {failed} failed, {errored} errored, {skipped} skipped" - return failed + errored + IO.println s!"{passed} passed, {failed} failed, {errors} errors, {skipped} skipped" + return failed + errors private def xmlEscape (s : String) : String := s.replace "&" "&" |>.replace "<" "<" |>.replace ">" ">" @@ -267,12 +267,12 @@ open collapsible block with its location and detail, and a per-module table in a def markdownReport (results : Array Result) : String := Id.run do let passed := countWhere results (· matches .pass) let failed := countWhere results (· matches .fail _) - let errored := countWhere results (· matches .error _) + let errors := countWhere results (· matches .error _) let skipped := countWhere results (· matches .skip _) - let icon := if failed + errored == 0 then "✅" else "❌" + let icon := if failed + errors == 0 then "✅" else "❌" let mut out := s!"## {icon} Errata test results\n\n" out := out ++ - s!"**{passed}** passed · **{failed}** failed · **{errored}** errored · **{skipped}** skipped\n\n" + s!"**{passed}** passed · **{failed}** failed · **{errors}** errors · **{skipped}** skipped\n\n" for r in results do let render (mark message : String) (detail? : Option String) : String := Id.run do let mut s := s!"<details open><summary>{mark} <code>{xmlEscape r.moduleTarget}</code> \ diff --git a/src/errata/Errata/RunOne.lean b/src/errata/Errata/RunOne.lean new file mode 100644 index 000000000..a763bf6b5 --- /dev/null +++ b/src/errata/Errata/RunOne.lean @@ -0,0 +1,117 @@ +/- +Copyright (c) 2026 Lean FRO LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Author: David Thrane Christiansen +-/ +module + +public import Errata.Runner + +public section + +set_option linter.missingDocs true +set_option doc.verso true + +namespace Errata + +/-- A run of captured output from a single stream, used to render output with the streams distinct. -/ +structure OutputChunk where + /-- The stream the text was written to: {lit}`"stdout"` or {lit}`"stderr"`. -/ + stream : String + /-- The text written to that stream. -/ + text : String + /-- When the chunk was received, in milliseconds since the Unix epoch; set by the runner. -/ + time : Nat := 0 +deriving Lean.FromJson, Lean.ToJson, Repr, Inhabited, DecidableEq + +/-- The chunk for a single captured output fragment, tagged by its stream. -/ +def OutputChunk.ofOutput : Output → OutputChunk + | .stdout s => { stream := "stdout", text := s } + | .stderr s => { stream := "stderr", text := s } + +/-- +The outcome of running a single test, in a form the infoview widget renders. The status is one of +{lit}`"passed"`, {lit}`"failed"`, {lit}`"error"`, or {lit}`"skipped"`. +-/ +structure RunOutcome where + /-- The overall verdict: {lit}`"passed"`, {lit}`"failed"`, {lit}`"error"`, or {lit}`"skipped"`. -/ + status : String + /-- How long the run took, in milliseconds. -/ + durationMs : Nat + /-- The failure or skip message, when the test did not pass. -/ + message? : Option String := none + /-- Supporting detail for a failure, such as a diff or counterexample. -/ + detail? : Option String := none + /-- The captured output, in order, with each chunk tagged by the stream it was written to. -/ + output : Array OutputChunk := #[] +deriving Lean.FromJson, Lean.ToJson, Repr, Inhabited + +/-- The status name a single result contributes. -/ +private def statusName : Status → String + | .pass => "passed" + | .fail _ => "failed" + | .error _ => "error" + | .skip _ => "skipped" + +/-- The message a status carries, when it did not pass. -/ +private def statusMessage : Status → Option String + | .pass => none + | .fail f => some f.message + | .error m => some m + | .skip r => some r + +/-- Appends one output fragment, merging it into the previous chunk when it is from the same stream. -/ +private def pushFragment (chunks : Array OutputChunk) (o : Output) : Array OutputChunk := + let stream := match o with | .stdout _ => "stdout" | .stderr _ => "stderr" + match chunks.back? with + | some last => if last.stream == stream + then chunks.pop.push { last with text := last.text ++ o.text } + else chunks.push { stream, text := o.text } + | none => chunks.push { stream, text := o.text } + +/-- +Condenses the results of one test run into a single outcome. The verdict is the most severe status +present (error over failed over skipped over passed), the message and detail come from the first +result with that status, and the output is every result's captured fragments in order, each tagged by +its stream. +-/ +def summarizeResults (results : Array Result) : RunOutcome := Id.run do + let rank : Status → Nat + | .error _ => 3 + | .fail _ => 2 + | .skip _ => 1 + | .pass => 0 + let worst := results.foldl (fun acc r => if rank r.status > rank acc then r.status else acc) .pass + let duration := results.foldl (fun acc r => acc + r.durationMs) 0 + let output := results.foldl (fun acc r => r.output.log.foldl pushFragment acc) #[] + return { + status := statusName worst + durationMs := duration + message? := statusMessage worst + detail? := match worst with | .fail f => f.detail? | _ => none + output + } + +/-- +Runs one testable value to completion and condenses its results into a {name}`RunOutcome`. Captured +output is kept on a passing result too, since the widget shows it on demand rather than only on +failure. +-/ +def runValue {α} [IsTest α] (location : Location) (value : α) + (sink : Output → IO Unit := fun _ => pure ()) : IO RunOutcome := do + let log ← IO.mkRef (#[] : Array Result) + let usedOptions ← IO.mkRef ∅ + let cfg : Context := { log, usedOptions, location, writeOutput := sink } + let start ← IO.monoMsNow + let (outcome, output) ← runCapturing cfg (IsTest.toTest value) + let dur := (← IO.monoMsNow) - start + let logged ← log.get + let results := + match outcome with + | .error e => logged.push { cfg.error (toString e) dur with output } + | .ok (.error f) => logged.push { cfg.fail f dur with output } + | .ok (.ok ()) => if logged.isEmpty then #[{ cfg.pass dur with output }] else logged + return summarizeResults results + +/-- Runs one testable value with a default failure location, for callers without a source range. -/ +def runValueDefault {α} [IsTest α] (value : α) : IO RunOutcome := runValue default value diff --git a/src/errata/Errata/TestM.lean b/src/errata/Errata/TestM.lean index 76132cfba..662ffd103 100644 --- a/src/errata/Errata/TestM.lean +++ b/src/errata/Errata/TestM.lean @@ -47,6 +47,15 @@ def fail (message : String) (detail? : Option String := none) (loc : Location := by exact here%) : TestM α := failAt loc message detail? +/-- +{lit}`failure` fails the test at the context's location, and {lit}`<|>` recovers from an assertion +failure by running the alternative. An escaping {name}`IO.Error` still propagates, so {lit}`<|>` does +not mask a broken setup. +-/ +instance : Alternative TestM where + failure := failHere "failure" + orElse x y := tryCatch x fun _ => y () + /-- Runs an action with the current failure location set to a call site, which defaults to the caller. A user-defined assertion helper can wrap its checks in this so their failures report at the helper's @@ -84,7 +93,7 @@ def Context.pass (ctx : Context) (durationMs : Nat := 0) : Result := def Context.fail (ctx : Context) (failure : TestFailure) (durationMs : Nat := 0) : Result := ctx.mkResult (.fail failure) durationMs -/-- An errored result for the current scope. -/ +/-- A result for the current scope that raised an error. -/ def Context.error (ctx : Context) (message : String) (durationMs : Nat := 0) : Result := ctx.mkResult (.error message) durationMs @@ -97,25 +106,27 @@ def skip (reason : String) : TestM Unit := do let ctx ← read ctx.log.modify (·.push (ctx.skip reason)) -/-- A stream that appends each write to a log, tagged by the stream it came from. -/ -private def captureStream (log : IO.Ref (Array Output)) (mk : String → Output) : IO.FS.Stream where +/-- A stream that hands each write to a destination as a fragment tagged by the stream it came from. -/ +private def captureStream (emit : Output → IO Unit) (mk : String → Output) : IO.FS.Stream where flush := pure () read _ := pure .empty - write bytes := log.modify (·.push (mk (String.fromUTF8! bytes))) + write bytes := emit (mk (String.fromUTF8! bytes)) getLine := pure "" - putStr s := log.modify (·.push (mk s)) + putStr s := emit (mk s) isTty := pure false /-- Runs a test action with the given context, capturing its outcome as data rather than letting it propagate. The action's stdout and stderr are recorded, in order and tagged by stream, and returned -alongside the outcome, so a test's output is shown only when it fails. +alongside the outcome. Each fragment is also handed to the context's output destination as it is +written, so a live runner can stream output while the test runs. -/ def runCapturing (ctx : Context) (act : TestM Unit) : IO (Except IO.Error (Except TestFailure Unit) × OutputLog) := do let log ← IO.mkRef (#[] : Array Output) - let outcome ← IO.withStdout (captureStream log .stdout) <| - IO.withStderr (captureStream log .stderr) <| ((act ctx).run).toBaseIO + let emit (o : Output) : IO Unit := do log.modify (·.push o); ctx.writeOutput o + let outcome ← IO.withStdout (captureStream emit .stdout) <| + IO.withStderr (captureStream emit .stderr) <| ((act ctx).run).toBaseIO return (outcome, { log := ← log.get }) /-- @@ -125,7 +136,8 @@ action wrote. -/ def captureOutput (act : TestM Unit) : TestM OutputLog := do let log ← IO.mkRef (#[] : Array Output) - IO.withStdout (captureStream log .stdout) <| IO.withStderr (captureStream log .stderr) act + let emit (o : Output) : IO Unit := log.modify (·.push o) + IO.withStdout (captureStream emit .stdout) <| IO.withStderr (captureStream emit .stderr) act return { log := ← log.get } /-- @@ -133,7 +145,7 @@ Runs a named result within the current test. Its path extends the current path, and its failure is isolated from sibling results. If the action records no nested results and completes, it contributes one passing result; if it throws, it -contributes one failed or errored result. +contributes one failed result or one that raised an error. -/ def result (name : String) (act : TestM Unit) : TestM Unit := withReader (fun c => { c with resultPath := c.resultPath.push name }) do diff --git a/src/errata/Errata/Widget.lean b/src/errata/Errata/Widget.lean new file mode 100644 index 000000000..ca9267ed4 --- /dev/null +++ b/src/errata/Errata/Widget.lean @@ -0,0 +1,268 @@ +/- +Copyright (c) 2026 Lean FRO LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Author: David Thrane Christiansen +-/ +module + +public meta import Lean.Widget.UserWidget +public meta import Lean.Server +public meta import Std.Time +public meta import Errata.NameJson +public meta import Errata.RunOne + +public section + +set_option linter.missingDocs true +set_option doc.verso true + +open Lean + +namespace Errata.Widget + +/-- +The infoview widget shown when the text cursor is on a test's {lit}`@[test]` marker. It offers a Run +button that runs the test in the language server, streaming its output as it is produced. +-/ +@[widget_module] +meta def runTestWidget : Lean.Widget.Module where + javascript := include_str "widget/run_test_widget.js" + +/-- The single-test runner exe, relative to the workspace root the server runs in. -/ +private meta def runnerPath : String := ".lake/build/bin/errata-run-one" + +/-- The current wall-clock time in milliseconds since the Unix epoch. -/ +private meta def nowMs : IO Nat := + return (← Std.Time.Timestamp.now).toMillisecondsSinceUnixEpoch.toInt.toNat + +/-- +A live (or just-finished) run. Output chunks accumulate in {name (full := RunState.chunks)}`chunks` +so a widget that reconnects after the cursor leaves and returns can replay them by index. The wakeup +promise is resolved and replaced whenever a chunk arrives or the run finishes, waking any waiter. +-/ +meta structure RunState where + /-- Every output chunk produced so far, in order. -/ + chunks : IO.Ref (Array Errata.OutputChunk) + /-- Whether the run has finished. -/ + finished : IO.Ref Bool + /-- The final outcome, set when the run finishes. -/ + outcome : IO.Ref (Option Errata.RunOutcome) + /-- A promise resolved and replaced on each change, used to wake waiters without polling. -/ + wakeup : IO.Ref (IO.Promise Unit) + /-- The current phase, {lit}`"building"` while compiling the module then {lit}`"running"`. -/ + phase : IO.Ref String + /-- A hash of the test's source when the run started; a later request with a different one is stale. -/ + version : String + /-- When the run started, in milliseconds since the Unix epoch. -/ + startTime : Nat + /-- How long the build took, in milliseconds; 0 while still building. -/ + buildMs : IO.Ref Nat + /-- When the test body started (reported by the runner), in epoch ms; 0 until then. -/ + execStartTime : IO.Ref Nat + /-- Kills the current process (the build, then the runner); updated as each is spawned. -/ + kill : IO.Ref (IO Unit) + +/-- The live runs, keyed by the test's declaration name so a run survives re-elaboration. -/ +meta initialize runRegistry : IO.Ref (Std.HashMap Name RunState) ← IO.mkRef {} + +/-- A request to start running a test: the declaration and the module that defines it. -/ +meta structure StartRequest where + /-- The test declaration to run, encoded by {name}`nameToJson`. -/ + decl : Json + /-- The module that defines the test, as a dotted name. -/ + module : String + /-- A hash of the test's source, recorded with the run so an edit can invalidate it. -/ + version : String +deriving Lean.FromJson, Lean.ToJson + +/-- A request for output past a known position, naming the test by its encoded declaration. -/ +meta structure AwaitRequest where + /-- The test declaration, encoded by {name}`nameToJson`. -/ + decl : Json + /-- The number of chunks the widget already has, so only later ones are returned. -/ + since : Nat + /-- The test's source hash; a run recorded under a different one is stale and ignored. -/ + version : String + /-- The phase the widget last saw; a reply is returned at once when the run's phase differs. -/ + phase : String +deriving Lean.FromJson, Lean.ToJson + +/-- A request that names a running test by its declaration, encoded by {name}`nameToJson`. -/ +meta structure RunRef where + /-- The test declaration, encoded by {name}`nameToJson`. -/ + decl : Json +deriving Lean.FromJson, Lean.ToJson + +/-- One reply from {lit}`awaitOutput`: any output chunks past the requested position, or the outcome. -/ +meta structure AwaitResult where + /-- The output chunks past the requested position. -/ + chunks : Array Errata.OutputChunk := #[] + /-- The position past the returned chunks, to pass as the next request's start. -/ + nextSince : Nat := 0 + /-- When the run started, in milliseconds since the Unix epoch. -/ + startTime : Nat := 0 + /-- How long the build took, in milliseconds; 0 while still building. -/ + buildMs : Nat := 0 + /-- When the test body started, in epoch ms; 0 until then. Output offsets are relative to it. -/ + execStartTime : Nat := 0 + /-- The current phase, {lit}`"building"` or {lit}`"running"`. -/ + phase : String := "running" + /-- Whether the run has finished and no more output will arrive. -/ + done : Bool := false + /-- The final outcome, present once {lit}`done` is set. -/ + outcome : Option Errata.RunOutcome := none +deriving Lean.FromJson, Lean.ToJson + +open Server in +/-- Decodes the declaration name from a request, failing the request if it is malformed. -/ +private meta def decodeDecl (j : Json) : RequestM Name := + match nameOfJson? j with + | .ok n => pure n + | .error e => throw (.mk .invalidParams e) + +/-- Resolves the run's current wakeup promise and installs a fresh one, waking any waiter. -/ +private meta def signalRun (state : RunState) : IO Unit := do + let p ← state.wakeup.get + state.wakeup.set (← IO.Promise.new) + p.resolve () + +/-- Kills the runner of a name, if any, marks it finished, and forgets it. -/ +private meta def dropRun (declName : Name) : IO Unit := do + if let some state := (← runRegistry.get).get? declName then + try (← state.kill.get) catch _ => pure () + state.finished.set true + signalRun state + runRegistry.modify (·.erase declName) + +/-- +Reads the runner's JSON protocol from its stdout: a {lit}`chunk` line per output fragment, then an +{lit}`outcome` line. Marks the run finished at end of input, which is reached when the process exits +or is killed, so this never holds a thread past the process's lifetime. +-/ +private meta partial def readLoop (out : IO.FS.Handle) (state : RunState) : IO Unit := do + let line ← out.getLine + if line.isEmpty then + state.finished.set true + signalRun state + else + if let .ok j := Json.parse line then + if let .ok c := j.getObjVal? "chunk" then + if let .ok chunk := (fromJson? c : Except String Errata.OutputChunk) then + state.chunks.modify (·.push chunk) + signalRun state + else if let .ok ex := j.getObjVal? "exec" then + if let .ok t := (fromJson? ex : Except String Nat) then + state.execStartTime.set t + signalRun state + else if let .ok o := j.getObjVal? "outcome" then + if let .ok oc := (fromJson? o : Except String Errata.RunOutcome) then + state.outcome.set oc + readLoop out state + +/-- The outcome shown when the build step fails, carrying its message and detail. -/ +private meta def buildFailure (detail : String) : Errata.RunOutcome := + { status := "error", durationMs := 0, message? := some "lake build failed", detail? := some detail } + +/-- +Builds the test's module from the saved source, then runs the test, streaming its output into the +run state. Building first means a Run reflects the latest saved version of the test. +-/ +private meta def buildAndRun (module declJson : String) (state : RunState) : IO Unit := do + let build ← IO.Process.spawn { + stdin := .null, stdout := .piped, stderr := .piped + cmd := "lake", args := #["build", "errata-run-one", module] } + state.kill.set build.kill + let errTask ← IO.asTask build.stderr.readToEnd + let _ ← build.stdout.readToEnd + let buildErr := (← IO.wait errTask).toOption.getD "" + if (← build.wait) != 0 then + state.outcome.set (some (buildFailure buildErr)) + state.finished.set true + signalRun state + return + let run ← IO.Process.spawn { + stdin := .null, stdout := .piped, stderr := .inherit + cmd := runnerPath, args := #[module, declJson] } + state.kill.set run.kill + state.buildMs.set ((← nowMs) - state.startTime) + state.phase.set "running" + signalRun state + readLoop run.stdout state + +open Server in +/-- Whether the document's live text matches what is on disk, i.e. it has no unsaved changes. -/ +private meta def bufferIsClean : RequestM Bool := do + let docMeta := (← RequestM.readDoc).meta + let some path := System.Uri.fileUriToPath? docMeta.uri + | return true + match (← (IO.FS.readFile path).toBaseIO).toOption with + | some disk => return docMeta.text.source == disk.crlfToLf + | none => return true + +open Server in +/-- Server RPC method reporting whether the file has no unsaved changes, gating the Run button. -/ +@[server_rpc_method] +meta def bufferClean (_ : RunRef) : RequestM (RequestTask Bool) := do + return RequestTask.pure (← bufferIsClean) + +open Server in +/-- Server RPC method that starts running a test: builds its saved source, then streams its output. -/ +@[server_rpc_method] +meta def startTest (req : StartRequest) : RequestM (RequestTask Unit) := do + let declName ← decodeDecl req.decl + unless ← bufferIsClean do + throw (.mk .invalidParams "the file has unsaved changes; save it before running the test") + dropRun declName + let state : RunState := { + chunks := ← IO.mkRef #[], finished := ← IO.mkRef false, outcome := ← IO.mkRef none, + wakeup := ← IO.mkRef (← IO.Promise.new), phase := ← IO.mkRef "building", version := req.version, + startTime := ← nowMs, buildMs := ← IO.mkRef 0, execStartTime := ← IO.mkRef 0, + kill := ← IO.mkRef (pure ()) } + runRegistry.modify (·.insert declName state) + let _ ← IO.asTask (buildAndRun req.module req.decl.compress state) + return RequestTask.pure () + +open Server in +/-- Builds the reply for a waiter given the run's current state and the position it already has. -/ +private meta def replyFrom (state : RunState) (since : Nat) : IO AwaitResult := do + let chunks ← state.chunks.get + let phase ← state.phase.get + let startTime := state.startTime + let buildMs ← state.buildMs.get + let execStartTime ← state.execStartTime.get + if chunks.size > since then + let slice := chunks.extract since chunks.size + return { chunks := slice, nextSince := since + slice.size, phase, startTime, buildMs, execStartTime } + let done ← state.finished.get + let outcome ← state.outcome.get + return { nextSince := chunks.size, phase, startTime, buildMs, execStartTime, done, outcome } + +open Server in +/-- +Server RPC method that returns output chunks past {name (full := AwaitRequest.since)}`since`, or the +final outcome. When nothing new is available yet, the reply hangs off the run's wakeup promise, so no +worker thread is held while waiting and a reconnecting widget replays from {lit}`since := 0`. +-/ +@[server_rpc_method] +meta def awaitOutput (req : AwaitRequest) : RequestM (RequestTask AwaitResult) := do + let declName ← decodeDecl req.decl + let some state := (← runRegistry.get).get? declName + | return RequestTask.pure ({ done := true } : AwaitResult) + -- A run recorded under a different source hash is from before an edit; treat it as absent. + if state.version != req.version then + return RequestTask.pure ({ done := true } : AwaitResult) + let p ← state.wakeup.get + let chunks ← state.chunks.get + -- Return at once when there is new output, the run finished, or its phase changed (so a widget + -- reconnecting mid-build learns it is building rather than waiting silently); otherwise wait. + if chunks.size > req.since || (← state.finished.get) || (← state.phase.get) != req.phase then + return RequestTask.pure (← replyFrom state req.since) + RequestM.mapTaskCheap (p.resultD ()).asServerTask fun _ => liftM (replyFrom state req.since) + +open Server in +/-- Server RPC method that cancels a running test by killing its process. -/ +@[server_rpc_method] +meta def cancelTest (req : RunRef) : RequestM (RequestTask Unit) := do + let declName ← decodeDecl req.decl + dropRun declName + return RequestTask.pure () diff --git a/src/errata/Errata/widget/jsconfig.json b/src/errata/Errata/widget/jsconfig.json new file mode 100644 index 000000000..9a3cd8eef --- /dev/null +++ b/src/errata/Errata/widget/jsconfig.json @@ -0,0 +1,8 @@ +{ + "compilerOptions": { + "lib": ["ES2024", "DOM", "DOM.Iterable"], + "target": "ES2024", + "noEmit": true + }, + "include": ["*.js", "*.d.ts"] +} diff --git a/src/errata/Errata/widget/run_test_widget.js b/src/errata/Errata/widget/run_test_widget.js new file mode 100644 index 000000000..d4fd826f3 --- /dev/null +++ b/src/errata/Errata/widget/run_test_widget.js @@ -0,0 +1,490 @@ +// @ts-check +import * as React from "react"; +import { useRpcSession } from "@leanprover/infoview"; + +const e = React.createElement; + +// Persists the last outcome per test for the lifetime of the infoview session, so leaving and +// returning to a test's `@[test]` marker shows its previous result rather than a blank widget. +const resultCache = new Map(); + +const STATUS_COLORS = { + passed: "#2e7d32", + failed: "#c62828", + error: "#e65100", + skipped: "#6b6b6b", +}; + +const STATUS_SYMBOLS = { + passed: "✓", + failed: "✗", + error: "⚠", + skipped: "○", +}; + +const STATUS_LABELS = { + passed: "Passed", + failed: "FAILED", + error: "ERROR", + skipped: "Skipped", +}; + +const preStyle = { + margin: "4px 0 0 0", + padding: "6px 8px", + whiteSpace: "pre-wrap", + wordBreak: "break-word", + background: "var(--vscode-textCodeBlock-background, rgba(127,127,127,0.1))", + borderRadius: "3px", + fontSize: "12px", +}; + +function formatDuration(ms) { + if (ms < 1000) return ms + " ms"; + return (ms / 1000).toFixed(ms < 10000 ? 2 : 1) + " s"; +} + +function block(text) { + return e("pre", { style: preStyle }, text); +} + +function pad(n, w) { + return String(n).padStart(w || 2, "0"); +} + +const monoFont = "var(--vscode-editor-font-family, monospace)"; + +// A wall-clock time of day, rounded to the nearest second, from a Unix-epoch millisecond timestamp. +function formatClock(ms) { + if (!ms) return ""; + const d = new Date(Math.round(ms / 1000) * 1000); + return pad(d.getHours()) + ":" + pad(d.getMinutes()) + ":" + pad(d.getSeconds()); +} + +// A chunk's offset from the start of execution, in tenths of a second, as `(N.Ns)`. +function chunkOffset(c, execStartTime) { + if (!execStartTime || !c.time) return ""; + return "(" + ((c.time - execStartTime) / 1000).toFixed(1) + "s)"; +} + +// A chunk's stream and offset as a plain string, for the native hover tooltip. +function chunkLabel(c, execStartTime) { + const off = chunkOffset(c, execStartTime); + return off ? c.stream + " " + off : c.stream; +} + +// Renders captured output: stdout and stderr interleaved in order, both in the editor's code font, +// with stderr italicized. Hovering a chunk highlights it and reports its stream and time offset. +function outputBlock(chunks, execStartTime, hovered, setHovered) { + return e( + "pre", + { + style: { ...preStyle, fontFamily: monoFont }, + onMouseLeave: function () { + setHovered(null); + }, + }, + ...chunks.map(function (c, i) { + return e( + "span", + { + key: i, + title: chunkLabel(c, execStartTime), + onMouseEnter: function () { + setHovered(i); + }, + style: { + fontStyle: c.stream === "stderr" ? "italic" : undefined, + borderRadius: "2px", + backgroundColor: + hovered === i + ? "var(--vscode-editor-hoverHighlightBackground, rgba(120,170,255,0.3))" + : undefined, + }, + }, + c.text, + ); + }), + ); +} + +export default function (props) { + const rs = useRpcSession(); + // Keyed by both the test and a hash of its source, so editing the test changes the key and + // invalidates its cached/in-progress run. + const version = props.version || ""; + const cacheKey = JSON.stringify(props.decl) + "@" + version; + + const [outcome, setOutcome] = React.useState(() => resultCache.get(cacheKey) || null); + const [running, setRunning] = React.useState(false); + const [cancelled, setCancelled] = React.useState(false); + const [elapsed, setElapsed] = React.useState(0); + const [error, setError] = React.useState(null); + const [live, setLive] = React.useState([]); + const [phase, setPhase] = React.useState("running"); + // When the run started (epoch ms), recorded server-side so it survives a reconnect. + const [startTime, setStartTime] = React.useState(0); + // How long the build took (ms), and when the test body started (epoch ms) for output offsets. + const [buildMs, setBuildMs] = React.useState(0); + const [execStartTime, setExecStartTime] = React.useState(0); + // The output chunk under the cursor, highlighted with its timestamp shown. + const [hovered, setHovered] = React.useState(null); + // Whether the file has no unsaved changes; the test runs the saved version, so Run is gated on it. + const [clean, setClean] = React.useState(true); + // Briefly true after the output is copied, to confirm the copy in the button label. + const [copied, setCopied] = React.useState(false); + // Whether the output disclosure is expanded; open by default, collapsible to hide large output. + const [outputOpen, setOutputOpen] = React.useState(true); + // Whether the cursor is over the output area, revealing the floating copy button. + const [overOutput, setOverOutput] = React.useState(false); + + // Bumped on each run start, cancel, and unmount so a superseded await loop ignores late replies. + const gen = React.useRef(0); + const liveRef = React.useRef([]); + // The number of chunks already pulled from the server, so a reconnect replays from the start. + const sinceRef = React.useRef(0); + // The last phase the widget saw; "" forces the next await to return the run's current phase at once. + const phaseRef = React.useRef(""); + const startedAt = React.useRef(0); + + React.useEffect( + function () { + if (!running) return undefined; + const timer = setInterval(function () { + setElapsed(Date.now() - startedAt.current); + }, 100); + return function () { + clearInterval(timer); + }; + }, + [running], + ); + + function loop(myGen) { + rs.call("Errata.Widget.awaitOutput", { + decl: props.decl, + since: sinceRef.current, + version: version, + phase: phaseRef.current, + }).then( + function (res) { + if (gen.current !== myGen) return; + if (res.startTime) setStartTime(res.startTime); + if (res.buildMs) setBuildMs(res.buildMs); + if (res.execStartTime) setExecStartTime(res.execStartTime); + if (res.phase) { + setPhase(res.phase); + phaseRef.current = res.phase; + } + if (res.chunks && res.chunks.length) { + liveRef.current = liveRef.current.concat(res.chunks); + setLive(liveRef.current); + sinceRef.current = res.nextSince; + setRunning(true); + } + if (res.done) { + if (res.outcome) { + resultCache.set(cacheKey, res.outcome); + setOutcome(res.outcome); + } + setRunning(false); + return; + } + setRunning(true); + loop(myGen); + }, + function (err) { + if (gen.current !== myGen) return; + setError((err && err.message) || String(err)); + setRunning(false); + }, + ); + } + + // The infoview reuses one component instance for whichever test the cursor is on, so reset and + // reconnect whenever the test changes (keyed on `cacheKey`), not just on mount. Restores any cached + // outcome for this test and replays an in-progress run from the start. + React.useEffect( + function () { + const myGen = gen.current + 1; + gen.current = myGen; + sinceRef.current = 0; + phaseRef.current = ""; + liveRef.current = []; + setLive([]); + setOutcome(resultCache.get(cacheKey) || null); + setRunning(false); + setCancelled(false); + setError(null); + setPhase("running"); + setStartTime(0); + setBuildMs(0); + setExecStartTime(0); + setHovered(null); + startedAt.current = Date.now(); + loop(myGen); + let cancelledCheck = false; + let cleanTimer = null; + function checkClean() { + rs.call("Errata.Widget.bufferClean", { decl: props.decl }).then( + function (c) { + if (cancelledCheck) return; + setClean(c); + // While the buffer is dirty, re-check so the button re-enables shortly after a save. + if (!c) cleanTimer = setTimeout(checkClean, 1500); + }, + function () {}, + ); + } + checkClean(); + return function () { + gen.current += 1; + cancelledCheck = true; + if (cleanTimer) clearTimeout(cleanTimer); + }; + }, + [cacheKey], + ); + + function run() { + const myGen = gen.current + 1; + gen.current = myGen; + liveRef.current = []; + setLive([]); + sinceRef.current = 0; + setOutcome(null); + setError(null); + setCancelled(false); + setPhase("building"); + phaseRef.current = "building"; + startedAt.current = Date.now(); + setElapsed(0); + setRunning(true); + rs.call("Errata.Widget.startTest", { + decl: props.decl, + module: props.module, + version: version, + }).then( + function () { + if (gen.current === myGen) loop(myGen); + }, + function (err) { + if (gen.current !== myGen) return; + setError((err && err.message) || String(err)); + setRunning(false); + }, + ); + } + + function cancel() { + gen.current += 1; + setRunning(false); + setCancelled(true); + rs.call("Errata.Widget.cancelTest", { decl: props.decl }).catch(function () {}); + } + + const name = props.name || "test"; + + const header = e( + "div", + { style: { display: "flex", alignItems: "center", gap: "8px" } }, + running + ? e("button", { onClick: cancel }, "Cancel") + : e( + "button", + { + onClick: run, + disabled: !clean, + title: clean ? undefined : "Save the file to run the test", + }, + outcome || error || cancelled ? "Run again" : "Run", + ), + e( + "span", + { + style: { + fontFamily: "var(--vscode-editor-font-family, monospace)", + fontSize: "12px", + }, + }, + name, + ), + !clean && !running + ? e("span", { style: { opacity: 0.6, fontSize: "11px" } }, "unsaved — save to run") + : null, + ); + + // Prefer the live, server-timestamped chunks; fall back to a cached outcome's output. + const chunks = live.length ? live : outcome && outcome.output ? outcome.output : []; + + function copyOutput() { + const text = chunks + .map(function (c) { + return c.text; + }) + .join(""); + Promise.resolve(navigator.clipboard.writeText(text)).then( + function () { + setCopied(true); + setTimeout(function () { + setCopied(false); + }, 1500); + }, + function () {}, + ); + } + + // The copy icon (two overlapping sheets), or a check mark once the output has been copied. + const copyIcon = e( + "svg", + { + width: 13, + height: 13, + viewBox: "0 0 24 24", + fill: "none", + stroke: "currentColor", + strokeWidth: 2, + strokeLinecap: "round", + strokeLinejoin: "round", + }, + copied + ? e("path", { key: "check", d: "M20 6L9 17l-5-5" }) + : [ + e("rect", { key: "sheet", x: 9, y: 9, width: 13, height: 13, rx: 2, ry: 2 }), + e("path", { + key: "back", + d: "M5 15H4a2 2 0 0 1-2-2V4a2 2 0 0 1 2-2h9a2 2 0 0 1 2 2v1", + }), + ], + ); + + // A copy button floating over the top-right of the output, revealed on hover (or while confirming). + const copyButton = e( + "button", + { + onClick: copyOutput, + title: copied ? "Copied" : "Copy output to clipboard", + "aria-label": "Copy output to clipboard", + style: { + position: "absolute", + top: "4px", + right: "4px", + zIndex: 1, + display: "flex", + alignItems: "center", + padding: "3px", + lineHeight: 0, + opacity: overOutput || copied ? 0.95 : 0, + transition: "opacity 0.1s", + }, + }, + copyIcon, + ); + + const outputSection = + chunks.length === 0 + ? null + : e( + "details", + { + key: "output", + open: outputOpen, + onToggle: function (ev) { + setOutputOpen(ev.target.open); + }, + style: { marginTop: "4px" }, + }, + e( + "summary", + { style: { opacity: 0.7, fontSize: "11px", cursor: "pointer" } }, + hovered !== null && chunks[hovered] + ? [ + "Output — ", + e( + "span", + { key: "stream", style: { fontFamily: monoFont } }, + chunks[hovered].stream, + ), + " " + chunkOffset(chunks[hovered], execStartTime), + ] + : "Output", + ), + e( + "div", + { + style: { position: "relative" }, + onMouseEnter: function () { + setOverOutput(true); + }, + onMouseLeave: function () { + setOverOutput(false); + }, + }, + copyButton, + outputBlock(chunks, execStartTime, hovered, setHovered), + ), + ); + + // The primary status/progress element, then dimmed badges: start time, build and run durations. + let primary = null; + if (running) { + const label = phase === "building" ? "Building… " : "Running… "; + primary = e( + "span", + { style: { opacity: 0.8 } }, + label, + e("span", { style: { fontFamily: monoFont } }, formatDuration(elapsed)), + ); + } else if (error) { + primary = e("span", { style: { color: STATUS_COLORS.error } }, "could not run: " + error); + } else if (outcome) { + primary = e( + "span", + { style: { color: STATUS_COLORS[outcome.status] || "inherit", fontWeight: 600 } }, + (STATUS_SYMBOLS[outcome.status] || "") + + " " + + (STATUS_LABELS[outcome.status] || outcome.status), + ); + } else if (cancelled) { + primary = e("span", { style: { opacity: 0.7 } }, "cancelled"); + } + + const badges = []; + if (startTime) badges.push("Start " + formatClock(startTime)); + if (buildMs) badges.push("Build " + formatDuration(buildMs)); + if (outcome) badges.push("Run " + formatDuration(outcome.durationMs)); + + const infoRow = + primary || badges.length + ? e( + "div", + { + style: { + display: "flex", + alignItems: "baseline", + gap: "8px", + flexWrap: "wrap", + }, + }, + primary, + ...badges.map(function (b, i) { + return e( + "span", + { key: i, style: { opacity: 0.55, fontSize: "11px" } }, + "· " + b, + ); + }), + ) + : null; + + const extras = []; + if (outcome && outcome.message) extras.push(e("div", { key: "msg" }, block(outcome.message))); + if (outcome && outcome.detail) extras.push(e("div", { key: "detail" }, block(outcome.detail))); + + const body = + infoRow || extras.length || outputSection + ? e("div", { style: { marginTop: "4px" } }, infoRow, ...extras, outputSection) + : null; + + return e("div", { style: { padding: "2px 0" } }, header, body); +} diff --git a/src/errata/Errata/widget/widget-externals.d.ts b/src/errata/Errata/widget/widget-externals.d.ts new file mode 100644 index 000000000..184c5d540 --- /dev/null +++ b/src/errata/Errata/widget/widget-externals.d.ts @@ -0,0 +1,16 @@ +// Minimal ambient declarations for the npm packages the run-test widget imports. The widget is +// served as-is to the infoview, which supplies React and the infoview RPC API at runtime, so only +// the surface the widget uses is declared here, enough for `tsc` to type-check the rest. + +declare module "react" { + export function createElement(type: any, props?: any, ...children: any[]): any; + export function useState(initial: any): [any, (value: any) => void]; + export function useEffect(effect: () => void | (() => void), deps?: any[]): void; + export function useRef(initial: any): { current: any }; +} + +declare module "@leanprover/infoview" { + export function useRpcSession(): { + call(method: string, params: any): Promise<any>; + }; +} diff --git a/src/errata/ErrataRunOne.lean b/src/errata/ErrataRunOne.lean new file mode 100644 index 000000000..b27fed2a3 --- /dev/null +++ b/src/errata/ErrataRunOne.lean @@ -0,0 +1,84 @@ +/- +Copyright (c) 2026 Lean FRO LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Author: David Thrane Christiansen +-/ +module + +public import Errata +public import Std.Time +public meta import Lean + +open Lean Meta + +/-- The current wall-clock time in milliseconds since the Unix epoch. -/ +def nowMs : IO Nat := + return (← Std.Time.Timestamp.now).toMillisecondsSinceUnixEpoch.toInt.toNat + +/-- +Evaluates the test named by {lean}`declName` in the current environment to a runnable action. + +The action is reached through {name}`Errata.IsTest.toTest` so any testable type works, and through +{lit}`import all` of its module so a module-private test is still reachable. +-/ +unsafe def evalTestM (declName : Name) : CoreM (Errata.TestM Unit) := + MetaM.run' do + let env ← getEnv + -- The widget passes the declaration's real name, but a module-private test is mangled, so fall + -- back to matching the user-facing name when the exact name is absent. + let realName ← + if env.contains declName then pure declName + else match env.constants.fold (init := none) (fun acc n _ => + acc <|> (if privateToUserName n == declName then some n else none)) with + | some n => pure n + | none => throwError "unknown test `{declName}`" + let decl := mkConst realName + let declType ← inferType decl + let inst ← + match ← trySynthInstance (mkApp (mkConst ``Errata.IsTest) declType) with + | .some inst => pure inst + | _ => throwError "`{declName}` is not a test" + let act := mkApp3 (mkConst ``Errata.IsTest.toTest) declType inst decl + let ty := mkApp (mkConst ``Errata.TestM) (mkConst ``Unit) + evalExpr (Errata.TestM Unit) ty act (safety := .unsafe) + +/-- Writes one JSON protocol line to the runner's real stdout and flushes it for prompt streaming. -/ +private def emitLine (out : IO.FS.Stream) (key : String) (value : Json) : IO Unit := do + out.putStr ((Json.mkObj [(key, value)]).compress ++ "\n") + out.flush + +/-- Imports {lean}`targetModule`, runs the test named by {lean}`declName`, and streams its result. -/ +unsafe def runImpl (args : List String) : IO UInt32 := do + let [modStr, declStr] := args + | IO.eprintln "usage: errata-run-one <module> <decl-json>"; return 2 + let targetModule := modStr.toName + let declName ← + match Json.parse declStr with + | .ok j => IO.ofExcept (Errata.nameOfJson? j) + | .error _ => pure declStr.toName + -- The runner's real stdout carries the JSON protocol; the test's own output is captured by + -- `runValue` and forwarded as chunk lines, so this handle is taken before that redirection. + let out ← IO.getStdout + initSearchPath (← findSysroot) + if let some leanPath ← IO.getEnv "LEAN_PATH" then + searchPathRef.modify (· ++ System.SearchPath.parse leanPath) + enableInitializersExecution + let env ← importModules + #[{ module := targetModule, importAll := true }, { module := `Errata }] {} (loadExts := true) + let coreCtx : Core.Context := { fileName := "<errata-run-one>", fileMap := default } + let (act, _) ← (evalTestM declName).toIO coreCtx { env } + -- Mark when the test body starts, so the widget shows output offsets within the test itself, + -- excluding the build and module-import time before this point. + emitLine out "exec" (toJson (← nowMs)) + let sink := fun (o : Errata.Output) => do + let chunk := { Errata.OutputChunk.ofOutput o with time := ← nowMs } + emitLine out "chunk" (toJson chunk) + let outcome ← Errata.runValue default act (sink := sink) + emitLine out "outcome" (toJson outcome) + return 0 + +@[implemented_by runImpl] +opaque run (args : List String) : IO UInt32 + +/-- Runs a single Errata test, streaming its output and final outcome as JSON lines to stdout. -/ +public def main (args : List String) : IO UInt32 := run args From 8c0875e97c233d2fd90326f4cb70ab65f35d0f59 Mon Sep 17 00:00:00 2001 From: David Thrane Christiansen <david@davidchristiansen.dk> Date: Wed, 1 Jul 2026 10:48:14 +0200 Subject: [PATCH 14/26] docstring and widget improvements --- lakefile.lean | 36 ++++++++------ src/errata-tests/ErrataTests.lean | 10 ++-- src/errata/Errata/CompileTime.lean | 29 ++++++++--- src/errata/Errata/Context.lean | 2 + src/errata/Errata/Discovery.lean | 28 +++++++---- src/errata/Errata/Property.lean | 3 +- src/errata/Errata/Report.lean | 49 ++++++++++++++----- src/errata/Errata/Result.lean | 22 +++++++-- src/errata/Errata/RunOne.lean | 14 ++++-- src/errata/Errata/Runner.lean | 16 +++--- src/errata/Errata/TestM.lean | 37 +++++++++----- src/errata/Errata/Widget.lean | 37 +++++++++----- src/errata/Errata/usage.txt | 3 +- src/errata/Errata/widget/run_test_widget.js | 33 +++++++++++-- .../Errata/widget/widget-externals.d.ts | 2 +- src/errata/ErrataRunOne.lean | 9 ++-- 16 files changed, 232 insertions(+), 98 deletions(-) diff --git a/lakefile.lean b/lakefile.lean index 6c4c11685..aa9db46e4 100644 --- a/lakefile.lean +++ b/lakefile.lean @@ -177,13 +177,17 @@ lean_exe «errata-runner» where supportInterpreter := true needs := #[errataSelection] -/-- Whether a source file introduces Errata tests, by an `@[test]` attribute, a `#test_msgs` -command, or a `#test_guard` command. This drives the glob-coverage check, which reads source files -before anything is built; test discovery itself reads the compiled modules. -/ +/-- +Whether a source file introduces Errata tests, by an `@[test]` attribute (applied inline or with a +separate `attribute [test] …`), a `#test_msgs` command, or a `#test_guard` command. This drives the +glob-coverage check, which reads source files before anything is built; test discovery itself reads +the compiled modules. +-/ private def errataSourceHasTests (lines : List String) : Bool := lines.any fun line => let t := line.trimAsciiStart.copy - t.startsWith "@[test]" || t.startsWith "#test_msgs" || t.startsWith "#test_guard" + t.startsWith "@[test]" || t.startsWith "attribute [test" || + t.startsWith "#test_msgs" || t.startsWith "#test_guard" /-- Reads a built module's `.olean` header: whether it participates in the module system, and whether it records any `@[test]` (including those generated by `#test_msgs` and `#test_guard`). -/ @@ -225,8 +229,9 @@ private def errataSplitArgs (args : List String) : Except String (List String × | (names, []) => (names, []) match names.find? (·.startsWith "-") with | some opt => - .error s!"unexpected option '{opt}' among library names; pass runner options after \ - `--test-options` (e.g. `lake test -- --test-options {opt}`)" + .error s!"unexpected option '{opt}': arguments before the `--test-options` marker name the \ + libraries to test. Put runner options after the marker, \ + e.g. `lake test -- --test-options {opt}`." | none => .ok (names, rest) /-- Usage information for `lake test`, shared with `Errata.usage` through one text file. -/ @@ -253,11 +258,12 @@ private def errataModuleOfPath (srcDir path : System.FilePath) : Option Lean.Nam some (".".intercalate comps).toName /-- -Reports modules that define tests but whose library's globs do not cover them, so the tests would be -silently undiscovered, and returns them. A module within a library's root that is not matched by the -library's globs, in a file that introduces tests, is the signal. +Warns about modules that look like they define tests but whose library's globs do not cover them, so +the tests would be silently undiscovered. A module within a library's root that is not matched by the +library's globs, in a file that introduces tests, is the signal. The check reads source text and is a +heuristic, so it warns rather than failing the run. -/ -private def errataUncoveredTestModules (ws : Lake.Workspace) : IO (Array Lean.Name) := do +private def errataWarnUncoveredTestModules (ws : Lake.Workspace) : IO Unit := do let mut missed : Array Lean.Name := #[] for lib in ws.root.leanLibs do if lib.name == `ErrataGenerated then continue @@ -271,12 +277,11 @@ private def errataUncoveredTestModules (ws : Lake.Workspace) : IO (Array Lean.Na if errataSourceHasTests lines then missed := missed.push mod unless missed.isEmpty do - IO.eprintln "error: these modules define tests but their library's globs do not cover \ - them, so the tests are not discovered. Widen the library's `globs` \ + IO.eprintln "warning: these modules look like they define tests but their library's globs do \ + not cover them, so the tests are not discovered. Widen the library's `globs` \ (e.g. `globs := #[Glob.andSubmodules `Root]`):" for mod in missed do IO.eprintln s!" {mod}" - return missed @[test_driver] script «errata-test» (args) do @@ -321,8 +326,9 @@ script «errata-test» (args) do IO.eprintln s!"error: no library matches '{spec}'" return 1 pure chosen - -- Uncovered @[test] modules are a configuration error: fail rather than run an incomplete suite. - unless (← errataUncoveredTestModules ws).isEmpty do return 1 + -- Modules that look like they define tests but escape their library's globs are likely a + -- configuration slip; warn, but run the discovered suite anyway. + errataWarnUncoveredTestModules ws -- Build every module in the selected libraries; their compiled `.olean` headers are authoritative -- on which modules carry tests, so no test is dropped by a source-level heuristic. let modInfos ← runBuild do diff --git a/src/errata-tests/ErrataTests.lean b/src/errata-tests/ErrataTests.lean index 3a37ba317..61b4b4044 100644 --- a/src/errata-tests/ErrataTests.lean +++ b/src/errata-tests/ErrataTests.lean @@ -83,12 +83,9 @@ def jsonRoundTrips : Test := @[test] def goldenRoundTrip : Test := IO.FS.withTempDir fun dir => do - let cfg ← read - -- In update mode this would write; here we drive it through a temp golden file. let goldenPath := dir / "expected.txt" IO.FS.writeFile goldenPath "contents\n" assertFileExists goldenPath - let _ := cfg goldenFile goldenPath "contents\n" /-- The `Verbosity` predicates and accumulation behave as the report relies on. -/ @@ -97,12 +94,17 @@ def verbosityLevels : Test := do assertEq false Verbosity.silent.showsPasses assertEq true Verbosity.quiet.showsPasses assertEq true Verbosity.verbose.showsPasses + assertEq true Verbosity.superVerbose.showsPasses assertEq false Verbosity.silent.truncates assertEq true Verbosity.quiet.truncates assertEq false Verbosity.verbose.truncates + assertEq false Verbosity.superVerbose.truncates + assertEq false Verbosity.verbose.showsAllDocstrings + assertEq true Verbosity.superVerbose.showsAllDocstrings assertEq Verbosity.quiet Verbosity.silent.increase assertEq Verbosity.verbose Verbosity.quiet.increase - assertEq Verbosity.verbose Verbosity.verbose.increase + assertEq Verbosity.superVerbose Verbosity.verbose.increase + assertEq Verbosity.superVerbose Verbosity.superVerbose.increase /-- At silent verbosity the report hides passes but shows failures and the summary line. -/ @[test] diff --git a/src/errata/Errata/CompileTime.lean b/src/errata/Errata/CompileTime.lean index b29cab4ca..d104dea04 100644 --- a/src/errata/Errata/CompileTime.lean +++ b/src/errata/Errata/CompileTime.lean @@ -22,14 +22,21 @@ set_option doc.verso true /-- When true, a failing Errata compile-time test is an elaboration error rather than a warning. -/ -register_option Errata.failOnError : Bool := { +register_option errata.failOnError : Bool := { defValue := false descr := "Make a failing Errata compile-time test an elaboration error rather than a warning." } namespace Errata -/-- Checks that the command below produces the messages given in the preceding doc comment. -/ +/-- +Checks that the command below produces the messages given in the preceding doc comment. + +This is a version of `#guard_msgs` that is specialized for use in Errata. If the messages +don't match, it is not a compile-time error unless the option {lit}`errata.failOnError` is +{name}`true`. This allows failing compile-time tests to appear in the test output together +with failing run-time tests. +-/ syntax (name := testMsgsCmd) (plainDocComment)? "#test_msgs" "in" command : command @[command_elab testMsgsCmd] @@ -74,13 +81,21 @@ meta def elabTestMsgs : Command.CommandElab #[{ suggestion := suggestedDoc actual }] (ref? := some fixRef) let body := m!"Errata #test_msgs: the messages do not match.\n\n\ Expected:\n{expected}\n\nActual:\n{actual}" - if (← getOptions).getBool `Errata.failOnError false then + if (← getOptions).getBool `errata.failOnError false then logErrorAt tk (body ++ hint) else logWarningAt tk (body ++ hint) | _ => throwUnsupportedSyntax -/-- Checks that a Boolean expression evaluates to {lean}`true`, registering the verdict as a test. -/ +/-- +Checks that a Boolean expression evaluates to {lean}`true`, registering the verdict as a test. + +This is a version of `#guard` that is specialized for use in Errata. If the condition does not +hold, it is not a compile-time error unless the option {lit}`errata.failOnError` is +{name}`true`. This allows failing compile-time tests to appear in the test output together +with failing run-time tests. + +-/ syntax (name := testGuardCmd) "#test_guard" term : command @[command_elab testGuardCmd] @@ -108,9 +123,9 @@ meta def elabTestGuard : Command.CommandElab -- truncated multi-line expression with an ellipsis and disambiguating against earlier ones. let lines := source.splitOn "\n" -- Strip guillemets so an escaped name in the source does not nest inside the test's own name. - let firstLine := (((lines.headD source).trimAscii.copy).replace "«" "").replace "»" "" + let firstLine := lines.headD source |>.trimAscii |>.replace "«" "" |>.replace "»" "" let base := - if (lines.drop 1).any (fun l => !l.trimAscii.copy.isEmpty) then firstLine ++ "…" else firstLine + if (lines.drop 1).any (fun l => !l.trimAscii.isEmpty) then firstLine ++ "…" else firstLine let ns ← getCurrNamespace let env ← getEnv let mut name := base @@ -130,7 +145,7 @@ meta def elabTestGuard : Command.CommandElab -- Report a failure at build time, as `#test_msgs` does. unless passed do let body := m!"Errata #test_guard: the expression did not evaluate to `true`:\n{source}" - if (← getOptions).getBool `Errata.failOnError false then + if (← getOptions).getBool `errata.failOnError false then logErrorAt tk body else logWarningAt tk body diff --git a/src/errata/Errata/Context.lean b/src/errata/Errata/Context.lean index ff137f47a..c93256219 100644 --- a/src/errata/Errata/Context.lean +++ b/src/errata/Errata/Context.lean @@ -37,6 +37,8 @@ structure Context where moduleName : String := "" /-- The running test declaration's name below its module. -/ test : String := "" + /-- The running test's docstring, rendered as Markdown, when it has one. -/ + description? : Option String := none /-- The named result currently being recorded, below the test. -/ resultPath : Array String := #[] /-- diff --git a/src/errata/Errata/Discovery.lean b/src/errata/Errata/Discovery.lean index 41971f7a2..3fa7327b6 100644 --- a/src/errata/Errata/Discovery.lean +++ b/src/errata/Errata/Discovery.lean @@ -46,7 +46,9 @@ structure TestDecl where name : Name /-- The source file that defines the test. -/ file : String - deriving Inhabited + /-- The test's docstring, rendered as Markdown, captured when the attribute is applied. -/ + docstring? : Option String := none +deriving Inhabited /-- The tests recorded by {lit}`@[test]`, per module. The attribute is an elaboration-time feature: @@ -60,10 +62,13 @@ meta initialize testExt : SimplePersistentEnvExtension TestDecl (Array TestDecl) addImportedFn := fun es => es.foldl Array.append #[] } -/-- Records a declaration as a test, capturing the source file that defines it. -/ +/-- Records a declaration as a test, capturing the source file that defines it and its docstring. +The docstring is read here, while it is still in the live environment, since a downstream build does +not load the imported docstrings. -/ meta def recordTest (decl : Name) : AttrM Unit := do (checkIsTest decl).run' - modifyEnv (testExt.addEntry · { name := decl, file := ← getFileName }) + let docstring? ← findDocString? (← getEnv) decl + modifyEnv (testExt.addEntry · { name := decl, file := ← getFileName, docstring? }) /-- A synthetic syntax carrying the given source range, used to position the widget. -/ meta def rangeSyntax [Monad m] [MonadFileMap m] @@ -104,10 +109,10 @@ private meta def docStartLine? (lines : Array String) (markerLineIdx : Nat) : Op docOpenLine lines (endLine - 1) /-- -The source range to show the test's widget over: the whole declaration. When the attribute is applied -separately (as in {lit}`attribute [test] foo`), the declaration's range is already recorded. When it -is applied inline (as in {lit}`@[test] def foo`), that range is not yet available, so the command is -re-parsed from the start of the marker's line to recover it. Falls back to the marker itself. +The source range to show the test's widget over: the whole declaration, including a doc comment above +it. The recorded declaration range is used when available; otherwise the command is re-parsed from the +start of the marker's line, extending up over an immediately preceding doc comment. Falls back to the +marker itself. -/ meta def widgetRangeSyntax (decl : Name) (attrStx : Syntax) : AttrM Syntax := do let fileMap ← getFileMap @@ -135,7 +140,8 @@ meta initialize ref := `Errata.test name := `test descr := "Marks a definition as a test, discovered and run by the Errata test runner." - applicationTime := .afterTypeChecking + -- Applied after compilation so the declaration's docstring is in the environment to capture. + applicationTime := .afterCompilation add := fun decl stx kind => do Attribute.Builtin.ensureNoArgs stx unless kind == AttributeKind.global do throwAttrMustBeGlobal `test kind @@ -190,10 +196,14 @@ meta def elabGetAllTests : TermElab := fun stx expectedType? => do let range ← findDeclarationRanges? test.name let pos := (range.map (·.range.pos)).getD ⟨0, 0⟩ let endPos := (range.map (·.range.endPos)).getD ⟨0, 0⟩ + -- The docstring captured when the attribute was applied, so the report and widget can show it. + let docStx ← match test.docstring? with + | some doc => `(some $(quote doc)) + | none => `((none : Option String)) entries := entries.push <| ← `(Errata.TestEntry.of $(quote package) $(quote moduleStr) $(quote testName) (Errata.Location.mk $(quote test.file) (Errata.Position.mk $(quote pos.line) $(quote pos.column)) (Errata.Position.mk $(quote endPos.line) $(quote endPos.column))) - (@$(mkIdent userName))) + (@$(mkIdent userName)) (docstring? := $docStx)) elabTerm (← `(#[$entries,*])) expectedType? diff --git a/src/errata/Errata/Property.lean b/src/errata/Errata/Property.lean index a3999fa2d..12aa48d68 100644 --- a/src/errata/Errata/Property.lean +++ b/src/errata/Errata/Property.lean @@ -26,7 +26,8 @@ def property (p : Prop) (cfg : Configuration := {}) (loc : Location := by exact let ctx ← read let cfg := { cfg with quiet := true, - randomSeed := ctx.seed.orElse (fun _ => cfg.randomSeed) } + randomSeed := ctx.seed.orElse (fun _ => cfg.randomSeed) + } match ← Testable.checkIO p' (cfg := cfg) with | .success _ => pure () | .gaveUp n => failAt loc s!"property gave up after discarding {n} cases" diff --git a/src/errata/Errata/Report.lean b/src/errata/Errata/Report.lean index 42842239b..94be3c9ad 100644 --- a/src/errata/Errata/Report.lean +++ b/src/errata/Errata/Report.lean @@ -29,19 +29,26 @@ private def indentLines (text : String) : String := private def locationText (l : Location) : String := s!"{l.file}:{l.startPos.line}:{l.startPos.column}" -/-- Prints one result: its status line, and for a failure its detail and captured output. -/ -private def printResult (r : Result) : IO Unit := do +/-- Prints one result: its status line, its docstring when shown, and for a failure its detail and +captured output. A failure or error shows its docstring; a pass or skip shows it only when the +verbosity does. -/ +private def printResult (verbosity : Verbosity) (r : Result) : IO Unit := do let name := s!"{r.moduleTarget} {r.testName}" + let printDoc : IO Unit := do + if verbosity.showsAllDocstrings || !r.status.isSuccess then + if let some d := r.description? then IO.println (indentLines d) match r.status with - | .pass => IO.println s!"ok {name} ({r.durationMs}ms)" - | .skip reason => IO.println s!"skip {name}: {reason}" + | .pass => IO.println s!"ok {name} ({r.durationMs}ms)"; printDoc + | .skip reason => IO.println s!"skip {name}: {reason}"; printDoc | .fail f => IO.println s!"FAIL {name}: {f.message}" + printDoc if let some l := f.location? then IO.println (indentLines (locationText l)) if let some d := f.detail? then IO.println (indentLines d) unless r.output.isEmpty do IO.println (indentLines s!"output:\n{r.output.all}") | .error m => IO.println s!"ERROR {name}: {m}" + printDoc unless r.output.isEmpty do IO.println (indentLines s!"output:\n{r.output.all}") /-- A running tally of results suppressed by truncation. -/ @@ -105,15 +112,27 @@ def humanReport (verbosity : Verbosity) (results : Array Result) : IO Nat := do if verbosity.truncates && shown ≥ cap then more := more.add r.status else - printResult r + printResult verbosity r shown := shown + 1 printSuppressed more IO.println s!"{passed} passed, {failed} failed, {errors} errors, {skipped} skipped" return failed + errors +/-- +Drops the control characters XML 1.0 forbids even when escaped: those below {lit}`U+0020` other than +tab, newline, and carriage return. +-/ +private def dropXmlForbidden (s : String) : String := + s.foldl (init := "") fun acc c => + if c == '\t' || c == '\n' || c == '\r' || Nat.ble 0x20 c.toNat then acc.push c else acc + +/-- +Escapes text for XML and drops characters XML 1.0 forbids even when escaped, so a captured ANSI escape +or NUL byte in a message or output fragment cannot make the report malformed. +-/ private def xmlEscape (s : String) : String := - s.replace "&" "&" |>.replace "<" "<" |>.replace ">" ">" - |>.replace "\"" """ + dropXmlForbidden <| + s.replace "&" "&" |>.replace "<" "<" |>.replace ">" ">" |>.replace "\"" """ instance : ToJson Location where toJson l := json%{ @@ -129,7 +148,8 @@ instance : FromJson Location where return { file := ← j.getObjValAs? String "file", startPos := ⟨← j.getObjValAs? Nat "startLine", ← j.getObjValAs? Nat "startColumn"⟩, - endPos := ⟨← j.getObjValAs? Nat "endLine", ← j.getObjValAs? Nat "endColumn"⟩ } + endPos := ⟨← j.getObjValAs? Nat "endLine", ← j.getObjValAs? Nat "endColumn"⟩ + } instance : ToJson Output where toJson @@ -168,7 +188,7 @@ private def byModule (results : Array Result) : Array (String × Array Result) : for r in results do let s := suiteOf r if !groups.contains s then order := order.push s - groups := groups.insert s ((groups.getD s #[]).push r) + groups := groups.alter s fun cur => some ((cur.getD #[]).push r) return order.map fun s => (s, groups.getD s #[]) /-- Renders the results as JUnit XML, grouping by the module path. -/ @@ -216,7 +236,8 @@ instance : ToJson Result where ("test", Json.str r.test), ("resultPath", ToJson.toJson r.resultPath), ("durationMs", ToJson.toJson r.durationMs)] ++ statusFields r.status ++ - (if r.output.isEmpty then [] else [("output", ToJson.toJson r.output)]) + (if r.output.isEmpty then [] else [("output", ToJson.toJson r.output)]) ++ + (match r.description? with | some d => [("description", Json.str d)] | none => []) /-- Decodes an optional field: absent maps to {lean}`none`. -/ private def optField [FromJson α] (j : Json) (key : String) : Except String (Option α) := @@ -233,7 +254,8 @@ instance : FromJson Status where | "fail" => return .fail { message := ← j.getObjValAs? String "message", detail? := ← optField j "detail", - location? := ← optField j "location" } + location? := ← optField j "location" + } | other => .error s!"unknown status: {other}" instance : FromJson Result where @@ -245,7 +267,9 @@ instance : FromJson Result where resultPath := ← j.getObjValAs? (Array String) "resultPath", durationMs := ← j.getObjValAs? Nat "durationMs", status := ← FromJson.fromJson? j, - output := (← optField j "output").getD {} } + output := (← optField j "output").getD {}, + description? := ← optField j "description" + } /-- Renders the results as a JSON array of objects. -/ def jsonReport (results : Array Result) : String := (ToJson.toJson results).pretty @@ -277,6 +301,7 @@ def markdownReport (results : Array Result) : String := Id.run do let render (mark message : String) (detail? : Option String) : String := Id.run do let mut s := s!"<details open><summary>{mark} <code>{xmlEscape r.moduleTarget}</code> \ {xmlEscape r.testName}: {xmlEscape message}</summary>\n\n" + if let some d := r.description? then s := s ++ s!"{d}\n\n" if let .fail f := r.status then if let some l := f.location? then s := s ++ s!"`{locationText l}`\n\n" if let some d := detail? then s := s ++ s!"{fencedBlock d}\n\n" diff --git a/src/errata/Errata/Result.lean b/src/errata/Errata/Result.lean index 79c3bdcd5..963bc37e6 100644 --- a/src/errata/Errata/Result.lean +++ b/src/errata/Errata/Result.lean @@ -20,22 +20,30 @@ inductive Verbosity where | quiet /-- Print every result. -/ | verbose + /-- Print every result, and each test's docstring alongside it, not only those that fail. -/ + | superVerbose deriving Repr, Inhabited, DecidableEq, BEq /-- Whether passes and skips are printed at this verbosity. -/ def Verbosity.showsPasses : Verbosity → Bool | .silent => false - | .quiet | .verbose => true + | .quiet | .verbose | .superVerbose => true /-- Whether each test's results are truncated after a cap at this verbosity. -/ def Verbosity.truncates : Verbosity → Bool | .quiet => true - | .silent | .verbose => false + | .silent | .verbose | .superVerbose => false -/-- The next verbosity up, for an accumulating {lit}`-v` / {lit}`-vv`. -/ +/-- Whether every result's docstring is shown, not only those of failures and errors. -/ +def Verbosity.showsAllDocstrings : Verbosity → Bool + | .superVerbose => true + | .silent | .quiet | .verbose => false + +/-- The next verbosity up, for an accumulating {lit}`-v` / {lit}`-vv` / {lit}`-vvv`. -/ def Verbosity.increase : Verbosity → Verbosity | .silent => .quiet - | .quiet | .verbose => .verbose + | .quiet => .verbose + | .verbose | .superVerbose => .superVerbose /-- A line and column within a source file, counting from one. -/ structure Position where @@ -148,6 +156,8 @@ structure Result where durationMs : Nat := 0 /-- What the test wrote to stdout and stderr. -/ output : OutputLog := {} + /-- The test's docstring, rendered as Markdown, when it has one. -/ + description? : Option String := none deriving Repr, Inhabited, DecidableEq /-- The test name below the module: the declaration and any named result, dotted. -/ @@ -171,4 +181,6 @@ def TestResult.mismatch (message detail file : String) location? := some { file, startPos := { line := startLine, column := startCol }, - endPos := { line := endLine, column := endCol } } } + endPos := { line := endLine, column := endCol } + } + } diff --git a/src/errata/Errata/RunOne.lean b/src/errata/Errata/RunOne.lean index a763bf6b5..d6e724c1f 100644 --- a/src/errata/Errata/RunOne.lean +++ b/src/errata/Errata/RunOne.lean @@ -30,7 +30,7 @@ def OutputChunk.ofOutput : Output → OutputChunk | .stderr s => { stream := "stderr", text := s } /-- -The outcome of running a single test, in a form the infoview widget renders. The status is one of +The outcome of running a single test, in a form the InfoView widget renders. The status is one of {lit}`"passed"`, {lit}`"failed"`, {lit}`"error"`, or {lit}`"skipped"`. -/ structure RunOutcome where @@ -44,6 +44,8 @@ structure RunOutcome where detail? : Option String := none /-- The captured output, in order, with each chunk tagged by the stream it was written to. -/ output : Array OutputChunk := #[] + /-- The test's docstring, rendered as Markdown, when it has one. -/ + description? : Option String := none deriving Lean.FromJson, Lean.ToJson, Repr, Inhabited /-- The status name a single result contributes. -/ @@ -107,10 +109,12 @@ def runValue {α} [IsTest α] (location : Location) (value : α) let dur := (← IO.monoMsNow) - start let logged ← log.get let results := - match outcome with - | .error e => logged.push { cfg.error (toString e) dur with output } - | .ok (.error f) => logged.push { cfg.fail f dur with output } - | .ok (.ok ()) => if logged.isEmpty then #[{ cfg.pass dur with output }] else logged + match cfg.resultOfOutcome outcome output dur (!logged.isEmpty) with + | some r => logged.push r + | none => + -- A passing test with named results: the results stand for it, but keep the test's own + -- top-level output (written outside any result block) so the widget still shows it. + if output.log.isEmpty then logged else logged.push { cfg.pass 0 with output } return summarizeResults results /-- Runs one testable value with a default failure location, for callers without a source range. -/ diff --git a/src/errata/Errata/Runner.lean b/src/errata/Errata/Runner.lean index 20c9302d7..7f4464c36 100644 --- a/src/errata/Errata/Runner.lean +++ b/src/errata/Errata/Runner.lean @@ -26,16 +26,19 @@ structure TestEntry where test : String /-- The test's own source range, used as the default failure location. -/ location : Location + /-- The test's docstring, rendered as Markdown, when it has one. -/ + docstring? : Option String := none /-- The action to run. -/ run : TestM Unit /-- Builds a test entry from any testable value. -/ def TestEntry.of {α} [IsTest α] (package moduleName test : String) (location : Location) - (value : α) : TestEntry where + (value : α) (docstring? : Option String := none) : TestEntry where package := package moduleName := moduleName test := test location := location + docstring? := docstring? run := IsTest.toTest value /-- Runs a single test entry, collecting all of its results. -/ @@ -43,17 +46,16 @@ def runEntry (cfg : Context) (entry : TestEntry) : IO (Array Result) := do let log ← IO.mkRef (#[] : Array Result) let ctx := { cfg with package := entry.package, moduleName := entry.moduleName, test := entry.test, - resultPath := #[], location := entry.location, log } + resultPath := #[], location := entry.location, log, description? := entry.docstring? + } let start ← IO.monoMsNow let (outcome, output) ← runCapturing ctx entry.run let stop ← IO.monoMsNow let dur := stop - start let logged ← log.get - match outcome with - | .error e => return logged.push { ctx.error (toString e) dur with output } - | .ok (.error f) => return logged.push { ctx.fail f dur with output } - | .ok (.ok ()) => - if logged.isEmpty then return #[ctx.pass dur] else return logged + return match ctx.resultOfOutcome outcome output dur (!logged.isEmpty) with + | some r => logged.push r + | none => logged /-- Runs all the test entries and collects their results. -/ def run (cfg : Context) (entries : Array TestEntry) : IO (Array Result) := do diff --git a/src/errata/Errata/TestM.lean b/src/errata/Errata/TestM.lean index 662ffd103..e0a227df1 100644 --- a/src/errata/Errata/TestM.lean +++ b/src/errata/Errata/TestM.lean @@ -81,9 +81,10 @@ def flag (name : String) : TestM Bool := | none => false /-- Builds a result for the current scope with the given status and duration. -/ -def Context.mkResult (ctx : Context) (status : Status) (durationMs : Nat := 0) : Result := - { package := ctx.package, moduleName := ctx.moduleName, test := ctx.test, - resultPath := ctx.resultPath, status, durationMs } +def Context.mkResult (ctx : Context) (status : Status) (durationMs : Nat := 0) : Result := { + package := ctx.package, moduleName := ctx.moduleName, test := ctx.test, + resultPath := ctx.resultPath, status, durationMs, description? := ctx.description? +} /-- A passing result for the current scope. -/ def Context.pass (ctx : Context) (durationMs : Nat := 0) : Result := @@ -101,6 +102,21 @@ def Context.error (ctx : Context) (message : String) (durationMs : Nat := 0) : R def Context.skip (ctx : Context) (reason : String) (durationMs : Nat := 0) : Result := ctx.mkResult (.skip reason) durationMs +/-- +The result a captured run contributes beyond any nested results it recorded. + +A raised error or a failed assertion becomes one error or failed result carrying the captured output. +A clean run becomes one passing result with the output when it recorded no nested results; when it did +record some, those results stand for it and it adds nothing of its own. +-/ +def Context.resultOfOutcome (ctx : Context) + (outcome : Except IO.Error (Except TestFailure Unit)) (output : OutputLog) (durationMs : Nat) + (hasNested : Bool) : Option Result := + match outcome with + | .error e => some { ctx.error (toString e) durationMs with output } + | .ok (.error f) => some { ctx.fail f durationMs with output } + | .ok (.ok ()) => if hasNested then none else some { ctx.pass durationMs with output } + /-- Records a skipped result for the current scope. -/ def skip (reason : String) : TestM Unit := do let ctx ← read @@ -110,7 +126,10 @@ def skip (reason : String) : TestM Unit := do private def captureStream (emit : Output → IO Unit) (mk : String → Output) : IO.FS.Stream where flush := pure () read _ := pure .empty - write bytes := emit (mk (String.fromUTF8! bytes)) + write bytes := + match String.fromUTF8? bytes with + | some s => emit (mk s) + | none => throw (.userError "captured test output was not valid UTF-8") getLine := pure "" putStr s := emit (mk s) isTty := pure false @@ -156,14 +175,8 @@ def result (name : String) (act : TestM Unit) : TestM Unit := let stop ← IO.monoMsNow let dur := stop - start let after := (← ctx.log.get).size - match outcome with - | .error e => - ctx.log.modify (·.push { ctx.error (toString e) dur with output }) - | .ok (.error f) => - ctx.log.modify (·.push { ctx.fail f dur with output }) - | .ok (.ok ()) => - if after == before then - ctx.log.modify (·.push (ctx.pass dur)) + if let some r := ctx.resultOfOutcome outcome output dur (after != before) then + ctx.log.modify (·.push r) /-- Expects the action to fail an assertion. The current scope passes if it does and fails if it diff --git a/src/errata/Errata/Widget.lean b/src/errata/Errata/Widget.lean index ca9267ed4..ef5dd79c4 100644 --- a/src/errata/Errata/Widget.lean +++ b/src/errata/Errata/Widget.lean @@ -21,16 +21,13 @@ open Lean namespace Errata.Widget /-- -The infoview widget shown when the text cursor is on a test's {lit}`@[test]` marker. It offers a Run +The InfoView widget shown when the text cursor is on a test's {lit}`@[test]` marker. It offers a Run button that runs the test in the language server, streaming its output as it is produced. -/ @[widget_module] meta def runTestWidget : Lean.Widget.Module where javascript := include_str "widget/run_test_widget.js" -/-- The single-test runner exe, relative to the workspace root the server runs in. -/ -private meta def runnerPath : String := ".lake/build/bin/errata-run-one" - /-- The current wall-clock time in milliseconds since the Unix epoch. -/ private meta def nowMs : IO Nat := return (← Std.Time.Timestamp.now).toMillisecondsSinceUnixEpoch.toInt.toNat @@ -59,7 +56,10 @@ meta structure RunState where buildMs : IO.Ref Nat /-- When the test body started (reported by the runner), in epoch ms; 0 until then. -/ execStartTime : IO.Ref Nat - /-- Kills the current process (the build, then the runner); updated as each is spawned. -/ + /-- + The process to be killed if the run is cancelled. Contains first the build, then the runner. + Updated as each is spawned. + -/ kill : IO.Ref (IO Unit) /-- The live runs, keyed by the test's declaration name so a run survives re-elaboration. -/ @@ -160,29 +160,43 @@ private meta partial def readLoop (out : IO.FS.Handle) (state : RunState) : IO U readLoop out state /-- The outcome shown when the build step fails, carrying its message and detail. -/ -private meta def buildFailure (detail : String) : Errata.RunOutcome := - { status := "error", durationMs := 0, message? := some "lake build failed", detail? := some detail } +private meta def buildFailure (detail : String) : Errata.RunOutcome := { + status := "error", durationMs := 0, message? := some "lake build failed", detail? := some detail +} /-- Builds the test's module from the saved source, then runs the test, streaming its output into the run state. Building first means a Run reflects the latest saved version of the test. -/ private meta def buildAndRun (module declJson : String) (state : RunState) : IO Unit := do + -- `lake query` builds the runner exe and the test's module (so the run reflects the saved source) + -- and prints the exe's absolute path on stdout; progress and errors go to stderr. let build ← IO.Process.spawn { stdin := .null, stdout := .piped, stderr := .piped - cmd := "lake", args := #["build", "errata-run-one", module] } + cmd := "lake", args := #["query", "errata-run-one", module] + } state.kill.set build.kill let errTask ← IO.asTask build.stderr.readToEnd - let _ ← build.stdout.readToEnd + let queryOut ← build.stdout.readToEnd let buildErr := (← IO.wait errTask).toOption.getD "" if (← build.wait) != 0 then state.outcome.set (some (buildFailure buildErr)) state.finished.set true signalRun state return + let some runnerPath := (queryOut.splitOn "\n").find? (!·.trimAscii.isEmpty) |>.map (·.trimAscii.copy) + | state.outcome.set (some (buildFailure "lake query did not report the runner's path")) + state.finished.set true + signalRun state + return + -- Spawn the runner directly rather than through `lake exe` so it inherits the language server's + -- broad `LEAN_PATH`. The runner imports the arbitrary test module at runtime, which is not a + -- dependency of the exe, so `lake exe` would narrow `LEAN_PATH` to the exe's own deps and the + -- import would fail. let run ← IO.Process.spawn { stdin := .null, stdout := .piped, stderr := .inherit - cmd := runnerPath, args := #[module, declJson] } + cmd := runnerPath, args := #[module, declJson] + } state.kill.set run.kill state.buildMs.set ((← nowMs) - state.startTime) state.phase.set "running" @@ -217,7 +231,8 @@ meta def startTest (req : StartRequest) : RequestM (RequestTask Unit) := do chunks := ← IO.mkRef #[], finished := ← IO.mkRef false, outcome := ← IO.mkRef none, wakeup := ← IO.mkRef (← IO.Promise.new), phase := ← IO.mkRef "building", version := req.version, startTime := ← nowMs, buildMs := ← IO.mkRef 0, execStartTime := ← IO.mkRef 0, - kill := ← IO.mkRef (pure ()) } + kill := ← IO.mkRef (pure ()) + } runRegistry.modify (·.insert declName state) let _ ← IO.asTask (buildAndRun req.module req.decl.compress state) return RequestTask.pure () diff --git a/src/errata/Errata/usage.txt b/src/errata/Errata/usage.txt index f5b292966..667894a7b 100644 --- a/src/errata/Errata/usage.txt +++ b/src/errata/Errata/usage.txt @@ -8,7 +8,8 @@ Usage: Runner options go after `--test-options`; tokens before it name libraries. A library is a bare `Library` in this package or a `package/Library` reaching into a dependency. Runner options: - -v, --verbose Also report passes (truncating each test's results); repeat (-vv) for all. + -v, --verbose Also report passes (truncating each test's results); repeat (-vv) for all, + -vvv to also show every test's docstring, not only those that fail. --update-golden Rewrite golden expected files instead of comparing. --seed N Seed property tests with N, to reproduce a failure. --junit PATH Write a JUnit XML report to PATH. diff --git a/src/errata/Errata/widget/run_test_widget.js b/src/errata/Errata/widget/run_test_widget.js index d4fd826f3..3fb98f59b 100644 --- a/src/errata/Errata/widget/run_test_widget.js +++ b/src/errata/Errata/widget/run_test_widget.js @@ -4,7 +4,7 @@ import { useRpcSession } from "@leanprover/infoview"; const e = React.createElement; -// Persists the last outcome per test for the lifetime of the infoview session, so leaving and +// Persists the last outcome per test for the lifetime of the InfoView session, so leaving and // returning to a test's `@[test]` marker shows its previous result rather than a blank widget. const resultCache = new Map(); @@ -201,7 +201,7 @@ export default function (props) { ); } - // The infoview reuses one component instance for whichever test the cursor is on, so reset and + // The InfoView reuses one component instance for whichever test the cursor is on, so reset and // reconnect whenever the test changes (keyed on `cacheKey`), not just on mount. Restores any cached // outcome for this test and replays an in-progress run from the start. React.useEffect( @@ -481,9 +481,34 @@ export default function (props) { if (outcome && outcome.message) extras.push(e("div", { key: "msg" }, block(outcome.message))); if (outcome && outcome.detail) extras.push(e("div", { key: "detail" }, block(outcome.detail))); + // The test's docstring, rendered by Lean to Markdown and shown as text alongside its result. + const descriptionSection = + outcome && outcome.description + ? e( + "div", + { + key: "description", + style: { + marginTop: "4px", + fontSize: "12px", + opacity: 0.85, + whiteSpace: "pre-wrap", + }, + }, + outcome.description, + ) + : null; + const body = - infoRow || extras.length || outputSection - ? e("div", { style: { marginTop: "4px" } }, infoRow, ...extras, outputSection) + infoRow || descriptionSection || extras.length || outputSection + ? e( + "div", + { style: { marginTop: "4px" } }, + infoRow, + descriptionSection, + ...extras, + outputSection, + ) : null; return e("div", { style: { padding: "2px 0" } }, header, body); diff --git a/src/errata/Errata/widget/widget-externals.d.ts b/src/errata/Errata/widget/widget-externals.d.ts index 184c5d540..cb9faad77 100644 --- a/src/errata/Errata/widget/widget-externals.d.ts +++ b/src/errata/Errata/widget/widget-externals.d.ts @@ -1,5 +1,5 @@ // Minimal ambient declarations for the npm packages the run-test widget imports. The widget is -// served as-is to the infoview, which supplies React and the infoview RPC API at runtime, so only +// served as-is to the InfoView, which supplies React and the InfoView RPC API at runtime, so only // the surface the widget uses is declared here, enough for `tsc` to type-check the rest. declare module "react" { diff --git a/src/errata/ErrataRunOne.lean b/src/errata/ErrataRunOne.lean index b27fed2a3..7cae3c6ae 100644 --- a/src/errata/ErrataRunOne.lean +++ b/src/errata/ErrataRunOne.lean @@ -21,7 +21,7 @@ Evaluates the test named by {lean}`declName` in the current environment to a run The action is reached through {name}`Errata.IsTest.toTest` so any testable type works, and through {lit}`import all` of its module so a module-private test is still reachable. -/ -unsafe def evalTestM (declName : Name) : CoreM (Errata.TestM Unit) := +unsafe def evalTestM (declName : Name) : CoreM (Errata.TestM Unit × Option String) := MetaM.run' do let env ← getEnv -- The widget passes the declaration's real name, but a module-private test is mangled, so fall @@ -40,7 +40,8 @@ unsafe def evalTestM (declName : Name) : CoreM (Errata.TestM Unit) := | _ => throwError "`{declName}` is not a test" let act := mkApp3 (mkConst ``Errata.IsTest.toTest) declType inst decl let ty := mkApp (mkConst ``Errata.TestM) (mkConst ``Unit) - evalExpr (Errata.TestM Unit) ty act (safety := .unsafe) + let test ← evalExpr (Errata.TestM Unit) ty act (safety := .unsafe) + return (test, ← findDocString? env realName) /-- Writes one JSON protocol line to the runner's real stdout and flushes it for prompt streaming. -/ private def emitLine (out : IO.FS.Stream) (key : String) (value : Json) : IO Unit := do @@ -66,7 +67,7 @@ unsafe def runImpl (args : List String) : IO UInt32 := do let env ← importModules #[{ module := targetModule, importAll := true }, { module := `Errata }] {} (loadExts := true) let coreCtx : Core.Context := { fileName := "<errata-run-one>", fileMap := default } - let (act, _) ← (evalTestM declName).toIO coreCtx { env } + let ((act, doc?), _) ← (evalTestM declName).toIO coreCtx { env } -- Mark when the test body starts, so the widget shows output offsets within the test itself, -- excluding the build and module-import time before this point. emitLine out "exec" (toJson (← nowMs)) @@ -74,7 +75,7 @@ unsafe def runImpl (args : List String) : IO UInt32 := do let chunk := { Errata.OutputChunk.ofOutput o with time := ← nowMs } emitLine out "chunk" (toJson chunk) let outcome ← Errata.runValue default act (sink := sink) - emitLine out "outcome" (toJson outcome) + emitLine out "outcome" (toJson { outcome with description? := doc? }) return 0 @[implemented_by runImpl] From a91db5d61ab98a45203ed3d169044773a2524900 Mon Sep 17 00:00:00 2001 From: David Thrane Christiansen <david@davidchristiansen.dk> Date: Wed, 1 Jul 2026 11:15:58 +0200 Subject: [PATCH 15/26] separate Lakefile contents --- lakefile.lean | 22 ++++++++++++++-------- 1 file changed, 14 insertions(+), 8 deletions(-) diff --git a/lakefile.lean b/lakefile.lean index aa9db46e4..6d4f319fc 100644 --- a/lakefile.lean +++ b/lakefile.lean @@ -124,6 +124,18 @@ lean_exe «verso-literate-plan» where srcDir := "src/verso-literate-plan" supportInterpreter := true +-- All test code: Errata test modules, compile-time tests, fixtures, and generators. Submodules are +-- globbed so each is built and every `@[test]` module is discoverable. +@[default_target] +lean_lib VersoTests where + srcDir := "src/tests" + roots := #[`VersoTests] + globs := #[Glob.andSubmodules `VersoTests] + +-- Everything below is Errata's own implementation: its library, the single-test runner and widget +-- support exe, its self-tests, the generated discovery runner, and the `lake test` driver. +section Errata + @[default_target] input_file errataUsageFile where text := true @@ -150,14 +162,6 @@ lean_lib ErrataTests where srcDir := "src/errata-tests" roots := #[`ErrataTests] --- All test code: Errata test modules, compile-time tests, fixtures, and generators. Submodules are --- globbed so each is built and every `@[test]` module is discoverable. -@[default_target] -lean_lib VersoTests where - srcDir := "src/tests" - roots := #[`VersoTests] - globs := #[Glob.andSubmodules `VersoTests] - -- The selected test set, written by the driver. The generated targets depend on it, so changing -- the selection changes their trace and Lake rebuilds them rather than relinking a stale object. input_file errataSelection where @@ -369,6 +373,8 @@ script «errata-test» (args) do let child ← IO.Process.spawn { cmd := exePath.toString, args := runnerArgs.toArray } child.wait +end Errata + lean_lib UsersGuide where srcDir := "doc" leanOptions := #[⟨`weak.linter.verso.manual.headerTags, true⟩] From e66a331af3fc177e4fd9ff59ca117bb6667751e3 Mon Sep 17 00:00:00 2001 From: David Thrane Christiansen <david@davidchristiansen.dk> Date: Wed, 1 Jul 2026 11:21:58 +0200 Subject: [PATCH 16/26] migrate test post-merge --- src/tests/VersoTests/LiterateHtml.lean | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/tests/VersoTests/LiterateHtml.lean b/src/tests/VersoTests/LiterateHtml.lean index 11a988c9a..622d6afd8 100644 --- a/src/tests/VersoTests/LiterateHtml.lean +++ b/src/tests/VersoTests/LiterateHtml.lean @@ -224,8 +224,8 @@ private def testAllBuiltinDocRoles (data : TestData) : Test := withTestDir data assertContains "\"content\":\"lhs\",\"kind\":{\"keyword\":{\"docs\":\"" jsonContent "Builtins JSON has no docs on the `lhs` keyword token. \ The conv handler did not attach the syntax kind's docstring." - unless hasSubstring jsonContent "{\"content\":\"funext\",\"kind\":{\"keyword\":{\"docs\":\"" do - throw <| IO.userError "Builtins JSON has no docs on the `funext` keyword token. \ + assertContains "{\"content\":\"funext\",\"kind\":{\"keyword\":{\"docs\":\"" jsonContent + "Builtins JSON has no docs on the `funext` keyword token. \ The kw handler did not attach the syntax kind's docstring." /-- From cbe0cbf18421749d6ad2cb9fe93f4445739a53bb Mon Sep 17 00:00:00 2001 From: David Thrane Christiansen <david@davidchristiansen.dk> Date: Wed, 1 Jul 2026 11:57:09 +0200 Subject: [PATCH 17/26] Shake Errata --- src/errata/Errata/CompileTime.lean | 2 -- src/errata/Errata/Context.lean | 1 - src/errata/Errata/Report.lean | 1 - src/errata/Errata/RunOne.lean | 3 ++- 4 files changed, 2 insertions(+), 5 deletions(-) diff --git a/src/errata/Errata/CompileTime.lean b/src/errata/Errata/CompileTime.lean index d104dea04..269bf2565 100644 --- a/src/errata/Errata/CompileTime.lean +++ b/src/errata/Errata/CompileTime.lean @@ -6,11 +6,9 @@ Author: David Thrane Christiansen module public import Errata.Result -import Errata.Discovery public meta import Errata.CompileTime.Helpers public import Lean.Elab.Command public import Lean.Data.Options -import Lean.Meta.Hint import Lean open Lean Elab Command Errata.CompileTime diff --git a/src/errata/Errata/Context.lean b/src/errata/Errata/Context.lean index c93256219..d72d8060a 100644 --- a/src/errata/Errata/Context.lean +++ b/src/errata/Errata/Context.lean @@ -5,7 +5,6 @@ Author: David Thrane Christiansen -/ module -public import Std.Data.HashMap public import Std.Data.HashSet public import Errata.Result diff --git a/src/errata/Errata/Report.lean b/src/errata/Errata/Report.lean index 94be3c9ad..e220b50f3 100644 --- a/src/errata/Errata/Report.lean +++ b/src/errata/Errata/Report.lean @@ -7,7 +7,6 @@ module public import Errata.Result public import Lean.Data.Json -import Std.Data.HashMap public section diff --git a/src/errata/Errata/RunOne.lean b/src/errata/Errata/RunOne.lean index d6e724c1f..2232afd18 100644 --- a/src/errata/Errata/RunOne.lean +++ b/src/errata/Errata/RunOne.lean @@ -5,7 +5,8 @@ Author: David Thrane Christiansen -/ module -public import Errata.Runner +public import Errata.IsTest +public import Lean.Data.Json public section From 0734cc8bd26c5b8427c048fec6603a2a65e275d6 Mon Sep 17 00:00:00 2001 From: David Thrane Christiansen <david@davidchristiansen.dk> Date: Wed, 1 Jul 2026 12:01:33 +0200 Subject: [PATCH 18/26] cleanup --- .github/workflows/no-eval-in-source.yml | 3 ++- src/errata-tests/ErrataTests.lean | 2 +- src/errata/Errata/CompileTime.lean | 1 - 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/no-eval-in-source.yml b/.github/workflows/no-eval-in-source.yml index 29b5e75a8..671d654fa 100644 --- a/.github/workflows/no-eval-in-source.yml +++ b/.github/workflows/no-eval-in-source.yml @@ -25,10 +25,11 @@ jobs: fi done < <(find ./src -path ./src/tests -prune -o \ -path ./src/test-projects -prune -o \ + -path ./src/errata-tests -prune -o \ -name "*.lean" -type f -print0) if [ ${#OFFENDING_FILES[@]} -gt 0 ]; then - echo "Found #eval statements in module source files (should be in src/tests/):" + echo "Found #eval statements in module source files (should be in src/tests/ or src/errata-tests/):" printf '%s\n' "${OFFENDING_FILES[@]}" echo "" echo "Offending lines:" diff --git a/src/errata-tests/ErrataTests.lean b/src/errata-tests/ErrataTests.lean index 61b4b4044..b3ad27a4c 100644 --- a/src/errata-tests/ErrataTests.lean +++ b/src/errata-tests/ErrataTests.lean @@ -217,4 +217,4 @@ def alternativeFailure : Test := expectFail failure /-- `<|>` recovers from an assertion failure by running the alternative. -/ @[test] -def alternativeOrElse : Test := failure <|> assertEq 1 1 \ No newline at end of file +def alternativeOrElse : Test := failure <|> assertEq 1 1 diff --git a/src/errata/Errata/CompileTime.lean b/src/errata/Errata/CompileTime.lean index 269bf2565..6849535a0 100644 --- a/src/errata/Errata/CompileTime.lean +++ b/src/errata/Errata/CompileTime.lean @@ -9,7 +9,6 @@ public import Errata.Result public meta import Errata.CompileTime.Helpers public import Lean.Elab.Command public import Lean.Data.Options -import Lean open Lean Elab Command Errata.CompileTime From c34a7a4b20fa35bf3fbce48ce9b3c2c8da752e10 Mon Sep 17 00:00:00 2001 From: David Thrane Christiansen <david@davidchristiansen.dk> Date: Wed, 1 Jul 2026 12:14:56 +0200 Subject: [PATCH 19/26] migrate --- src/tests/VersoTests/Interactive.lean | 10 +++++----- src/tests/VersoTests/LeanCode.lean | 14 +++++++------- 2 files changed, 12 insertions(+), 12 deletions(-) diff --git a/src/tests/VersoTests/Interactive.lean b/src/tests/VersoTests/Interactive.lean index 8f6a3d499..291964ac5 100644 --- a/src/tests/VersoTests/Interactive.lean +++ b/src/tests/VersoTests/Interactive.lean @@ -10,11 +10,11 @@ import Errata open Errata /-- -The interactive tests exercise the LSP server through a shell harness. The harness inherits this -process's standard streams, so its own output appears directly; a non-zero exit is the failure. +Use a shell harness to test the LSP server. -/ @[test] def interactive : Test := do - let child ← IO.Process.spawn { cmd := "src/tests/interactive/run_interactive.sh" } - let exitCode ← child.wait - assert (exitCode == 0) s!"interactive LSP tests failed with exit code {exitCode}" + let out ← IO.Process.output { cmd := "src/tests/interactive/run_interactive.sh" } + IO.print out.stdout + IO.eprint out.stderr + assert (out.exitCode == 0) s!"interactive LSP tests failed with exit code {out.exitCode}" diff --git a/src/tests/VersoTests/LeanCode.lean b/src/tests/VersoTests/LeanCode.lean index 9b288169e..cbfbaaa09 100644 --- a/src/tests/VersoTests/LeanCode.lean +++ b/src/tests/VersoTests/LeanCode.lean @@ -134,13 +134,13 @@ Note: This linter can be disabled with `set_option linter.unusedVariables false` ::::::: /-- -error: Didn't match - got: ⏎ +error: Didn't match - got: [a b c] but expected: b - ⏎ + Hint: Replace with the actual message: information: a̲ @@ -148,7 +148,7 @@ Hint: Replace with the actual message: c̲ ̲ -/ -#guard_msgs in +#test_msgs in #docs (Genre.Manual) allowDiff30 "Not enough allowDiff" := ::::::: ```lean (name := foo) @@ -160,13 +160,13 @@ b ::::::: /-- -error: Didn't match even with allowDiff := 1 - got: ⏎ +error: Didn't match even with allowDiff := 1 - got: [a b c] but expected: b - ⏎ + Hint: Replace with the actual message: information: a̲ @@ -174,7 +174,7 @@ Hint: Replace with the actual message: c̲ ̲ -/ -#guard_msgs in +#test_msgs in #docs (Genre.Manual) allowDiff31 "Not enough allowDiff" := ::::::: ```lean (name := foo) @@ -185,7 +185,7 @@ b ``` ::::::: -#guard_msgs in +#test_msgs in #docs (Genre.Manual) allowDiff32 "Enough allowDiff" := ::::::: ```lean (name := foo) From 76edbb85825d7b6e76cb1361cf5d42994977dd97 Mon Sep 17 00:00:00 2001 From: David Thrane Christiansen <david@davidchristiansen.dk> Date: Wed, 1 Jul 2026 12:34:59 +0200 Subject: [PATCH 20/26] restore removed mandatory check --- .github/workflows/test-imports.yml | 52 ++++++++++++++++++++++++++++++ 1 file changed, 52 insertions(+) create mode 100644 .github/workflows/test-imports.yml diff --git a/.github/workflows/test-imports.yml b/.github/workflows/test-imports.yml new file mode 100644 index 000000000..b1a227647 --- /dev/null +++ b/.github/workflows/test-imports.yml @@ -0,0 +1,52 @@ +# This check is retained only to satisfy the required "Check all test modules are imported" status +# check on the protected branch. It is a no-op on this layout: test modules now live under +# src/tests/VersoTests and are discovered by globbing, and src/tests/Tests no longer exists, so the +# scan below finds nothing. Coverage is instead enforced by `errataWarnUncoveredTestModules` during +# `lake test`. Remove this workflow (and drop the required check) once merged. +name: All test modules imported + +on: [pull_request, merge_group] + +jobs: + check-test-imports: + name: "Check all test modules are imported" + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v7 + + - name: Check all test modules are transitively imported + run: | + # Convert file paths to module names and check imports + # e.g., src/tests/Tests/Html.lean -> Tests.Html + MISSING=() + while IFS= read -r -d '' file; do + # Convert path to module name + module=$(echo "$file" | sed 's|^src/tests/||; s|\.lean$||; s|/|.|g') + + # Check if this module is imported (directly or transitively) + # by searching for it in Tests.lean or any intermediate import file + if grep -rq "import $module" src/tests/; then + : # Module is imported, continue + else + # Check if it might be imported via a parent module + # e.g., Tests.VersoManual.Html is imported if Tests.VersoManual imports it + parent_dir=$(dirname "$file") + parent_file="$parent_dir.lean" + + if [ -f "$parent_file" ] && grep -q "import $module" "$parent_file"; then + : # Imported via parent + else + MISSING+=("$module") + fi + fi + done < <(find src/tests/Tests -name "*.lean" -print0 | sort -z) + + if [ ${#MISSING[@]} -gt 0 ]; then + echo "The following test modules are not transitively imported by the test suite:" + printf '%s\n' "${MISSING[@]}" + echo "" + echo "Please add them to src/tests/Tests.lean or an appropriate intermediate import file." + exit 1 + else + echo "All test modules are transitively imported by the test suite." + fi From 6cca9aba280ae87e4a499438eac962a76f484a66 Mon Sep 17 00:00:00 2001 From: David Thrane Christiansen <david@lean-fro.org> Date: Wed, 1 Jul 2026 22:05:00 +0200 Subject: [PATCH 21/26] Update src/errata/Errata/Widget.lean Co-authored-by: Wojciech Nawrocki <13901751+Vtec234@users.noreply.github.com> --- src/errata/Errata/Widget.lean | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/errata/Errata/Widget.lean b/src/errata/Errata/Widget.lean index ef5dd79c4..365885c07 100644 --- a/src/errata/Errata/Widget.lean +++ b/src/errata/Errata/Widget.lean @@ -21,8 +21,9 @@ open Lean namespace Errata.Widget /-- -The InfoView widget shown when the text cursor is on a test's {lit}`@[test]` marker. It offers a Run -button that runs the test in the language server, streaming its output as it is produced. +Shown when the text cursor is on a test's source span. +It offers a Run button that runs the test in the language server, +streaming its output as it is produced. -/ @[widget_module] meta def runTestWidget : Lean.Widget.Module where From e5693e59a5c030e09cef1ee126e128efcab1139b Mon Sep 17 00:00:00 2001 From: David Thrane Christiansen <david@lean-fro.org> Date: Wed, 1 Jul 2026 22:08:22 +0200 Subject: [PATCH 22/26] Update src/errata/Errata/widget/run_test_widget.js Co-authored-by: Robert J. Simmons <442315+robsimmons@users.noreply.github.com> --- src/errata/Errata/widget/run_test_widget.js | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/errata/Errata/widget/run_test_widget.js b/src/errata/Errata/widget/run_test_widget.js index 3fb98f59b..4e160b707 100644 --- a/src/errata/Errata/widget/run_test_widget.js +++ b/src/errata/Errata/widget/run_test_widget.js @@ -389,8 +389,10 @@ export default function (props) { { key: "output", open: outputOpen, - onToggle: function (ev) { - setOutputOpen(ev.target.open); + onToggle: /** @param ev {React.ToggleEvent<HTMLDetailsElement>} */ function ( + ev, + ) { + setOutputOpen(ev.currentTarget.open); }, style: { marginTop: "4px" }, }, From 2e270ca3f26791fe6d758535802e93cfb9a4e8df Mon Sep 17 00:00:00 2001 From: David Thrane Christiansen <david@lean-fro.org> Date: Wed, 1 Jul 2026 22:09:18 +0200 Subject: [PATCH 23/26] Update lakefile.lean Co-authored-by: Mac Malone <tydeu@hatpress.net> --- lakefile.lean | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/lakefile.lean b/lakefile.lean index 6d4f319fc..7a60717f6 100644 --- a/lakefile.lean +++ b/lakefile.lean @@ -343,8 +343,7 @@ script «errata-test» (args) do for m in mods do oleanJobs := oleanJobs.push (← m.olean.fetch) infos := infos.push (m.name, m.oleanFile) - let _ ← (Job.collectArray oleanJobs).await - pure (Job.pure infos) + (Job.collectArray oleanJobs).map (sync := true) fun _ => infos -- A test module is one whose `.olean` records a test. Module-system test modules go in the bridge -- module (`import all`); non-module ones can only be imported by the non-module main. let mut moduleMods : Array Lean.Name := #[] From b0180d9cccab487e28dce1c29575aa380142765d Mon Sep 17 00:00:00 2001 From: David Thrane Christiansen <david@lean-fro.org> Date: Wed, 1 Jul 2026 22:09:41 +0200 Subject: [PATCH 24/26] Update lakefile.lean Co-authored-by: Mac Malone <tydeu@hatpress.net> --- lakefile.lean | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/lakefile.lean b/lakefile.lean index 7a60717f6..12570f7d2 100644 --- a/lakefile.lean +++ b/lakefile.lean @@ -366,9 +366,7 @@ script «errata-test» (args) do let changed ← if ← file.pathExists then pure ((← IO.FS.readFile file) != src) else pure true if changed then IO.FS.writeFile file src -- Build and run the discovered runner. - let some exe := ws.findLeanExe? `«errata-runner» - | IO.eprintln "errata-runner executable is not configured"; return 1 - let exePath ← runBuild exe.fetch + let exePath ← runBuild «errata-runner».fetch let child ← IO.Process.spawn { cmd := exePath.toString, args := runnerArgs.toArray } child.wait From 6029b673e16c84a65704f6f12ecdf90aaaf50757 Mon Sep 17 00:00:00 2001 From: David Thrane Christiansen <david@davidchristiansen.dk> Date: Thu, 2 Jul 2026 11:24:29 +0200 Subject: [PATCH 25/26] cleanups --- lakefile.lean | 48 +++++++++---------- src/errata/Errata/Widget.lean | 5 +- .../Errata/widget/widget-externals.d.ts | 4 ++ 3 files changed, 30 insertions(+), 27 deletions(-) diff --git a/lakefile.lean b/lakefile.lean index 12570f7d2..3e1b928fc 100644 --- a/lakefile.lean +++ b/lakefile.lean @@ -134,7 +134,7 @@ lean_lib VersoTests where -- Everything below is Errata's own implementation: its library, the single-test runner and widget -- support exe, its self-tests, the generated discovery runner, and the `lake test` driver. -section Errata +namespace Errata @[default_target] input_file errataUsageFile where @@ -187,15 +187,15 @@ separate `attribute [test] …`), a `#test_msgs` command, or a `#test_guard` com glob-coverage check, which reads source files before anything is built; test discovery itself reads the compiled modules. -/ -private def errataSourceHasTests (lines : List String) : Bool := +private def sourceHasTests (lines : List String) : Bool := lines.any fun line => - let t := line.trimAsciiStart.copy + let t := line.trimAsciiStart t.startsWith "@[test]" || t.startsWith "attribute [test" || t.startsWith "#test_msgs" || t.startsWith "#test_guard" /-- Reads a built module's `.olean` header: whether it participates in the module system, and whether it records any `@[test]` (including those generated by `#test_msgs` and `#test_guard`). -/ -private def errataModuleInfo (oleanFile : System.FilePath) : IO (Bool × Bool) := do +private def moduleInfo (oleanFile : System.FilePath) : IO (Bool × Bool) := do let (data, region) ← Lean.readModuleData oleanFile let hasTests := data.entries.any fun (name, entries) => name == `Errata.test && entries.size > 0 let isModule := data.isModule @@ -204,7 +204,7 @@ private def errataModuleInfo (oleanFile : System.FilePath) : IO (Bool × Bool) : /-- Generate the bridge module: `import all` the module-system test modules so their private tests are reachable, gathering them into `allTests` through `getAllTests%`. -/ -private def errataDiscoveredSource (packageName : String) (mods : Array Lean.Name) : String := +private def discoveredSource (packageName : String) (mods : Array Lean.Name) : String := let imports := "\n".intercalate ("public import Errata" :: mods.toList.map (s!"import all {·}")) let modList := " ".intercalate (mods.toList.map (·.toString)) s!"module\n\n{imports}\n\n\ @@ -212,7 +212,7 @@ private def errataDiscoveredSource (packageName : String) (mods : Array Lean.Nam /-- Generate the non-module main: import the bridge module and the non-module test modules (which a `module` cannot import), then run their combined tests. -/ -private def errataMainSource (packageName : String) (mods : Array Lean.Name) (discovered : Lean.Name) : +private def mainSource (packageName : String) (mods : Array Lean.Name) (discovered : Lean.Name) : String := let imports := "\n".intercalate ("import Errata" :: s!"import {discovered}" :: mods.toList.map (s!"import {·}")) @@ -226,7 +226,7 @@ Splits driver arguments at the `--test-options` marker into library names and ru arguments. Library names precede the marker and may not look like options; everything after the marker goes to the runner. -/ -private def errataSplitArgs (args : List String) : Except String (List String × List String) := +private def splitArgs (args : List String) : Except String (List String × List String) := let (names, rest) := match args.span (· != "--test-options") with | (names, _ :: after) => (names, after) @@ -239,21 +239,21 @@ private def errataSplitArgs (args : List String) : Except String (List String × | none => .ok (names, rest) /-- Usage information for `lake test`, shared with `Errata.usage` through one text file. -/ -private def errataUsage : String := include_str "src/errata/Errata/usage.txt" +private def usage : String := include_str "src/errata/Errata/usage.txt" /-- Every `.lean` file below a directory, recursively. -/ -private partial def errataLeanFiles (dir : System.FilePath) : IO (Array System.FilePath) := do +private partial def leanFiles (dir : System.FilePath) : IO (Array System.FilePath) := do unless ← dir.pathExists do return #[] let mut out := #[] for entry in ← dir.readDir do if ← entry.path.isDir then - out := out ++ (← errataLeanFiles entry.path) + out := out ++ (← leanFiles entry.path) else if entry.path.extension == some "lean" then out := out.push entry.path return out /-- The module name of a `.lean` file relative to a source directory, if it lies within it. -/ -private def errataModuleOfPath (srcDir path : System.FilePath) : Option Lean.Name := do +private def moduleOfPath (srcDir path : System.FilePath) : Option Lean.Name := do guard (path.extension == some "lean") let stem ← path.fileStem let parent ← path.parent @@ -267,18 +267,18 @@ the tests would be silently undiscovered. A module within a library's root that library's globs, in a file that introduces tests, is the signal. The check reads source text and is a heuristic, so it warns rather than failing the run. -/ -private def errataWarnUncoveredTestModules (ws : Lake.Workspace) : IO Unit := do +private def warnUncoveredTestModules (ws : Lake.Workspace) : IO Unit := do let mut missed : Array Lean.Name := #[] for lib in ws.root.leanLibs do if lib.name == `ErrataGenerated then continue let srcDir := lib.srcDir - for path in ← errataLeanFiles srcDir do - let some mod := errataModuleOfPath srcDir path | continue + for path in ← leanFiles srcDir do + let some mod := moduleOfPath srcDir path | continue let withinRoot := lib.roots.any (·.isPrefixOf mod) let globbed := lib.config.globs.any (·.matches mod) if withinRoot && !globbed && !missed.contains mod then let lines := (← IO.FS.readFile path).splitOn "\n" - if errataSourceHasTests lines then + if sourceHasTests lines then missed := missed.push mod unless missed.isEmpty do IO.eprintln "warning: these modules look like they define tests but their library's globs do \ @@ -288,18 +288,18 @@ private def errataWarnUncoveredTestModules (ws : Lake.Workspace) : IO Unit := do IO.eprintln s!" {mod}" @[test_driver] -script «errata-test» (args) do +script run (args) do let ws ← getWorkspace -- Answer `--help` before discovering or building anything. if args.any (fun a => a == "--help" || a == "-h") then - IO.println errataUsage + IO.println usage return 0 let (libNames, runnerArgs) ← - match errataSplitArgs args with + match splitArgs args with | .ok result => pure result | .error msg => IO.eprintln s!"error: {msg}" - IO.eprintln errataUsage + IO.eprintln usage return 1 -- Search the named libraries, or every library in the package by default. A name may be a bare -- `Library` in this package or a `package/Library` reaching into a dependency, following Lake's @@ -332,7 +332,7 @@ script «errata-test» (args) do pure chosen -- Modules that look like they define tests but escape their library's globs are likely a -- configuration slip; warn, but run the discovered suite anyway. - errataWarnUncoveredTestModules ws + warnUncoveredTestModules ws -- Build every module in the selected libraries; their compiled `.olean` headers are authoritative -- on which modules carry tests, so no test is dropped by a source-level heuristic. let modInfos ← runBuild do @@ -343,13 +343,13 @@ script «errata-test» (args) do for m in mods do oleanJobs := oleanJobs.push (← m.olean.fetch) infos := infos.push (m.name, m.oleanFile) - (Job.collectArray oleanJobs).map (sync := true) fun _ => infos + pure <| (Job.collectArray oleanJobs).map (sync := true) fun _ => infos -- A test module is one whose `.olean` records a test. Module-system test modules go in the bridge -- module (`import all`); non-module ones can only be imported by the non-module main. let mut moduleMods : Array Lean.Name := #[] let mut nonModuleMods : Array Lean.Name := #[] for (moduleName, oleanFile) in modInfos do - let (isModule, hasTests) ← errataModuleInfo oleanFile + let (isModule, hasTests) ← moduleInfo oleanFile if hasTests then if isModule then moduleMods := moduleMods.push moduleName else nonModuleMods := nonModuleMods.push moduleName @@ -360,8 +360,8 @@ script «errata-test» (args) do let selection := "\n".intercalate ((moduleMods ++ nonModuleMods).map (·.toString) |>.qsort (· < ·)).toList for (name, src) in [("selection", selection ++ "\n"), - ("ErrataDiscovered.lean", errataDiscoveredSource ws.root.prettyName moduleMods), - ("ErrataRunnerMain.lean", errataMainSource ws.root.prettyName nonModuleMods `ErrataDiscovered)] do + ("ErrataDiscovered.lean", discoveredSource ws.root.prettyName moduleMods), + ("ErrataRunnerMain.lean", mainSource ws.root.prettyName nonModuleMods `ErrataDiscovered)] do let file := dir / name let changed ← if ← file.pathExists then pure ((← IO.FS.readFile file) != src) else pure true if changed then IO.FS.writeFile file src diff --git a/src/errata/Errata/Widget.lean b/src/errata/Errata/Widget.lean index 365885c07..d53cf0106 100644 --- a/src/errata/Errata/Widget.lean +++ b/src/errata/Errata/Widget.lean @@ -21,9 +21,8 @@ open Lean namespace Errata.Widget /-- -Shown when the text cursor is on a test's source span. -It offers a Run button that runs the test in the language server, -streaming its output as it is produced. +Shown when the text cursor is on a test's source span. It offers a "run" button that runs the test +in the language server, streaming its output as it is produced. -/ @[widget_module] meta def runTestWidget : Lean.Widget.Module where diff --git a/src/errata/Errata/widget/widget-externals.d.ts b/src/errata/Errata/widget/widget-externals.d.ts index cb9faad77..6fe08ffdf 100644 --- a/src/errata/Errata/widget/widget-externals.d.ts +++ b/src/errata/Errata/widget/widget-externals.d.ts @@ -7,6 +7,10 @@ declare module "react" { export function useState(initial: any): [any, (value: any) => void]; export function useEffect(effect: () => void | (() => void), deps?: any[]): void; export function useRef(initial: any): { current: any }; + export interface ToggleEvent<T = Element> { + currentTarget: T; + target: EventTarget; + } } declare module "@leanprover/infoview" { From 72cde91957c8d6f1b94c2d6b0af3d77586ea369a Mon Sep 17 00:00:00 2001 From: David Thrane Christiansen <david@davidchristiansen.dk> Date: Fri, 14 Aug 2026 10:22:00 +0200 Subject: [PATCH 26/26] Complete the merge: port tests added on main to Errata and adapt to v4.34 New tests from main become Errata tests: Serve, Tags, HoverMerge, DocVisibility, DocstringMissing(Legacy), ExpanderSignatures(Legacy), VersoManual.Docstring, VersoManual.Sections, VersoBlog.LiterateLeanPage, the escape-doc and twoside-doc TeX goldens, and NestedTacticHtml's duplicate-elision checks. Ported from main: deterministic golden-tree ordering and lualatex log reporting. Adapted to v4.34: the `assert` do-element now maps to Errata.assert, and #test_guard disambiguates the private names that `module` files generate. --- src/errata/Errata/Assertions.lean | 13 ++- src/errata/Errata/CompileTime.lean | 4 +- src/errata/Errata/Golden.lean | 4 +- src/tests/VersoTests/DocVisibility.lean | 7 +- src/tests/VersoTests/DocVisibility/Doc.lean | 4 +- src/tests/VersoTests/DocstringMissing.lean | 3 +- .../VersoTests/DocstringMissingLegacy.lean | 5 +- src/tests/VersoTests/ExpanderSignatures.lean | 7 +- .../VersoTests/ExpanderSignaturesLegacy.lean | 5 +- src/tests/VersoTests/HoverMerge.lean | 45 +++++----- src/tests/VersoTests/NestedTacticHtml.lean | 43 ++++++++++ src/tests/VersoTests/Serve.lean | 84 +++++++------------ src/tests/VersoTests/Tags.lean | 9 +- src/tests/VersoTests/TeXGolden.lean | 21 ++++- .../VersoBlog/LiterateLeanPage.lean | 3 +- src/tests/VersoTests/VersoManual.lean | 2 + .../VersoTests/VersoManual/Docstring.lean | 13 +-- .../VersoTests/VersoManual/Sections.lean | 24 +++--- 18 files changed, 179 insertions(+), 117 deletions(-) diff --git a/src/errata/Errata/Assertions.lean b/src/errata/Errata/Assertions.lean index 8663016d4..ce2d59eb3 100644 --- a/src/errata/Errata/Assertions.lean +++ b/src/errata/Errata/Assertions.lean @@ -15,11 +15,22 @@ set_option doc.verso true namespace Errata -/-- Asserts that a condition holds. -/ +/-- +Asserts that a condition holds. In a {lit}`do` block, {lit}`assert cond` and +{lit}`assert cond msg` invoke this assertion. +-/ def assert (cond : Bool) (message : String := "assertion failed") (loc : Location := by exact here%) : TestM Unit := unless cond do failAt loc message +-- The `assert` statement of `do` blocks parses its whole argument list as one term, so an +-- application there is the condition followed by the message. +macro_rules + | `(doElem| assert $p:term) => + match p with + | `($cond $message) => `(doElem| Errata.assert $cond $message) + | cond => `(doElem| Errata.assert $cond) + /-- Asserts that the actual value equals the expected value, reporting both when they differ. -/ def assertEq {α} [BEq α] [Repr α] (expected actual : α) (loc : Location := by exact here%) : TestM Unit := diff --git a/src/errata/Errata/CompileTime.lean b/src/errata/Errata/CompileTime.lean index 6849535a0..06c349f74 100644 --- a/src/errata/Errata/CompileTime.lean +++ b/src/errata/Errata/CompileTime.lean @@ -127,7 +127,9 @@ meta def elabTestGuard : Command.CommandElab let env ← getEnv let mut name := base let mut n := 1 - while env.contains (ns ++ Name.mkSimple name) do + -- In a `module`, the generated definition is private, so probe its mangled name as well. + while env.contains (ns ++ Name.mkSimple name) + || env.contains (mkPrivateName env (ns ++ Name.mkSimple name)) do n := n + 1 name := s!"{base} ({n})" let verdict ← diff --git a/src/errata/Errata/Golden.lean b/src/errata/Errata/Golden.lean index 2b16916e1..5aba57d0e 100644 --- a/src/errata/Errata/Golden.lean +++ b/src/errata/Errata/Golden.lean @@ -38,7 +38,7 @@ def goldenFile (expected : System.FilePath) (actual : String) failAt loc s!"missing golden file {expected}" (detail? := some "Run with --update-golden to create it.") -/-- All files below a directory, recursively. -/ +/-- All files below a directory, recursively, in a deterministic order. -/ partial def filesUnder (dir : System.FilePath) : IO (Array System.FilePath) := do let mut out : Array System.FilePath := #[] for entry in ← dir.readDir do @@ -46,7 +46,7 @@ partial def filesUnder (dir : System.FilePath) : IO (Array System.FilePath) := d out := out ++ (← filesUnder entry.path) else out := out.push entry.path - return out + return out.qsort (·.toString < ·.toString) /-- The path of a file relative to a base directory. -/ private def relativeTo (base file : System.FilePath) : String := diff --git a/src/tests/VersoTests/DocVisibility.lean b/src/tests/VersoTests/DocVisibility.lean index 494118691..0b6ed7bcb 100644 --- a/src/tests/VersoTests/DocVisibility.lean +++ b/src/tests/VersoTests/DocVisibility.lean @@ -4,7 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Author: David Thrane Christiansen -/ module -public meta import Tests.DocVisibility.Doc +public import Errata +public meta import VersoTests.DocVisibility.Doc public section /-! @@ -20,5 +21,5 @@ info: Verso.Doc.Part.mk #[Verso.Doc.Block.para #[Verso.Doc.Inline.text "A paragraph.", Verso.Doc.Inline.linebreak "\n"]] #[] -/ -#guard_msgs in -#eval %doc Tests.DocVisibility.Doc +#test_msgs in +#eval %doc VersoTests.DocVisibility.Doc diff --git a/src/tests/VersoTests/DocVisibility/Doc.lean b/src/tests/VersoTests/DocVisibility/Doc.lean index c5160020c..6f45376ca 100644 --- a/src/tests/VersoTests/DocVisibility/Doc.lean +++ b/src/tests/VersoTests/DocVisibility/Doc.lean @@ -8,8 +8,8 @@ public import Verso public meta import Verso /-! -This document is deliberately not wrapped in a `public section`, so that `Tests.DocVisibility` can -check that `#doc` results in a public name. +This document is deliberately not wrapped in a `public section`, so that `VersoTests.DocVisibility` +can check that `#doc` results in a public name. -/ #doc (.none) "Title" => diff --git a/src/tests/VersoTests/DocstringMissing.lean b/src/tests/VersoTests/DocstringMissing.lean index f17777584..22947be77 100644 --- a/src/tests/VersoTests/DocstringMissing.lean +++ b/src/tests/VersoTests/DocstringMissing.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Author: David Thrane Christiansen -/ module +import Errata public import VersoManual open Lean Elab Command @@ -25,6 +26,6 @@ Hint: If `Signature.mk` is documented, add `import all VersoManual.Docstring.Bas Set option 'verso.docstring.allowMissing' to 'true' to allow missing docstrings. -/ -#guard_msgs in +#test_msgs in run_cmd do discard <| getDocString? (← getEnv) ``Verso.Genre.Manual.Signature.mk diff --git a/src/tests/VersoTests/DocstringMissingLegacy.lean b/src/tests/VersoTests/DocstringMissingLegacy.lean index 0ba6d699a..f8b9d6310 100644 --- a/src/tests/VersoTests/DocstringMissingLegacy.lean +++ b/src/tests/VersoTests/DocstringMissingLegacy.lean @@ -3,6 +3,7 @@ Copyright (c) 2026 Lean FRO LLC. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Author: David Thrane Christiansen -/ +import Errata import VersoManual open Lean Elab Command @@ -13,7 +14,7 @@ set_option guard_msgs.diff true /-! The `import all` hint is specific to module documents, where a plain `import` does not load docstrings. A non-`module` document loads docstrings from a plain `import`, so the -diagnostic omits the hint. This is the non-`module` counterpart of `Tests/DocstringMissing.lean`. +diagnostic omits the hint. This is the non-`module` counterpart of `VersoTests/DocstringMissing.lean`. -/ /-- @@ -21,6 +22,6 @@ error: 'Verso.Genre.Manual.Signature.mk' is not documented. Set option 'verso.docstring.allowMissing' to 'true' to allow missing docstrings. -/ -#guard_msgs in +#test_msgs in run_cmd do discard <| getDocString? (← getEnv) ``Verso.Genre.Manual.Signature.mk diff --git a/src/tests/VersoTests/ExpanderSignatures.lean b/src/tests/VersoTests/ExpanderSignatures.lean index 947feaf8a..8214e5ae2 100644 --- a/src/tests/VersoTests/ExpanderSignatures.lean +++ b/src/tests/VersoTests/ExpanderSignatures.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Author: David Thrane Christiansen -/ module +public import Errata public import Verso public import VersoManual public meta import Verso @@ -23,8 +24,8 @@ expander is defined. These tests pin down that the signature is computed correct particular that defining an expander whose parser is built from `.many`/`partial` combinators does not crash when the module holding the constant is loaded. -This file defines the expanders in a `module`, so the parsers are `meta`. `Tests/ExpanderSignaturesLegacy.lean` -checks the same thing for a non-`module` source file. +This file defines the expanders in a `module`, so the parsers are `meta`. +`VersoTests/ExpanderSignaturesLegacy.lean` checks the same thing for a non-`module` source file. -/ structure ManyArgs where @@ -68,7 +69,7 @@ Ident attr : String (key/value)* ``` -/ -#guard_msgs in +#test_msgs in run_cmd do let report (label : String) (s : Option SigDoc) : CommandElabM Unit := match s with diff --git a/src/tests/VersoTests/ExpanderSignaturesLegacy.lean b/src/tests/VersoTests/ExpanderSignaturesLegacy.lean index d35f77b85..bd1003dc2 100644 --- a/src/tests/VersoTests/ExpanderSignaturesLegacy.lean +++ b/src/tests/VersoTests/ExpanderSignaturesLegacy.lean @@ -3,6 +3,7 @@ Copyright (c) 2026 Lean FRO LLC. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Author: David Thrane Christiansen -/ +import Errata import Verso import VersoManual @@ -13,7 +14,7 @@ open Lean Elab Command open Verso Doc Elab ArgParse /-! -The non-`module` counterpart of `Tests/ExpanderSignatures.lean`. The expanders are defined in a +The non-`module` counterpart of `VersoTests/ExpanderSignatures.lean`. The expanders are defined in a legacy source file, so the parsers are ordinary (non-`meta`) definitions and the generated signature constants are not marked `meta`. The signatures must still be computed correctly, and loading this file must not crash on the `.many` parser's constant. @@ -60,7 +61,7 @@ Ident attr : String (key/value)* ``` -/ -#guard_msgs in +#test_msgs in run_cmd do let report (label : String) (s : Option SigDoc) : CommandElabM Unit := match s with diff --git a/src/tests/VersoTests/HoverMerge.lean b/src/tests/VersoTests/HoverMerge.lean index 43fb72a39..542871abf 100644 --- a/src/tests/VersoTests/HoverMerge.lean +++ b/src/tests/VersoTests/HoverMerge.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Author: David Thrane Christiansen -/ module +import Errata import all Verso.Code.Highlighted meta import Verso.Output.Html meta import SubVerso.Highlighting @@ -24,20 +25,20 @@ def tok : Html := .tag "span" #[("class", "token"), ("data-verso-hover", "5")] ( def tokNoHover : Html := .tag "span" #[("class", "token")] (.text true "x") -- The attribute is taken from a bare element. -#guard takeAttrs #["data-verso-hover"] tok == (#[("data-verso-hover", "5")], tokNoHover) +#test_guard takeAttrs #["data-verso-hover"] tok == (#[("data-verso-hover", "5")], tokNoHover) -- The attribute is found through a wrapping element, such as a link. -#guard takeAttrs #["data-verso-hover"] (.tag "a" #[("href", "x.html")] tok) == +#test_guard takeAttrs #["data-verso-hover"] (.tag "a" #[("href", "x.html")] tok) == (#[("data-verso-hover", "5")], .tag "a" #[("href", "x.html")] tokNoHover) -- Attributes are gathered across the wrappers of a sole element: the hover from the token -- and the extra links from the link element around it. -#guard takeAttrs #["data-verso-hover", "data-verso-links"] +#test_guard takeAttrs #["data-verso-hover", "data-verso-links"] (.tag "a" #[("data-verso-links", "[]")] tok) == (#[("data-verso-links", "[]"), ("data-verso-hover", "5")], .tag "a" #[] tokNoHover) -- Only the attributes that are present appear in the result. -#guard takeAttrs #["data-verso-hover", "data-verso-links"] +#test_guard takeAttrs #["data-verso-hover", "data-verso-links"] (.tag "a" #[("data-verso-links", "[]")] tokNoHover) == (#[("data-verso-links", "[]")], .tag "a" #[] tokNoHover) @@ -47,54 +48,54 @@ def tokLinked : Html := -- Each attribute is taken from the outermost element that carries it, and repeats on -- elements nested inside stay in place. -#guard takeAttrs #["data-verso-hover", "data-verso-links"] +#test_guard takeAttrs #["data-verso-hover", "data-verso-links"] (.tag "a" #[("data-verso-hover", "9")] tokLinked) == (#[("data-verso-hover", "9"), ("data-verso-links", "[2]")], .tag "a" #[] (.tag "span" #[("class", "token"), ("data-verso-hover", "5")] (.text true "x"))) -#guard takeAttrs #["data-verso-hover", "data-verso-links"] +#test_guard takeAttrs #["data-verso-hover", "data-verso-links"] (.tag "a" #[("data-verso-links", "[1]")] tokLinked) == (#[("data-verso-links", "[1]"), ("data-verso-hover", "5")], .tag "a" #[] (.tag "span" #[("class", "token"), ("data-verso-links", "[2]")] (.text true "x"))) -- The outermost attribute wins, and inner ones are left in place. -#guard takeAttrs #["data-verso-hover"] (.tag "a" #[("data-verso-hover", "9")] tok) == +#test_guard takeAttrs #["data-verso-hover"] (.tag "a" #[("data-verso-hover", "9")] tok) == (#[("data-verso-hover", "9")], .tag "a" #[] tok) -- Empty content around a sole element does not block the search. -#guard takeAttrs #["data-verso-hover"] (.seq #[.text true "", tok, .seq #[]]) == +#test_guard takeAttrs #["data-verso-hover"] (.seq #[.text true "", tok, .seq #[]]) == (#[("data-verso-hover", "5")], tokNoHover) -- Adjacent content blocks the search, including whitespace. -#guard takeAttrs #["data-verso-hover"] (.seq #[tok, .text true "y"]) == +#test_guard takeAttrs #["data-verso-hover"] (.seq #[tok, .text true "y"]) == (#[], .seq #[tok, .text true "y"]) -#guard takeAttrs #["data-verso-hover"] (.seq #[tok, tokNoHover]) == (#[], .seq #[tok, tokNoHover]) -#guard takeAttrs #["data-verso-hover"] (.seq #[.text true " ", tok]) == +#test_guard takeAttrs #["data-verso-hover"] (.seq #[tok, tokNoHover]) == (#[], .seq #[tok, tokNoHover]) +#test_guard takeAttrs #["data-verso-hover"] (.seq #[.text true " ", tok]) == (#[], .seq #[.text true " ", tok]) -- Adjacent content inside a wrapper blocks the search. -#guard takeAttrs #["data-verso-hover"] (.tag "a" #[] (.seq #[tok, tokNoHover])) == +#test_guard takeAttrs #["data-verso-hover"] (.tag "a" #[] (.seq #[tok, tokNoHover])) == (#[], .tag "a" #[] (.seq #[tok, tokNoHover])) -- Content without the attributes is unchanged. -#guard takeAttrs #["data-verso-hover"] tokNoHover == (#[], tokNoHover) -#guard takeAttrs #["data-verso-hover"] (.text true "x") == (#[], .text true "x") -#guard takeAttrs #["data-verso-hover"] (.seq #[]) == (#[], .seq #[]) +#test_guard takeAttrs #["data-verso-hover"] tokNoHover == (#[], tokNoHover) +#test_guard takeAttrs #["data-verso-hover"] (.text true "x") == (#[], .text true "x") +#test_guard takeAttrs #["data-verso-hover"] (.seq #[]) == (#[], .seq #[]) def hlTok : Highlighted := .token ⟨.keyword none none none, "rfl"⟩ def hlTok' : Highlighted := .token ⟨.keyword none none none, "skip"⟩ -- A sequence around a single element becomes that element, through nesting and empty text. -#guard (Highlighted.seq #[hlTok]).normalize == hlTok -#guard (Highlighted.seq #[.seq #[hlTok]]).normalize == hlTok -#guard (Highlighted.seq #[.text "", hlTok, .seq #[]]).normalize == hlTok +#test_guard (Highlighted.seq #[hlTok]).normalize == hlTok +#test_guard (Highlighted.seq #[.seq #[hlTok]]).normalize == hlTok +#test_guard (Highlighted.seq #[.text "", hlTok, .seq #[]]).normalize == hlTok -- Whitespace is content, and sequences with several elements keep their structure. -#guard (Highlighted.seq #[.text " ", hlTok]).normalize == .seq #[.text " ", hlTok] -#guard (Highlighted.seq #[hlTok, hlTok']).normalize == .seq #[hlTok, hlTok'] +#test_guard (Highlighted.seq #[.text " ", hlTok]).normalize == .seq #[.text " ", hlTok] +#test_guard (Highlighted.seq #[hlTok, hlTok']).normalize == .seq #[hlTok, hlTok'] -- Normalization reaches inside spans and proof states. -#guard (Highlighted.span #[] (.seq #[hlTok])).normalize == .span #[] hlTok -#guard (Highlighted.tactics #[] 5 10 (.seq #[.text "", hlTok])).normalize == +#test_guard (Highlighted.span #[] (.seq #[hlTok])).normalize == .span #[] hlTok +#test_guard (Highlighted.tactics #[] 5 10 (.seq #[.text "", hlTok])).normalize == .tactics #[] 5 10 hlTok end Verso.HoverMergeTest diff --git a/src/tests/VersoTests/NestedTacticHtml.lean b/src/tests/VersoTests/NestedTacticHtml.lean index 58004c771..7e140c904 100644 --- a/src/tests/VersoTests/NestedTacticHtml.lean +++ b/src/tests/VersoTests/NestedTacticHtml.lean @@ -218,3 +218,46 @@ def checkElision : CommandElabM Unit := do #test_msgs in #eval checkElision + +/-! +## Duplicated proof states + +Elaboration can record the same tactic more than once, producing nested proof states with +identical goals at identical positions. These render as adjacent duplicate toggle widgets, so +the elision pass also removes them. +-/ + +/-- Whether `hl` contains a proof state nested in one with the same goals and position. -/ +partial def hlHasDuplicate (hl : Highlighted) + (seen : List (Array (Highlighted.Goal Highlighted) × Nat × Nat) := []) : Bool := + match hl with + | .seq xs => xs.any (hlHasDuplicate · seen) + | .span _ x => hlHasDuplicate x seen + | .tactics info s e content => + seen.contains (info, s, e) || hlHasDuplicate content ((info, s, e) :: seen) + | _ => false + +/-- The number of proof state displays in `hl`. -/ +partial def tacticNodeCount : Highlighted → Nat + | .seq xs => xs.foldl (fun n x => n + tacticNodeCount x) 0 + | .span _ x => tacticNodeCount x + | .tactics _ _ _ x => 1 + tacticNodeCount x + | _ => 0 + +/-- A proof state with the same goals and position nested directly inside another. -/ +def duplicated : Highlighted := + let goal : Highlighted.Goal Highlighted := + { name := none, goalPrefix := "⊢ ", hypotheses := #[], conclusion := .text "1 + 1 = 2" } + .tactics #[goal] 5 10 (.tactics #[goal] 5 10 (.token ⟨.keyword none none none, "rfl"⟩)) + +def checkDuplicateElision : CommandElabM Unit := do + unless hlHasDuplicate duplicated do + throwError "expected the example to contain duplicated proof states" + let elided := duplicated.elideRedundantProofStates + if hlHasDuplicate elided then + throwError "`elideRedundantProofStates` left a duplicated proof state behind" + unless tacticNodeCount elided == 1 do + throwError "expected exactly one proof state to remain, but found {tacticNodeCount elided}" + +#test_msgs in +#eval checkDuplicateElision diff --git a/src/tests/VersoTests/Serve.lean b/src/tests/VersoTests/Serve.lean index 5900c29a1..3eca8d1d8 100644 --- a/src/tests/VersoTests/Serve.lean +++ b/src/tests/VersoTests/Serve.lean @@ -4,12 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Author: David Thrane Christiansen -/ +import Errata import Std.Http import Plausible import Plausible.ArbitraryFueled import VersoServe import VersoServe.Static +open Errata open Plausible open Std Async Http open VersoServe @@ -18,28 +20,23 @@ namespace Verso.Tests.Serve /-! ## Property-based checks (Plausible) -/ -open scoped Plausible.Decorations in -/-- Runs a Plausible property as an `IO` test. -/ -def testProp - (p : Prop) (cfg : Configuration := {}) - (p' : Decorations.DecorationsOf p := by mk_decorations) [Testable p'] : - IO (TestResult p') := - Testable.checkIO p' (cfg := cfg) - /-- A range result stays within bounds whenever it selects a sub-range. -/ -def propRangeBounds := testProp <| ∀ (a b size : Nat), show Bool from +@[test] +def rangeBounds : Test := property <| ∀ (a b size : Nat), show Bool from match parseRange s!"bytes={a}-{b}" size with | .range s e => s ≤ e && e < size | _ => true /-- The resolved mount's prefix is genuinely a prefix of the request, and no match is missed. -/ -def propMountPrefix := testProp <| ∀ (prefixes segs : Array String), show Bool from +@[test] +def mountPrefix : Test := property <| ∀ (prefixes segs : Array String), show Bool from match resolveMountBy id prefixes segs with | some (p, _) => (prefixSegments p).isPrefixOf segs | none => prefixes.all fun q => !(prefixSegments q).isPrefixOf segs /-- The chosen mount has the longest matching prefix of any candidate. -/ -def propMountLongest := testProp <| ∀ (prefixes segs : Array String), show Bool from +@[test] +def mountLongest : Test := property <| ∀ (prefixes segs : Array String), show Bool from match resolveMountBy id prefixes segs with | some (p, _) => prefixes.all fun q => @@ -47,19 +44,11 @@ def propMountLongest := testProp <| ∀ (prefixes segs : Array String), show Boo | none => True /-- Mount resolution does not depend on the order of the mount table. -/ -def propMountShuffle := testProp <| ∀ (prefixes segs : Array String), +@[test] +def mountShuffle : Test := property <| ∀ (prefixes segs : Array String), (resolveMountBy id prefixes segs).map (·.1) == (resolveMountBy id prefixes.reverse segs).map (·.1) -open Lean in -/-- The properties to check, paired with display names. -/ -meta def props : List (Name × (Σ p, IO (TestResult p))) := [ - (`propRangeBounds, ⟨_, propRangeBounds⟩), - (`propMountPrefix, ⟨_, propMountPrefix⟩), - (`propMountLongest, ⟨_, propMountLongest⟩), - (`propMountShuffle, ⟨_, propMountShuffle⟩), -] - /-! ## Unit checks -/ /-- The mount table from the user-guide example. -/ @@ -75,7 +64,7 @@ def resolvedPrefix (mounts : Array Mount) (path : String) : Option String := (resolveMount mounts segs).map (·.1.urlPrefix) /-- The deterministic unit checks, paired with display names. -/ -def units : List (String × Bool) := [ +private def units : List (String × Bool) := [ -- MIME ("mime html", mimeType? "HTML" == some ⟨"text", "html"⟩), ("mime css charset", contentTypeForPath "a.css" == "text/css; charset=utf-8"), @@ -225,16 +214,16 @@ def units : List (String × Bool) := [ (({} : ServeConfig).withCli { port := Port.ofNat? 9000 }).toOption |>.map (·.port.toNat) |>.isEqSome 9000), -- argument parsing accepts valid forms and rejects malformed ones - ("args long port", parseArgs ["--port", "9000"] |>.toOption.bind (·.port) |>.map (·.toNat) |>.isEqSome 9000), - ("args short port", parseArgs ["-p", "3000"] |>.toOption.bind (·.port) |>.map (·.toNat) |>.isEqSome 3000), - ("args positional dir", parseArgs ["site"] |>.toOption.bind (·.dir) |>.map (·.toString) |>.isEqSome "site"), + ("args long port", VersoServe.parseArgs ["--port", "9000"] |>.toOption.bind (·.port) |>.map (·.toNat) |>.isEqSome 9000), + ("args short port", VersoServe.parseArgs ["-p", "3000"] |>.toOption.bind (·.port) |>.map (·.toNat) |>.isEqSome 3000), + ("args positional dir", VersoServe.parseArgs ["site"] |>.toOption.bind (·.dir) |>.map (·.toString) |>.isEqSome "site"), ("args boolean flags", - parseArgs ["--quiet"] |>.toOption.map (fun a => a.quiet) |>.isEqSome true), - ("args unknown option rejected", (parseArgs ["--nope"]).toOption.isNone), - ("args missing port value rejected", (parseArgs ["--port"]).toOption.isNone), - ("args non-numeric port rejected", (parseArgs ["--port", "x"]).toOption.isNone), - ("args out-of-range port rejected", (parseArgs ["--port", "0"]).toOption.isNone), - ("args extra positional rejected", (parseArgs ["a", "b"]).toOption.isNone), + VersoServe.parseArgs ["--quiet"] |>.toOption.map (fun a => a.quiet) |>.isEqSome true), + ("args unknown option rejected", (VersoServe.parseArgs ["--nope"]).toOption.isNone), + ("args missing port value rejected", (VersoServe.parseArgs ["--port"]).toOption.isNone), + ("args non-numeric port rejected", (VersoServe.parseArgs ["--port", "x"]).toOption.isNone), + ("args out-of-range port rejected", (VersoServe.parseArgs ["--port", "0"]).toOption.isNone), + ("args extra positional rejected", (VersoServe.parseArgs ["a", "b"]).toOption.isNone), -- port scanning skips taken ports and reports the one it settled on ("port scan skips taken", (Id.run <| firstAvailable (m := Id) (fun p => if [8000, 8001].contains p.toNat then none else some p) 8000) @@ -246,6 +235,12 @@ def units : List (String × Bool) := [ (Id.run <| firstAvailable (m := Id) (fun p => if p.toNat == 65535 then none else some p) 65535).isNone), ] +/-- Every deterministic unit check in {name}`units` passes. -/ +@[test] +def unitChecks : Test := do + let failed := units.filter (!·.2) |>.map (·.1) + assert failed.isEmpty s!"failed unit checks: {", ".intercalate failed}" + /-! ## In-process integration (Mock transport) -/ /-- Sends a raw HTTP request to a handler over an in-memory connection and returns the raw response. -/ @@ -276,7 +271,7 @@ def unicodeNames : List String := ["øllebrød", "اَلْعَرَبِيَّةُ", "中文文件", "नमस्ते", "All goals proved!🎉", "𝔏𝔢𝔞𝔫"] /-- Runs the integration checks against a temporary directory tree, returning failure messages. -/ -def integrationFailures : IO (Array String) := do +private def integrationFailures : IO (Array String) := do let tmp ← IO.FS.createTempDir -- The served directory is a subdirectory, so a sibling file lets us probe traversal escapes. let root := tmp / "site" @@ -471,23 +466,8 @@ def integrationFailures : IO (Array String) := do IO.FS.removeDirAll tmp return fails -/-! ## Entry point -/ - -/-- Runs every serve test, printing each result and returning the number of failures. -/ -public def runServeTests : IO Nat := do - let mut failures := 0 - for (name, test) in props do - IO.print s!"{name}: " - let res ← test.2 - IO.println res - unless res matches .success .. do failures := failures + 1 - for (name, ok) in units do - if ok then - IO.println s!"{name}: ok" - else - IO.println s!"{name}: FAILED" - failures := failures + 1 - for name in ← integrationFailures do - IO.println s!"integration {name}: FAILED" - failures := failures + 1 - return failures +/-- Every in-process integration check against the mock transport passes. -/ +@[test] +def integration : Test := do + let fails ← integrationFailures + assert fails.isEmpty s!"failed integration checks: {", ".intercalate fails.toList}" diff --git a/src/tests/VersoTests/Tags.lean b/src/tests/VersoTests/Tags.lean index 18c19fa89..a74f872ec 100644 --- a/src/tests/VersoTests/Tags.lean +++ b/src/tests/VersoTests/Tags.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Author: David Thrane Christiansen -/ module +import Errata import VersoManual set_option doc.verso true @@ -32,7 +33,7 @@ private def htmlId (state : TraverseState) (id : InternalId) : Option String := A tag that nobody else holds is assigned exactly as written, and gives the element its HTML id. -/ /-- info: (true, some "my-tag", false) -/ -#guard_msgs in +#test_msgs in #eval show IO _ from do let ((tag, id), state, failed) ← run do let id ← freshId @@ -45,7 +46,7 @@ Assigning the same tag to the same element again is what later traversal rounds error. -/ /-- info: (true, some "my-tag", false) -/ -#guard_msgs in +#test_msgs in #eval show IO _ from do let ((tag, id), state, failed) ← run do let id ← freshId @@ -64,7 +65,7 @@ An error was encountered! --- info: (false, some "my-tag", none, true) -/ -#guard_msgs in +#test_msgs in #eval show IO _ from do let ((tag, first, second), state, failed) ← run do let first ← freshId @@ -84,7 +85,7 @@ An error was encountered! --- info: (false, some "my-tag", none, true) -/ -#guard_msgs in +#test_msgs in #eval show IO _ from do let ((tag, machine, chosen), state, failed) ← run do let machine ← freshId diff --git a/src/tests/VersoTests/TeXGolden.lean b/src/tests/VersoTests/TeXGolden.lean index d1c464b00..516842044 100644 --- a/src/tests/VersoTests/TeXGolden.lean +++ b/src/tests/VersoTests/TeXGolden.lean @@ -12,8 +12,10 @@ import VersoTests.Integration.SampleDoc import VersoTests.Integration.InheritanceDoc import VersoTests.Integration.CodeContent import VersoTests.Integration.ExtraFilesDoc +import VersoTests.Integration.Escape import VersoTests.Integration.FrontMatter import VersoTests.Integration.DiagramDoc +import VersoTests.Integration.TwoSideDoc import Errata open Verso Genre Manual @@ -26,12 +28,14 @@ Renders `doc` to TeX under `integration/<dir>/output`, checks the produced tree lists place additional assets alongside the output, matching the document's expectations. -/ def texGolden (dir : System.FilePath) (doc : Verso.Doc.VersoDoc Manual) + (twoside : Bool := false) (extraFiles extraFilesTeX : List (System.FilePath × String) := []) : Test := do let base : System.FilePath := "src/tests/integration" / dir let output := base / "output" if ← output.pathExists then IO.FS.removeDirAll output let config : Manual.Config := - { destination := output, emitTeX := true, emitHtmlMulti := .no, extraFiles, extraFilesTeX } + { destination := output, emitTeX := true, emitHtmlMulti := .no, twoside, extraFiles, + extraFilesTeX } let logger ← Verso.Logger.new emitTeX config doc.toPart |>.run extension_impls% |>.run logger goldenDir (base / "expected") output @@ -42,7 +46,12 @@ def texGolden (dir : System.FilePath) (doc : Verso.Doc.VersoDoc Manual) cmd := "lualatex" args := #["-shell-escape", "-halt-on-error", "-interaction=nonstopmode", "main.tex"] } - assertExitCode 0 out + unless out.exitCode == 0 do + -- lualatex writes its diagnostics to stdout and `main.log`, not stderr, so report all three. + let logFile := output / "tex" / "main.log" + let log ← if ← logFile.pathExists then IO.FS.readFile logFile else pure "" + fail s!"lualatex exited with code {out.exitCode}" + (detail? := some s!"stdout:\n{out.stdout}\nstderr:\n{out.stderr}\n{logFile}:\n{log}") /-- The sample document renders to its golden TeX. -/ @[test] @@ -63,10 +72,18 @@ def extraFilesDoc : Test := (extraFiles := [("src/tests/integration/extra-files-doc/test-data/shared", "shared")]) (extraFilesTeX := [("src/tests/integration/extra-files-doc/test-data/TeX-only", "TeX-only")]) +/-- A document exercising escaped `]` in item descriptions renders to its golden TeX. -/ +@[test] +def escapeDoc : Test := texGolden "escape-doc" Escape.doc + /-- A document with front matter renders to its golden TeX. -/ @[test] def frontMatterDoc : Test := texGolden "front-matter-doc" FrontMatter.doc +/-- A document rendered with two-sided layout renders to its golden TeX. -/ +@[test] +def twoSideDoc : Test := texGolden "twoside-doc" TwoSideDoc.doc (twoside := true) + /-- A document with diagrams renders to its golden TeX. -/ @[test] def diagramDoc : Test := texGolden "diagram-doc" DiagramDoc.doc diff --git a/src/tests/VersoTests/VersoBlog/LiterateLeanPage.lean b/src/tests/VersoTests/VersoBlog/LiterateLeanPage.lean index 05a851b83..34f9be2bd 100644 --- a/src/tests/VersoTests/VersoBlog/LiterateLeanPage.lean +++ b/src/tests/VersoTests/VersoBlog/LiterateLeanPage.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Author: David Thrane Christiansen -/ module +import Errata meta import all VersoBlog.LiterateLeanPage namespace Verso.Tests.VersoBlog.LiterateLeanPage @@ -16,5 +17,5 @@ open Verso.Genre.Blog.Literate.Internal -/ /-- info: some (Except.ok "foo/foo/bar/baz/f.png") -/ -#guard_msgs in +#test_msgs in #eval (url_subst "xy/" z "/static/" pic ".jpg" => "foo/" z "/" pic ".png") "xy/foo/static/bar/baz/f.jpg" diff --git a/src/tests/VersoTests/VersoManual.lean b/src/tests/VersoTests/VersoManual.lean index 1de68a725..5155b7b0b 100644 --- a/src/tests/VersoTests/VersoManual.lean +++ b/src/tests/VersoTests/VersoManual.lean @@ -3,8 +3,10 @@ Copyright (c) 2025 Lean FRO LLC. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Author: David Thrane Christiansen -/ +import VersoTests.VersoManual.Docstring import VersoTests.VersoManual.Html import VersoTests.VersoManual.Html.SoftHyphenate import VersoTests.VersoManual.License import VersoTests.VersoManual.Markdown +import VersoTests.VersoManual.Sections import VersoTests.VersoManual.WordCount diff --git a/src/tests/VersoTests/VersoManual/Docstring.lean b/src/tests/VersoTests/VersoManual/Docstring.lean index 0b24e7d8c..6c143c820 100644 --- a/src/tests/VersoTests/VersoManual/Docstring.lean +++ b/src/tests/VersoTests/VersoManual/Docstring.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Author: David Thrane Christiansen -/ module +import Errata meta import all VersoManual.Docstring namespace Verso.Tests.VersoManual.Docstring @@ -17,20 +18,20 @@ to strip when rendering a docstring's code block. -/ /-- info: 0 -/ -#guard_msgs in +#test_msgs in #eval indentColumn "" /-- info: 0 -/ -#guard_msgs in +#test_msgs in #eval indentColumn "abc" /-- info: 3 -/ -#guard_msgs in +#test_msgs in #eval indentColumn " abc" /-- info: 3 -/ -#guard_msgs in +#test_msgs in #eval indentColumn " abc\n\n def" /-- info: 2 -/ -#guard_msgs in +#test_msgs in #eval indentColumn " abc\n\n def" /-- info: 2 -/ -#guard_msgs in +#test_msgs in #eval indentColumn " abc\n\n def\n a" diff --git a/src/tests/VersoTests/VersoManual/Sections.lean b/src/tests/VersoTests/VersoManual/Sections.lean index 310474497..9c3e8d609 100644 --- a/src/tests/VersoTests/VersoManual/Sections.lean +++ b/src/tests/VersoTests/VersoManual/Sections.lean @@ -3,10 +3,12 @@ Copyright (c) 2024-2025 Lean FRO LLC. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Author: Emilio J. Gallego Arias -/ +import Errata import VersoManual namespace DocstringSectionRegression +open Errata open Verso Output Genre Manual /-- A fixture for Manual docstring subsection HTML rendering. -/ @@ -55,23 +57,19 @@ private def renderDoc : IO String := do throw <| IO.userError "Manual docstring HTML rendering logged errors" rendered.get -private def assertLabeledSection (compact label : String) : IO Unit := do +private def assertLabeledSection (compact label : String) : TestM Unit := do let id := s!"docstring-section-{label}" let group := s!"<divclass=\"docstring-section\"role=\"group\"aria-labelledby=\"{id}\">" - unless hasSubstring compact group do - throw <| IO.userError s!"{label} section should render as a named group" + assert (hasSubstring compact group) s!"{label} section should render as a named group" let labelHtml := s!"<pclass=\"docstring-section-label\"id=\"{id}\">{label}</p>" - unless hasSubstring compact labelHtml do - throw <| IO.userError s!"{label} section should use a paragraph label with the group's ID" - if hasSubstring compact s!"<h1>{label}</h1>" then - throw <| IO.userError s!"{label} section label should not render as h1" + assert (hasSubstring compact labelHtml) + s!"{label} section should use a paragraph label with the group's ID" + assert (!hasSubstring compact s!"<h1>{label}</h1>") + s!"{label} section label should not render as h1" -/-- -info: docstring section labels render as labeled groups --/ -#guard_msgs in -#eval show IO Unit from do +/-- Docstring section labels render as labeled groups. -/ +@[test] +def sectionLabels : Test := do let compact := compactHtml (← renderDoc) assertLabeledSection compact "Fields" assertLabeledSection compact "Constructors" - IO.println "docstring section labels render as labeled groups"