Compare commits
No commits in common. "d44693e548062145f530fdc7ea6c832c56528208" and "b1da7f21517a437cb07f39607450e415f6425a85" have entirely different histories.
d44693e548
...
b1da7f2151
|
@ -132,5 +132,8 @@ requires the presence of `lean-all`.
|
||||||
|
|
||||||
To run tests:
|
To run tests:
|
||||||
``` sh
|
``` sh
|
||||||
nix flake check
|
nix build .#checks.${system}.test
|
||||||
```
|
```
|
||||||
|
|
||||||
|
For example, `${system}` could be `x86_64-linux`. Using `nix develop` drops the
|
||||||
|
current session into a development shell with fixed Lean version.
|
||||||
|
|
|
@ -8,7 +8,6 @@ open Lean
|
||||||
|
|
||||||
namespace Pantograph
|
namespace Pantograph
|
||||||
|
|
||||||
-- Auxiliary functions
|
|
||||||
namespace Protocol
|
namespace Protocol
|
||||||
/-- Set internal names to "" -/
|
/-- Set internal names to "" -/
|
||||||
def Goal.devolatilize (goal: Goal): Goal :=
|
def Goal.devolatilize (goal: Goal): Goal :=
|
||||||
|
@ -38,11 +37,10 @@ def TacticResult.toString : TacticResult → String
|
||||||
| .parseError error => s!".parseError {error}"
|
| .parseError error => s!".parseError {error}"
|
||||||
| .indexError index => s!".indexError {index}"
|
| .indexError index => s!".indexError {index}"
|
||||||
|
|
||||||
namespace Test
|
|
||||||
|
|
||||||
def expectationFailure (desc: String) (error: String): LSpec.TestSeq := LSpec.test desc (LSpec.ExpectationFailure "ok _" error)
|
|
||||||
def assertUnreachable (message: String): LSpec.TestSeq := LSpec.check message false
|
def assertUnreachable (message: String): LSpec.TestSeq := LSpec.check message false
|
||||||
|
|
||||||
|
open Lean
|
||||||
|
|
||||||
def runCoreMSeq (env: Environment) (coreM: CoreM LSpec.TestSeq) (options: Array String := #[]): IO LSpec.TestSeq := do
|
def runCoreMSeq (env: Environment) (coreM: CoreM LSpec.TestSeq) (options: Array String := #[]): IO LSpec.TestSeq := do
|
||||||
let coreContext: Core.Context ← createCoreContext options
|
let coreContext: Core.Context ← createCoreContext options
|
||||||
match ← (coreM.run' coreContext { env := env }).toBaseIO with
|
match ← (coreM.run' coreContext { env := env }).toBaseIO with
|
||||||
|
@ -61,6 +59,5 @@ def defaultTermElabMContext: Lean.Elab.Term.Context := {
|
||||||
declName? := some "_pantograph".toName,
|
declName? := some "_pantograph".toName,
|
||||||
errToSorry := false
|
errToSorry := false
|
||||||
}
|
}
|
||||||
end Test
|
|
||||||
|
|
||||||
end Pantograph
|
end Pantograph
|
||||||
|
|
|
@ -94,11 +94,10 @@ def test_inspect: IO LSpec.TestSeq := do
|
||||||
) LSpec.TestSeq.done
|
) LSpec.TestSeq.done
|
||||||
runCoreMSeq env inner
|
runCoreMSeq env inner
|
||||||
|
|
||||||
def suite: List (String × IO LSpec.TestSeq) :=
|
def suite: IO LSpec.TestSeq := do
|
||||||
[
|
return LSpec.group "Environment" $
|
||||||
("Catalog", test_catalog),
|
(LSpec.group "Catalog" (← test_catalog)) ++
|
||||||
("Symbol Visibility", test_symbol_visibility),
|
(LSpec.group "Symbol visibility" (← test_symbol_visibility)) ++
|
||||||
("Inspect", test_inspect),
|
(LSpec.group "Inspect" (← test_inspect))
|
||||||
]
|
|
||||||
|
|
||||||
end Pantograph.Test.Environment
|
end Pantograph.Test.Environment
|
||||||
|
|
|
@ -112,7 +112,7 @@ def test_tactic : IO LSpec.TestSeq :=
|
||||||
Protocol.GoalTacticResult))
|
Protocol.GoalTacticResult))
|
||||||
]
|
]
|
||||||
|
|
||||||
def test_env_add_inspect : IO LSpec.TestSeq :=
|
def test_env : IO LSpec.TestSeq :=
|
||||||
let name1 := "Pantograph.mystery"
|
let name1 := "Pantograph.mystery"
|
||||||
let name2 := "Pantograph.mystery2"
|
let name2 := "Pantograph.mystery2"
|
||||||
subroutine_runner [
|
subroutine_runner [
|
||||||
|
@ -148,13 +148,13 @@ def test_env_add_inspect : IO LSpec.TestSeq :=
|
||||||
Protocol.EnvInspectResult))
|
Protocol.EnvInspectResult))
|
||||||
]
|
]
|
||||||
|
|
||||||
def suite: List (String × IO LSpec.TestSeq) :=
|
def suite: IO LSpec.TestSeq := do
|
||||||
[
|
|
||||||
("Option modify", test_option_modify),
|
return LSpec.group "Integration" $
|
||||||
("Malformed command", test_malformed_command),
|
(LSpec.group "Option modify" (← test_option_modify)) ++
|
||||||
("Tactic", test_tactic),
|
(LSpec.group "Malformed command" (← test_malformed_command)) ++
|
||||||
("env.add env.inspect", test_env_add_inspect),
|
(LSpec.group "Tactic" (← test_tactic)) ++
|
||||||
]
|
(LSpec.group "Env" (← test_env))
|
||||||
|
|
||||||
|
|
||||||
end Pantograph.Test.Integration
|
end Pantograph.Test.Integration
|
||||||
|
|
|
@ -8,7 +8,11 @@ open Pantograph
|
||||||
|
|
||||||
namespace Pantograph.Test.Library
|
namespace Pantograph.Test.Library
|
||||||
|
|
||||||
def test_expr_echo (env: Environment): IO LSpec.TestSeq := do
|
def test_expr_echo: IO LSpec.TestSeq := do
|
||||||
|
let env: Environment ← importModules
|
||||||
|
(imports := #[`Init])
|
||||||
|
(opts := {})
|
||||||
|
(trustLevel := 1)
|
||||||
let inner: CoreM LSpec.TestSeq := do
|
let inner: CoreM LSpec.TestSeq := do
|
||||||
let prop_and_proof := "⟨∀ (x: Prop), x → x, λ (x: Prop) (h: x) => h⟩"
|
let prop_and_proof := "⟨∀ (x: Prop), x → x, λ (x: Prop) (h: x) => h⟩"
|
||||||
let tests := LSpec.TestSeq.done
|
let tests := LSpec.TestSeq.done
|
||||||
|
@ -30,9 +34,9 @@ def test_expr_echo (env: Environment): IO LSpec.TestSeq := do
|
||||||
return tests
|
return tests
|
||||||
runCoreMSeq env (options := #["pp.proofs.threshold=100"]) inner
|
runCoreMSeq env (options := #["pp.proofs.threshold=100"]) inner
|
||||||
|
|
||||||
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
|
def suite: IO LSpec.TestSeq := do
|
||||||
[
|
|
||||||
("expr_echo", test_expr_echo env),
|
return LSpec.group "Library" $
|
||||||
]
|
(LSpec.group "ExprEcho" (← test_expr_echo))
|
||||||
|
|
||||||
end Pantograph.Test.Library
|
end Pantograph.Test.Library
|
||||||
|
|
|
@ -6,48 +6,18 @@ import Test.Metavar
|
||||||
import Test.Proofs
|
import Test.Proofs
|
||||||
import Test.Serial
|
import Test.Serial
|
||||||
|
|
||||||
-- Test running infrastructure
|
|
||||||
|
|
||||||
namespace Pantograph.Test
|
|
||||||
|
|
||||||
def addPrefix (pref: String) (tests: List (String × α)): List (String × α) :=
|
|
||||||
tests.map (λ (name, x) => (pref ++ "/" ++ name, x))
|
|
||||||
|
|
||||||
/-- Runs test in parallel. Filters test name if given -/
|
|
||||||
def runTestGroup (filter: Option String) (tests: List (String × IO LSpec.TestSeq)): IO LSpec.TestSeq := do
|
|
||||||
let tests: List (String × IO LSpec.TestSeq) := match filter with
|
|
||||||
| .some filter => tests.filter (λ (name, _) => filter.isPrefixOf name)
|
|
||||||
| .none => tests
|
|
||||||
let tasks: List (String × Task _) ← tests.mapM (λ (name, task) => do
|
|
||||||
return (name, ← EIO.asTask task))
|
|
||||||
let all := tasks.foldl (λ acc (name, task) =>
|
|
||||||
let v: Except IO.Error LSpec.TestSeq := Task.get task
|
|
||||||
match v with
|
|
||||||
| .ok case => acc ++ (LSpec.group name case)
|
|
||||||
| .error e => acc ++ (expectationFailure name e.toString)
|
|
||||||
) LSpec.TestSeq.done
|
|
||||||
return all
|
|
||||||
|
|
||||||
end Pantograph.Test
|
|
||||||
|
|
||||||
open Pantograph.Test
|
open Pantograph.Test
|
||||||
|
|
||||||
/-- Main entry of tests; Provide an argument to filter tests by prefix -/
|
def main := do
|
||||||
def main (args: List String) := do
|
|
||||||
let name_filter := args.head?
|
|
||||||
Lean.initSearchPath (← Lean.findSysroot)
|
Lean.initSearchPath (← Lean.findSysroot)
|
||||||
let env_default: Lean.Environment ← Lean.importModules
|
|
||||||
(imports := #[`Init])
|
|
||||||
(opts := {})
|
|
||||||
(trustLevel := 1)
|
|
||||||
|
|
||||||
let suites: List (String × List (String × IO LSpec.TestSeq)) := [
|
let suites := [
|
||||||
("Environment", Environment.suite),
|
Environment.suite,
|
||||||
("Integration", Integration.suite),
|
Integration.suite,
|
||||||
("Library", Library.suite env_default),
|
Library.suite,
|
||||||
("Metavar", Metavar.suite env_default),
|
Metavar.suite,
|
||||||
("Proofs", Proofs.suite env_default),
|
Proofs.suite,
|
||||||
("Serial", Serial.suite env_default),
|
Serial.suite,
|
||||||
]
|
]
|
||||||
let tests: List (String × IO LSpec.TestSeq) := suites.foldl (λ acc (name, suite) => acc ++ (addPrefix name suite)) []
|
let all ← suites.foldlM (λ acc m => do pure $ acc ++ (← m)) LSpec.TestSeq.done
|
||||||
LSpec.lspecIO (← runTestGroup name_filter tests)
|
LSpec.lspecIO $ all
|
||||||
|
|
|
@ -268,7 +268,11 @@ def test_partial_continuation: TestM Unit := do
|
||||||
return ()
|
return ()
|
||||||
|
|
||||||
|
|
||||||
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
|
def suite: IO LSpec.TestSeq := do
|
||||||
|
let env: Lean.Environment ← Lean.importModules
|
||||||
|
(imports := #["Init"].map (λ str => { module := str.toName, runtimeOnly := false }))
|
||||||
|
(opts := {})
|
||||||
|
(trustLevel := 1)
|
||||||
let tests := [
|
let tests := [
|
||||||
("Instantiate", test_instantiate_mvar),
|
("Instantiate", test_instantiate_mvar),
|
||||||
("2 < 5", test_m_couple),
|
("2 < 5", test_m_couple),
|
||||||
|
@ -276,6 +280,11 @@ def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
|
||||||
("Proposition Generation", test_proposition_generation),
|
("Proposition Generation", test_proposition_generation),
|
||||||
("Partial Continuation", test_partial_continuation)
|
("Partial Continuation", test_partial_continuation)
|
||||||
]
|
]
|
||||||
tests.map (fun (name, test) => (name, proofRunner env test))
|
let tests ← tests.foldlM (fun acc tests => do
|
||||||
|
let (name, tests) := tests
|
||||||
|
let tests ← proofRunner env tests
|
||||||
|
return acc ++ (LSpec.group name tests)) LSpec.TestSeq.done
|
||||||
|
|
||||||
|
return LSpec.group "Metavar" tests
|
||||||
|
|
||||||
end Pantograph.Test.Metavar
|
end Pantograph.Test.Metavar
|
||||||
|
|
|
@ -293,7 +293,12 @@ def proof_or_comm: TestM Unit := do
|
||||||
]
|
]
|
||||||
}
|
}
|
||||||
|
|
||||||
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
|
|
||||||
|
def suite: IO LSpec.TestSeq := do
|
||||||
|
let env: Lean.Environment ← Lean.importModules
|
||||||
|
(imports := #[{ module := "Init".toName, runtimeOnly := false}])
|
||||||
|
(opts := {})
|
||||||
|
(trustLevel := 1)
|
||||||
let tests := [
|
let tests := [
|
||||||
("Nat.add_comm", proof_nat_add_comm false),
|
("Nat.add_comm", proof_nat_add_comm false),
|
||||||
("Nat.add_comm manual", proof_nat_add_comm true),
|
("Nat.add_comm manual", proof_nat_add_comm true),
|
||||||
|
@ -301,6 +306,11 @@ def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
|
||||||
("arithmetic", proof_arith),
|
("arithmetic", proof_arith),
|
||||||
("Or.comm", proof_or_comm)
|
("Or.comm", proof_or_comm)
|
||||||
]
|
]
|
||||||
tests.map (fun (name, test) => (name, proofRunner env test))
|
let tests ← tests.foldlM (fun acc tests => do
|
||||||
|
let (name, tests) := tests
|
||||||
|
let tests ← proofRunner env tests
|
||||||
|
return acc ++ (LSpec.group name tests)) LSpec.TestSeq.done
|
||||||
|
|
||||||
|
return LSpec.group "Proofs" tests
|
||||||
|
|
||||||
end Pantograph.Test.Proofs
|
end Pantograph.Test.Proofs
|
||||||
|
|
|
@ -72,13 +72,17 @@ def test_instance (env: Environment): IO LSpec.TestSeq := do
|
||||||
return LSpec.TestSeq.done
|
return LSpec.TestSeq.done
|
||||||
runMetaMSeq env metaM
|
runMetaMSeq env metaM
|
||||||
|
|
||||||
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
|
def suite: IO LSpec.TestSeq := do
|
||||||
[
|
let env: Environment ← importModules
|
||||||
("name_to_ast", do pure test_name_to_ast),
|
(imports := #["Init"].map (λ str => { module := str.toName, runtimeOnly := false }))
|
||||||
("Expression binder", test_expr_to_binder env),
|
(opts := {})
|
||||||
("Sexp from symbol", test_sexp_of_symbol env),
|
(trustLevel := 1)
|
||||||
("Sexp from expr", test_sexp_of_expr env),
|
|
||||||
("Instance", test_instance env),
|
return LSpec.group "Serialization" $
|
||||||
]
|
(LSpec.group "name_to_ast" test_name_to_ast) ++
|
||||||
|
(LSpec.group "Expression binder" (← test_expr_to_binder env)) ++
|
||||||
|
(LSpec.group "Sexp from symbol" (← test_sexp_of_symbol env)) ++
|
||||||
|
(LSpec.group "Sexp from expr" (← test_sexp_of_expr env)) ++
|
||||||
|
(LSpec.group "Instance" (← test_instance env))
|
||||||
|
|
||||||
end Pantograph.Test.Serial
|
end Pantograph.Test.Serial
|
||||||
|
|
Loading…
Reference in New Issue