08eb78a5b2
This PR sets up the new integrated test/bench suite. It then migrates all benchmarks and some related tests to the new suite. There's also some documentation and some linting. For now, a lot of the old tests are left alone so this PR doesn't become even larger than it already is. Eventually, all tests should be migrated to the new suite though so there isn't a confusing mix of two systems.
209 lines
8.1 KiB
Text
209 lines
8.1 KiB
Text
module
|
|
|
|
import Lean
|
|
import all Lean.Elab.Idbg
|
|
import Std.Internal.Async
|
|
import Std.Net.Addr
|
|
|
|
/-! ## Part 1: Expr JSON round-trip with hygienic names -/
|
|
|
|
open Lean Lean.Idbg Std.Net Std.Internal.IO.Async in
|
|
#eval show IO Unit from do
|
|
-- `_@` contains `@` which breaks the standard Name.toString/toName round-trip
|
|
let hygName := Name.mkNum (.mkStr (.mkNum (.mkStr (.mkStr .anonymous "_@") "test") 42) "_hyg") 6
|
|
|
|
-- Lambda with hygienic name
|
|
let e := Expr.lam hygName (.const ``Nat []) (.bvar 0) .default
|
|
let j := exprToJson e
|
|
let d ← IO.ofExcept (exprFromJson? j)
|
|
let Expr.lam n .. := d | throw (IO.userError "expected lam")
|
|
assert! n == hygName
|
|
|
|
-- Const with universe levels
|
|
let e2 := Expr.const ``List [.param `u]
|
|
let j2 := exprToJson e2
|
|
let d2 ← IO.ofExcept (exprFromJson? j2)
|
|
let Expr.const n2 ls2 := d2 | throw (IO.userError "expected const")
|
|
assert! n2 == ``List
|
|
assert! ls2 == [.param `u]
|
|
|
|
-- The remainder of the test currently is a bit timing- and possibly platform-dependent, better for
|
|
-- selective testing locally than in CI
|
|
#exit
|
|
|
|
/-! ## Part 2: Manual TCP server/client round-trip with hand-built expression -/
|
|
|
|
open Lean Lean.Idbg Std.Net Std.Internal.IO.Async in
|
|
#eval show IO Unit from do
|
|
let siteId := "test-e2e"
|
|
let env ← importModules #[{ module := `Init }] {} 0
|
|
|
|
-- Build: fun (x : Nat) => toString (Nat.add x 1)
|
|
let value := Expr.lam `x (.const ``Nat []) (mkApp3 (.const ``ToString.toString [.zero])
|
|
(.const ``Nat [])
|
|
(.const ``instToStringNat [])
|
|
(mkApp2 (.const ``Nat.add []) (.bvar 0) (mkNatLit 1))) .default
|
|
let type := Expr.forallE `x (.const ``Nat []) (.const ``String []) .default
|
|
|
|
let exprJson := Json.mkObj [
|
|
("type", exprToJson type),
|
|
("value", exprToJson value)
|
|
]
|
|
|
|
-- Run server in background
|
|
let serverTask ← IO.asTask (idbgServer siteId exprJson)
|
|
|
|
-- Give server time to bind
|
|
IO.sleep 100
|
|
|
|
-- Connect to deterministic port
|
|
let port := idbgPort siteId
|
|
let client ← TCP.Socket.Client.mk
|
|
let addr := SocketAddressV4.mk (.ofParts 127 0 0 1) port
|
|
let t ← (client.connect addr).toIO
|
|
t.block
|
|
|
|
-- Receive length-prefixed message (decimal length + newline + payload)
|
|
let mut hdr := ByteArray.empty
|
|
repeat
|
|
let t ← (client.recv? 1).toIO
|
|
let some chunk ← t.block | throw (IO.userError "connection closed")
|
|
if chunk[0]! == '\n'.toUInt8 then break
|
|
hdr := hdr ++ chunk
|
|
let some hdrStr := String.fromUTF8? hdr | throw (IO.userError "invalid header")
|
|
let some len := hdrStr.toNat? | throw (IO.userError "invalid length")
|
|
let mut payload := ByteArray.empty
|
|
while payload.size < len do
|
|
let t ← (client.recv? (len - payload.size).toUInt64).toIO
|
|
let some chunk ← t.block | throw (IO.userError "connection closed")
|
|
payload := payload ++ chunk
|
|
let some msg := String.fromUTF8? payload | throw (IO.userError "invalid UTF-8")
|
|
|
|
-- Parse and compile
|
|
let json ← IO.ofExcept (Json.parse msg)
|
|
let recvType ← IO.ofExcept (exprFromJson? (← IO.ofExcept (json.getObjVal? "type")))
|
|
let recvValue ← IO.ofExcept (exprFromJson? (← IO.ofExcept (json.getObjVal? "value")))
|
|
|
|
let declName := `_idbg_test
|
|
let decl := Declaration.defnDecl {
|
|
name := declName
|
|
levelParams := []
|
|
type := recvType
|
|
value := recvValue
|
|
hints := .opaque
|
|
safety := .unsafe
|
|
}
|
|
let ((), {env := env', ..}) ← (addAndCompile decl).toIO
|
|
{ fileName := "<idbg-test>", fileMap := default, options := {} }
|
|
{ env }
|
|
let result := match env'.evalConst (Nat → String) {} declName (checkMeta := false) with
|
|
| .ok f => f 41 -- 41 + 1 = 42
|
|
| .error msg => s!"evalConst failed: {msg}"
|
|
|
|
-- Send result back (length-prefixed)
|
|
let resultBytes := result.toUTF8
|
|
let resultHdr := s!"{resultBytes.size}\n".toUTF8
|
|
let t ← (client.sendAll #[resultHdr, resultBytes]).toIO
|
|
t.block
|
|
let t ← client.shutdown |>.toIO
|
|
t.block
|
|
|
|
-- Verify server received "42"
|
|
let serverResult ← IO.ofExcept (← IO.wait serverTask)
|
|
assert! serverResult == some "42"
|
|
|
|
/-! ## Part 3: Full pipeline through the real elaborator
|
|
|
|
Run `lean -DElab.inServer=true` on a file containing `idbg`, then act as the
|
|
client: receive the expression JSON, compile it, evaluate it, send result back.
|
|
This is the actual end-to-end flow that happens between the editor and a running program.
|
|
We do this TWICE to test reconnection (simulating the user editing the expression). -/
|
|
|
|
open Lean Lean.Idbg Std.Net Std.Internal.IO.Async in
|
|
#eval show IO Unit from do
|
|
let lean := (← IO.appDir) / "lean"
|
|
let env ← importModules #[{ module := `Init }] {} 0
|
|
|
|
-- Helper: run lean on a test file with idbg, act as client, compile the received expression
|
|
let doExchange := fun (env : Environment) (testCode : String) (idbgPos : Nat) => do
|
|
IO.FS.withTempFile fun _ testFile => do
|
|
IO.FS.writeFile testFile testCode
|
|
let realPath ← IO.FS.realPath testFile
|
|
let siteId := toString (hash s!"{realPath}:{idbgPos}")
|
|
let port := idbgPort siteId
|
|
|
|
let child ← IO.Process.spawn {
|
|
cmd := lean.toString
|
|
args := #["-DElab.inServer=true", testFile.toString]
|
|
stdout := .piped
|
|
stderr := .piped
|
|
}
|
|
|
|
-- Retry connecting until the server binds
|
|
let addr := SocketAddressV4.mk (.ofParts 127 0 0 1) port
|
|
let mut client ← TCP.Socket.Client.mk
|
|
let mut connected := false
|
|
for _ in List.range 200 do
|
|
match (← (do let t ← (client.connect addr).toIO; t.block : IO Unit).toBaseIO) with
|
|
| .ok () => connected := true; break
|
|
| .error _ => IO.sleep 100; client ← TCP.Socket.Client.mk
|
|
unless connected do
|
|
let stderr ← child.stderr.readToEnd
|
|
throw (IO.userError s!"Could not connect to port {port}. stderr: {stderr}")
|
|
|
|
-- Receive expression JSON (length-prefixed: decimal length + newline + payload)
|
|
let mut hdr := ByteArray.empty
|
|
repeat
|
|
let t ← (client.recv? 1).toIO
|
|
let some chunk ← t.block | throw (IO.userError "connection closed")
|
|
if chunk[0]! == '\n'.toUInt8 then break
|
|
hdr := hdr ++ chunk
|
|
let some hdrStr := String.fromUTF8? hdr | throw (IO.userError "invalid header")
|
|
let some len := hdrStr.toNat? | throw (IO.userError "invalid length")
|
|
let mut payload := ByteArray.empty
|
|
while payload.size < len do
|
|
let t ← (client.recv? (len - payload.size).toUInt64).toIO
|
|
let some chunk ← t.block | throw (IO.userError "connection closed")
|
|
payload := payload ++ chunk
|
|
let some msg := String.fromUTF8? payload | throw (IO.userError "invalid UTF-8")
|
|
|
|
let json ← IO.ofExcept (Json.parse msg)
|
|
let recvType ← IO.ofExcept (exprFromJson? (← IO.ofExcept (json.getObjVal? "type")))
|
|
let recvValue ← IO.ofExcept (exprFromJson? (← IO.ofExcept (json.getObjVal? "value")))
|
|
|
|
-- Verify no metavariables
|
|
if recvValue.hasMVar then throw (IO.userError "Expression value has metavariables!")
|
|
if recvType.hasMVar then throw (IO.userError "Expression type has metavariables!")
|
|
|
|
-- Compile (this is where "declaration has metavariables" would fail)
|
|
let declName := `_idbg_e2e_real
|
|
let decl := Declaration.defnDecl {
|
|
name := declName
|
|
levelParams := []
|
|
type := recvType
|
|
value := recvValue
|
|
hints := .opaque
|
|
safety := .unsafe
|
|
}
|
|
let _ ← (addAndCompile decl).toIO
|
|
{ fileName := "<idbg-test>", fileMap := default, options := {} }
|
|
{ env }
|
|
|
|
-- Send dummy result back (length-prefixed)
|
|
let resultBytes := "test-ok".toUTF8
|
|
let resultHdr := s!"{resultBytes.size}\n".toUTF8
|
|
let t ← (client.sendAll #[resultHdr, resultBytes]).toIO
|
|
t.block
|
|
let t ← client.shutdown |>.toIO
|
|
t.block
|
|
let _ ← child.wait
|
|
|
|
-- Exchange 1: `idbg x + s.length`
|
|
-- idbg at byte 108 in this string
|
|
let code1 := "import Lean\nset_option backward.do.legacy false\ndef main : IO Unit := do\n let x := 42\n let s := \"hello\"\n idbg x + s.length\n"
|
|
doExchange env code1 108
|
|
|
|
-- Exchange 2: `idbg x + s.length + 1` (the expression that triggered the mvar bug)
|
|
-- idbg at byte 108 in this string too
|
|
let code2 := "import Lean\nset_option backward.do.legacy false\ndef main : IO Unit := do\n let x := 42\n let s := \"hello\"\n idbg x + s.length + 1\n"
|
|
doExchange env code2 108
|