test: Dual monad testing stub

This commit is contained in:
Leni Aniva 2024-11-30 23:21:16 -08:00
parent 4bfd606e2a
commit 7c9b092200
Signed by: aniva
GPG Key ID: 4D9B1C8D10EA4C50
3 changed files with 61 additions and 1 deletions

View File

@ -130,6 +130,8 @@ def addTest [Monad m] (test: LSpec.TestSeq): TestT m Unit := do
def runTest [Monad m] (t: TestT m Unit): m LSpec.TestSeq := def runTest [Monad m] (t: TestT m Unit): m LSpec.TestSeq :=
Prod.snd <$> t.run LSpec.TestSeq.done Prod.snd <$> t.run LSpec.TestSeq.done
def runTestWithResult { α } [Monad m] (t: TestT m α): m (α × LSpec.TestSeq) :=
t.run LSpec.TestSeq.done
def runTestTermElabM (env: Environment) (t: TestT Elab.TermElabM Unit): def runTestTermElabM (env: Environment) (t: TestT Elab.TermElabM Unit):
IO LSpec.TestSeq := IO LSpec.TestSeq :=

View File

@ -1,11 +1,12 @@
import LSpec import LSpec
import Test.Delate
import Test.Environment import Test.Environment
import Test.Frontend import Test.Frontend
import Test.Integration import Test.Integration
import Test.Library import Test.Library
import Test.Metavar import Test.Metavar
import Test.Proofs import Test.Proofs
import Test.Delate import Test.Serial
import Test.Tactic import Test.Tactic
-- Test running infrastructure -- Test running infrastructure
@ -51,6 +52,7 @@ def main (args: List String) := do
("Metavar", Metavar.suite env_default), ("Metavar", Metavar.suite env_default),
("Proofs", Proofs.suite env_default), ("Proofs", Proofs.suite env_default),
("Delate", Delate.suite env_default), ("Delate", Delate.suite env_default),
("Serial", Serial.suite env_default),
("Tactic/Congruence", Tactic.Congruence.suite env_default), ("Tactic/Congruence", Tactic.Congruence.suite env_default),
("Tactic/Motivated Apply", Tactic.MotivatedApply.suite env_default), ("Tactic/Motivated Apply", Tactic.MotivatedApply.suite env_default),
("Tactic/No Confuse", Tactic.NoConfuse.suite env_default), ("Tactic/No Confuse", Tactic.NoConfuse.suite env_default),

56
Test/Serial.lean Normal file
View File

@ -0,0 +1,56 @@
import LSpec
import Test.Common
import Lean
import Pantograph.Library
open Lean
namespace Pantograph.Test.Serial
structure MultiState where
coreContext : Core.Context
coreStates : Array Core.State
abbrev TestM := StateRefT MultiState $ TestT $ EIO LSpec.TestSeq
def runCoreM { α } (id : Nat) (testCoreM: TestT CoreM α) : TestM α := do
let multiState ← get
let state ← match multiState.coreStates[id]? with
| .some state => pure state
| .none =>
let test := LSpec.test "Invalid index" (id < multiState.coreStates.size)
throw test
let coreM := runTestWithResult testCoreM
match ← (coreM.run' multiState.coreContext state).toBaseIO with
| .error _ => do
let test := LSpec.test "Exception" false
throw test
| .ok (a, tests) => do
set $ (← getThe LSpec.TestSeq) ++ tests
return a
def simple : TestM Unit := do
return
structure Test where
name : String
nInstances : Nat
routine: TestM Unit
protected def Test.run (test: Test) (env: Lean.Environment) : IO LSpec.TestSeq := do
-- Create the state
let state : MultiState := {
coreContext := ← createCoreContext #[],
coreStates := Array.range test.nInstances |>.map λ _ => { env },
}
match ← (runTest $ test.routine.run' state).toBaseIO with
| .ok e => return e
| .error e => return e
def suite (env : Lean.Environment): List (String × IO LSpec.TestSeq) :=
let tests: List Test := [
{ name := "simple", nInstances := 2, routine := simple }
]
tests.map (fun test => (test.name, test.run env))
end Pantograph.Test.Serial