Test/Holes.lean

@@ -0,0 +1,101 @@
+import LSpec
+import Pantograph.Tactic
+import Pantograph.Serial
+
+namespace Pantograph.Test.Holes
+open Pantograph
+open Lean
+
+abbrev TestM := StateRefT LSpec.TestSeq (ReaderT Commands.Options M)
+
+deriving instance DecidableEq, Repr for Commands.Expression
+deriving instance DecidableEq, Repr for Commands.Variable
+deriving instance DecidableEq, Repr for Commands.Goal
+
+def add_test (test: LSpec.TestSeq): TestM Unit := do
+  set $ (← get) ++ test
+
+def start_goal (hole: String): TestM (Option GoalState) := do
+  let env ← Lean.MonadEnv.getEnv
+  let syn? := syntax_from_str env hole
+  add_test $ LSpec.check s!"Parsing {hole}" (syn?.isOk)
+  match syn? with
+  | .error error =>
+    IO.println error
+    return Option.none
+  | .ok syn =>
+    let expr? ← syntax_to_expr syn
+    add_test $ LSpec.check s!"Elaborating" expr?.isOk
+    match expr? with
+    | .error error =>
+      IO.println error
+      return Option.none
+    | .ok expr =>
+      let goal ← GoalState.create (expr := expr)
+      return Option.some goal
+
+def assert_unreachable (message: String): LSpec.TestSeq := LSpec.check message false
+
+def build_goal (nameType: List (String × String)) (target: String): Commands.Goal :=
+  {
+    target := { pp? := .some target},
+    vars := (nameType.map fun x => ({
+      name := x.fst,
+      type? := .some { pp? := .some x.snd },
+      isInaccessible? := .some false
+    })).toArray
+  }
+-- Like `build_goal` but allow certain variables to be elided.
+def build_goal_selective (nameType: List (String × Option String)) (target: String): Commands.Goal :=
+  {
+    target := { pp? := .some target},
+    vars := (nameType.map fun x => ({
+      name := x.fst,
+      type? := x.snd.map (λ type => { pp? := type }),
+      isInaccessible? := x.snd.map (λ _ => false)
+    })).toArray
+  }
+
+def construct_sigma: TestM Unit := do
+  let goal? ← start_goal "∀ (n m: Nat), n + m = m + n"
+  add_test $ LSpec.check "Start goal" goal?.isSome
+  if let .some goal := goal? then
+    return ()
+
+
+def proof_runner (env: Lean.Environment) (tests: TestM Unit): IO LSpec.TestSeq := do
+  let termElabM := tests.run LSpec.TestSeq.done |>.run {} -- with default options
+
+  let coreContext: Lean.Core.Context := {
+    currNamespace := str_to_name "Aniva",
+    openDecls := [],     -- No 'open' directives needed
+    fileName := "<Pantograph>",
+    fileMap := { source := "", positions := #[0], lines := #[1] }
+  }
+  let metaM := termElabM.run' (ctx := {
+    declName? := some "_pantograph",
+    errToSorry := false
+  })
+  let coreM := metaM.run'
+  match ← (coreM.run' coreContext { env := env }).toBaseIO with
+  | .error exception =>
+    return LSpec.test "Exception" (s!"internal exception #{← exception.toMessageData.toString}" = "")
+  | .ok (_, a) =>
+    return a
+
+def suite: IO LSpec.TestSeq := do
+  let env: Lean.Environment ← Lean.importModules
+    (imports := #["Init"].map (λ str => { module := str_to_name str, runtimeOnly := false }))
+    (opts := {})
+    (trustLevel := 1)
+  let tests := [
+    ("Σ'", construct_sigma)
+  ]
+  let tests ← tests.foldlM (fun acc tests => do
+    let (name, tests) := tests
+    let tests ← proof_runner env tests
+    return acc ++ (LSpec.group name tests)) LSpec.TestSeq.done
+
+  return LSpec.group "Holes" tests
+
+end Pantograph.Test.Holes

Test/Integration.lean

@@ -2,7 +2,7 @@
  -/
 import LSpec
 import Pantograph
-namespace Pantograph.Test
+namespace Pantograph.Test.Integration
 open Pantograph
 
 def subroutine_named_step (name cmd: String) (payload: List (String × Lean.Json))
@@ -83,11 +83,11 @@ def test_malformed_command : IO LSpec.TestSeq :=
       Commands.InteractionError))
   ]
 
-def test_integration: IO LSpec.TestSeq := do
+def suite: IO LSpec.TestSeq := do
 
   return LSpec.group "Integration" $
     (LSpec.group "Option modify" (← test_option_modify)) ++
     (LSpec.group "Malformed command" (← test_malformed_command))
 
 
-end Pantograph.Test
+end Pantograph.Test.Integration

Test/Main.lean

@@ -1,4 +1,5 @@
 import LSpec
+import Test.Holes
 import Test.Integration
 import Test.Proofs
 import Test.Serial
@@ -10,9 +11,10 @@ unsafe def main := do
   Lean.initSearchPath (← Lean.findSysroot)
 
   let suites := [
-    test_integration,
+    Holes.suite,
-    test_proofs,
+    Integration.suite,
-    test_serial
+    Proofs.suite,
+    Serial.suite
   ]
   let all ← suites.foldlM (λ acc m => do pure $ acc ++ (← m)) LSpec.TestSeq.done
   LSpec.lspecIO $ all

Test/Proofs.lean

@@ -2,7 +2,7 @@ import LSpec
 import Pantograph.Tactic
 import Pantograph.Serial
 
-namespace Pantograph.Test
+namespace Pantograph.Test.Proofs
 open Pantograph
 open Lean
 
@@ -229,7 +229,8 @@ def proof_runner (env: Lean.Environment) (tests: TestM Unit): IO LSpec.TestSeq :
   | .ok (_, a) =>
     return a
 
-def test_proofs : IO LSpec.TestSeq := do
+/-- Tests the most basic form of proofs whose goals do not relate to each other -/
+def suite: IO LSpec.TestSeq := do
   let env: Lean.Environment ← Lean.importModules
     (imports := #["Init"].map (λ str => { module := str_to_name str, runtimeOnly := false }))
     (opts := {})
@@ -248,5 +249,4 @@ def test_proofs : IO LSpec.TestSeq := do
 
   return LSpec.group "Proofs" tests
 
-end Pantograph.Test
+end Pantograph.Test.Proofs
-

Test/Serial.lean

@@ -2,7 +2,7 @@ import LSpec
 import Pantograph.Serial
 import Pantograph.Symbols
 
-namespace Pantograph.Test
+namespace Pantograph.Test.Serial
 
 open Pantograph
 open Lean
@@ -62,15 +62,15 @@ def test_sexp_of_symbol (env: Environment): IO LSpec.TestSeq := do
   | .ok a            => return a
 
 
-def test_serial: IO LSpec.TestSeq := do
+def suite: IO LSpec.TestSeq := do
   let env: Environment ← importModules
     (imports := #["Init"].map (λ str => { module := str_to_name str, runtimeOnly := false }))
     (opts := {})
     (trustLevel := 1)
 
-  return LSpec.group "Serialisation" $
+  return LSpec.group "Serialization" $
     (LSpec.group "str_to_name" test_str_to_name) ++
     (LSpec.group "Expression binder" (← test_expr_to_binder env)) ++
     (LSpec.group "Sexp from symbol" (← test_sexp_of_symbol env))
 
-end Pantograph.Test
+end Pantograph.Test.Serial