Joseph Ferano
86174531b7
The feature was built and never tested. Three things were missing. The two packages holding a ring of macros and a macro that never settles were not dependencies of the test stanza, so both non-termination refusals failed on "no package at ..." rather than on their own reason. They fire, and now the suite sees them fire. The positive half of the rule had no acceptance case at all -- only the refusal that pins the bare name. pkg-macro.flan is asserted at three opt levels and on the dev path, which is where six package macros and the program's own coexist in one file. And the dev loop was broken in exactly the way that matters most here. Session held the imported macro set but *replaced* it on every evaluation, and the one form C-c C-c sends carries no import -- so (mac/twice 4) compiled on the build and came back "unknown function" on the first reload. It unions now. test_session drives two evaluations, because one proves nothing: the first could have re-supplied the set. BUILT.md said the expander collects from the prelude and the file being compiled. It collects from imported packages too, and the refusal's old reasoning -- that this needed a second import resolver -- was wrong for a reason worth keeping written down. Cold build cost roughly doubles for a program importing a package that declares macros: a macro module is built per round and the package's rounds are its own. Warm is unchanged at ~70ms.
456 lines
24 KiB
OCaml
456 lines
24 KiB
OCaml
(* The session: the declarations a running process was built from, plus every
|
|
change accepted since (NEXT.md, the dev loop).
|
|
|
|
Two halves. First, what a session refuses — every case here is a change that
|
|
would compile, load, install, and then be wrong, because a cell is a bare
|
|
pointer and storage that already exists already has a shape. Second, that
|
|
refusing leaves the session usable, which is the failure people actually hit:
|
|
one typo must not poison every later evaluation. *)
|
|
|
|
open Flan
|
|
|
|
(* The watchdog first: a hang is the one failure mode that reports
|
|
nothing at all. See watchdog.ml. *)
|
|
let () = Watchdog.arm ~seconds:600 "test_session"
|
|
|
|
let failures = ref 0
|
|
let fail fmt = Printf.ksprintf (fun s -> incr failures; print_endline ("FAIL " ^ s)) fmt
|
|
|
|
let has hay needle =
|
|
let n = String.length needle and h = String.length hay in
|
|
let rec go i = i + n <= h && (String.sub hay i n = needle || go (i + 1)) in
|
|
go 0
|
|
|
|
(* Every rejection is asserted on its reason, not just on the failure: the
|
|
reason is the part that has to survive a refactor. *)
|
|
let checked_program file =
|
|
Check.program
|
|
(Load.program ~file (Reader.read_file file)).Load.decls
|
|
|
|
let refuses ?(file = "programs/reload.flan") name src reason =
|
|
let t, _ = Session.create ~file () in
|
|
match Session.eval t src with
|
|
| _ -> fail "%s was accepted" name
|
|
| exception Loc.Error { Loc.dmsg = msg; _ } ->
|
|
if not (has msg reason) then
|
|
fail "%s\n said: %S\n wanted it to mention: %S" name msg reason
|
|
|
|
let () =
|
|
(* A cell carries no signature, so every call site compiled before the change
|
|
still passes the old arguments through it. *)
|
|
(* [outer] is called only from C, and [spare] is read by nothing, so the
|
|
checker has no complaint about either change and the session is the only
|
|
thing that can refuse them. A change something else in the program uses is
|
|
an ordinary type error first, which is a different and louder failure. *)
|
|
refuses "a changed parameter type"
|
|
"(defn outer [x i64] i64 (bump))"
|
|
"changes signature";
|
|
refuses "a changed return type"
|
|
"(defn outer [] i32 (i32 (bump)))"
|
|
"changes signature";
|
|
refuses "a changed arity"
|
|
"(defn outer [a i64 b i64] i64 (bump))"
|
|
"changes signature";
|
|
(* The storage exists and has a shape: reusing it reads at the wrong offsets,
|
|
and replacing it discards the state the reload exists to preserve. *)
|
|
refuses "a retyped global"
|
|
"(defvar spare i32)"
|
|
"changes type";
|
|
(* Values of the type are already in the running program's memory. *)
|
|
(* A defconst the *checker* consumed is in the shape of the program — an
|
|
array length is decided before any type resolves — so no store can reach
|
|
it. One that is only read at run time is a different matter; see below. *)
|
|
refuses "a changed defconst used at compile time"
|
|
"(defconst folded i64 8)"
|
|
"used at compile time";
|
|
(* An enum member is erased to an i32 literal in the caller, so the same
|
|
applies. It is compared over declarations because Tast.program carries no
|
|
enums at all, for exactly that reason. *)
|
|
refuses "a changed enum member"
|
|
"(defenum Colour [red 0 green 2])"
|
|
"changes its members";
|
|
refuses ~file:"programs/values.flan" "a restructured struct"
|
|
"(defstruct P [x i32 y i32])"
|
|
"changes layout";
|
|
|
|
(* An ordinary redefinition, and what the session works out about it. *)
|
|
let t, _ = Session.create ~file:"programs/reload.flan" () in
|
|
let c = Session.eval t "(defn bump [] i64 (set counter (+ counter 5)) counter)" in
|
|
if not c.Session.installs then fail "a redefined function had nothing to install";
|
|
if c.Session.fns <> [ "bump" ] then
|
|
fail "redefining bump reported %s" (String.concat " " c.Session.fns);
|
|
(* The prelude is in the checked program and in no accumulated AST, so a
|
|
session that derived [known] from declarations would call rand-seed
|
|
through a registry cell nobody ever publishes. *)
|
|
if not (has c.Session.ir "@\"flan.cell.rand-seed\" = external global ptr") then
|
|
fail "the prelude was treated as new";
|
|
if has c.Session.ir "flan_dev_cell" then
|
|
fail "a name the host has went through the registry";
|
|
|
|
(* DWARF in a redefinition module, which is a property of the session and
|
|
not of the call. [Emit.redefinition] has taken a ~debug argument all
|
|
along and was tested with it; what was missing was anyone passing it, so
|
|
every body installed by C-c C-c lost its debug info in a running process.
|
|
The defect was one unpassed argument, so the test is that the argument
|
|
arrives — asserted on the emitted text, which is the only place it shows.
|
|
|
|
Both directions matter. A session that always emitted debug info would
|
|
force -O0 on every reloaded body ([Build.shared] does that, and must),
|
|
which would change the frame time of the one function being iterated on.
|
|
Off unless asked for is the behaviour, so off is asserted too. *)
|
|
let dt, _ = Session.create ~debug:true ~file:"programs/reload.flan" () in
|
|
let dc =
|
|
Session.eval dt
|
|
"(defn bump [] i64 (let [step (i64 5)] (set counter (+ counter step)) counter))"
|
|
in
|
|
if not (has dc.Session.ir "!DILocalVariable(name: \"step\"") then
|
|
fail "a debug session's redefinition carries no name for its local";
|
|
if not (has dc.Session.ir "!DISubprogram(name: \"bump\"") then
|
|
fail "a debug session's redefinition carries no subprogram";
|
|
let pt, _ = Session.create ~file:"programs/reload.flan" () in
|
|
let pc =
|
|
Session.eval pt
|
|
"(defn bump [] i64 (let [step (i64 5)] (set counter (+ counter step)) counter))"
|
|
in
|
|
if has pc.Session.ir "!DILocalVariable" then
|
|
fail "a plain session's redefinition carries debug info it was not asked for";
|
|
|
|
(* The same for an expression evaluation, which takes the other path out of
|
|
the session and so can lose the flag on its own. *)
|
|
let ec = Session.eval_expr dt "(+ counter 1)" in
|
|
if not (has ec.Session.ir "!DISubprogram") then
|
|
fail "a debug session's eval thunk carries no debug info";
|
|
|
|
(* A form that does not check must leave the session exactly as it was. This
|
|
is the one that decides whether a REPL survives a typo. *)
|
|
(match Session.eval t "(defn bump [] i64 nonsense)" with
|
|
| _ -> fail "an unresolvable name was accepted"
|
|
| exception Loc.Error _ -> ());
|
|
(match Session.eval t "(defn bump [] i64 (set counter (+ counter 6)) counter)" with
|
|
| c -> if c.Session.fns <> [ "bump" ] then fail "the session did not recover"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } -> fail "the session was poisoned by a typo: %s" m);
|
|
|
|
(* A declaration the program already has, with no body and no new storage,
|
|
is accepted and has nothing to send. Building a module for it would report
|
|
success for a change that cannot have taken effect, and would cost the
|
|
program a reload it did not need. *)
|
|
(match Session.eval t "(defvar counter i64)" with
|
|
| c -> if c.Session.installs then fail "an empty change claimed to install"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } -> fail "redeclaring a var unchanged: %s" m);
|
|
|
|
(* A constant that is only ever read at run time is just bytes in the
|
|
program's memory. A dev build emits it as a mutable global and the module
|
|
stores the new value at the frame boundary, which is how a colour table
|
|
gets tuned live. *)
|
|
(match Session.eval t "(defconst palette [2 u32] [9 9])" with
|
|
| c ->
|
|
if not c.Session.installs then
|
|
fail "a changed run-time constant had nothing to install";
|
|
if not (has c.Session.ir "store [2 x i32]") then
|
|
fail "a changed run-time constant published no new value"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } -> fail "changing a run-time constant: %s" m);
|
|
(* And in a dev build its storage is writable, where a release build keeps
|
|
it immutable and gets all the folding back. *)
|
|
let host = checked_program "programs/reload.flan" in
|
|
if not (has (Emit.program ~dev:true host) "@\"flan.palette\" = global") then
|
|
fail "a dev build left a constant immutable";
|
|
if not (has (Emit.program host) "@\"flan.palette\" = constant") then
|
|
fail "a release build made a constant mutable";
|
|
|
|
(* A new global carries its declared initial value, copied once when the
|
|
storage is allocated and never again — calloc alone would make it zero. *)
|
|
let c = Session.eval t "(defvar started i64 42) (defn read-started [] i64 started)" in
|
|
if not (has c.Session.ir "@\".init.") then
|
|
fail "a new global's initialiser was dropped";
|
|
if not c.Session.installs then fail "adding a global had nothing to install";
|
|
|
|
(* Names the process was never built with go through the registry instead of
|
|
binding to a symbol, and adding one is allowed where retyping one is not. *)
|
|
let c = Session.eval t "(defvar fresh i64) (defn use-fresh [] i64 (set fresh 3) fresh)" in
|
|
if not (List.mem "fresh" c.Session.names && List.mem "use-fresh" c.Session.fns) then
|
|
fail "adding a var and a function reported %s" (String.concat " " c.Session.names);
|
|
if not (has c.Session.ir "call ptr @flan_dev_global") then
|
|
fail "a new global did not go through the registry";
|
|
(* And once added, it is part of the session: a later form can use it. *)
|
|
(match Session.eval t "(defn use-fresh [] i64 (set fresh 4) fresh)" with
|
|
| _ -> ()
|
|
| exception Loc.Error { Loc.dmsg = m; _ } -> fail "a name added earlier was forgotten: %s" m);
|
|
|
|
(* A file with imports, re-evaluated whole — the C-c C-k case. The session
|
|
keeps the *expanded* declarations, so the package's names are replaced in
|
|
place rather than appended a second time and rejected as duplicates. *)
|
|
let t, _ = Session.create ~file:"../sand.flan" () in
|
|
let src = In_channel.with_open_bin "../sand.flan" In_channel.input_all in
|
|
(* [~origin] is the buffer's own path and both editor paths send it
|
|
(flan-dev.el's `:file (or buffer-file-name "<buffer>")`). Omitting it here
|
|
was testing a request the editor never sends. It used to matter to this
|
|
case for a second reason — sand.flan embedded brush.png, and an embedded
|
|
path resolves relative to the file the form is written in, so the default
|
|
origin of "<eval>" found nothing. sand.flan has no embed any more; the
|
|
first reason is the one that stands. *)
|
|
(match Session.eval ~origin:"../sand.flan" t src with
|
|
| c ->
|
|
if not (List.mem "game-draw" c.Session.fns) then
|
|
fail "reloading sand.flan did not include its own functions"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "reloading a file with imports failed: %s" m);
|
|
|
|
(* A macro that came in with an import is still there on the *second*
|
|
evaluation, which is the C-c C-c case and the one that can quietly break.
|
|
A package's macros are collected by [Load.program] from the import forms
|
|
it is handed, and the single form an editor sends has no import in it —
|
|
so a session that replaced its set instead of adding to it would expand
|
|
[mac/twice] on the build and answer "unknown function" on the reload.
|
|
Two evaluations, because one proves nothing: the first is the C-c C-k
|
|
that could have re-supplied the set, the second is the one that has to
|
|
work without it.
|
|
|
|
An unexpanded macro call is an unknown function and therefore an
|
|
exception, so reaching the assertions at all is what says the expansion
|
|
happened. *)
|
|
let tm, _ = Session.create ~file:"programs/pkg-macro.flan" () in
|
|
(match Session.eval ~origin:"programs/pkg-macro.flan" tm
|
|
"(defn twiced [] i32 (mac/twice 21))"
|
|
with
|
|
| c ->
|
|
if not (List.mem "twiced" c.Session.fns) then
|
|
fail "a package macro on the first evaluation reported %s"
|
|
(String.concat " " c.Session.fns)
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "a package macro on the first evaluation: %s" m);
|
|
(match Session.eval ~origin:"programs/pkg-macro.flan" tm
|
|
"(defn quaded [] i32 (mac/quad 3))"
|
|
with
|
|
| c ->
|
|
if not (List.mem "quaded" c.Session.fns) then
|
|
fail "a package macro on the second evaluation reported %s"
|
|
(String.concat " " c.Session.fns)
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "a package macro was forgotten by the second evaluation: %s" m);
|
|
(* And the rule holds in the session as it does in a build: the bare name is
|
|
not a name here either. *)
|
|
(match Session.eval ~origin:"programs/pkg-macro.flan" tm
|
|
"(defn bare [] i32 (twice 21))"
|
|
with
|
|
| _ -> fail "an unqualified package macro was accepted in a session"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
if not (has m "twice") then
|
|
fail "an unqualified package macro said %S" m);
|
|
|
|
(* A form typed into a file that is *imported as a package* has to be
|
|
qualified the way the import qualified it, or it splices as a brand-new
|
|
unrelated name: the evaluation reports success and the running program
|
|
goes on calling the one it already had. The alias is chosen by the
|
|
importer and written nowhere in the file, so the path is the only thing
|
|
that can decide it — which is why it is derived here and not sent by the
|
|
editor. *)
|
|
let t, _ = Session.create ~file:"../sand.flan" () in
|
|
(match
|
|
Session.eval ~origin:"../vendor/agent/agent.flan" t
|
|
"(defn poll [] i32 (poll-raw))"
|
|
with
|
|
| c ->
|
|
if c.Session.fns <> [ "agent/poll" ] then
|
|
fail "a form from a package file reported %s, wanted agent/poll"
|
|
(String.concat " " c.Session.fns)
|
|
| exception Loc.Error { Loc.dmsg = m; _ } -> fail "redefining agent/poll: %s" m);
|
|
(* A package that is a single file, which is what sand.flan is to the
|
|
headless driver. The file being edited *is* the package rather than a
|
|
member of a directory, so matching on the directory alone would answer
|
|
"not a package" — and the failure is the silent one above: the form
|
|
splices as a bare [step] and the running program keeps the one it had. *)
|
|
let t2, _ = Session.create ~file:"programs/sand-headless.flan" () in
|
|
(match Session.eval ~origin:"../sand.flan" t2 "(defn step [] () (do))" with
|
|
| c ->
|
|
if c.Session.fns <> [ "sand/step" ] then
|
|
fail "a form from a single-file package reported %s, wanted sand/step"
|
|
(String.concat " " c.Session.fns)
|
|
| exception Loc.Error { Loc.dmsg = m; _ } -> fail "redefining sand/step: %s" m);
|
|
|
|
(* And a file that is not a package keeps its names as written. *)
|
|
(match Session.eval ~origin:"../sand.flan" t "(defn game-draw [] () (do))" with
|
|
| c ->
|
|
if c.Session.fns <> [ "game-draw" ] then
|
|
fail "a form from the program's own file reported %s"
|
|
(String.concat " " c.Session.fns)
|
|
| exception Loc.Error { Loc.dmsg = m; _ } -> fail "redefining game-draw: %s" m);
|
|
|
|
(* An expression's thunk leaves nothing behind, and the module says so, which
|
|
is what lets the agent unload it: nothing may point into its text
|
|
afterwards. So it is called directly rather than through a cell, and it
|
|
must not take a registry slot either — there are 4096 of those and an
|
|
expression evaluated in a loop would exhaust them. A module that publishes
|
|
a body can never say this; its whole purpose is to leave a pointer. *)
|
|
let t, _ = Session.create ~file:"programs/reload.flan" () in
|
|
let e = Session.eval_expr t "(+ 1 2)" in
|
|
if not (has e.Session.ir "@flan_reload_transient") then
|
|
fail "an expression's module did not declare itself unloadable";
|
|
if not (has e.Session.ir "define void @flan_reload_call") then
|
|
fail "an expression's module carried no thunk to run";
|
|
if has e.Session.ir "flan.cellp.eval" then
|
|
fail "an expression's thunk took a registry slot";
|
|
if has e.Session.ir "call ptr @flan_dev_cell" then
|
|
fail "an expression's thunk was looked up by name";
|
|
let c = Session.eval t "(defn bump [] i64 (set counter (+ counter 1)) counter)" in
|
|
if has c.Session.ir "@flan_reload_transient" then
|
|
fail "a module that publishes a body claimed to be unloadable";
|
|
|
|
(* And a third condition, about data rather than text. A string literal lives
|
|
in the evaluating module's own image, and an expression may store one
|
|
anywhere: [(set msg "x")] on a string global would leave that global
|
|
pointing into a mapping the agent then drops — and since the next thunk can
|
|
be mapped at the same address, the result is silent garbage rather than a
|
|
fault. A module carrying any string constant keeps its mapping. *)
|
|
let str = Session.eval_expr t "(println \"tuned\")" in
|
|
if not (has str.Session.ir ".str.0") then
|
|
fail "the fixture stopped carrying a string constant, so it proves nothing";
|
|
if has str.Session.ir "@flan_reload_transient" then
|
|
fail "an expression holding a string claimed to be unloadable";
|
|
|
|
(* ── Generics in the dev loop ─────────────────────────────────────────
|
|
A generic [defn] produces no [Tast.fn] of its own — only its copies do —
|
|
so every one of these is a question the editor asks that the ordinary
|
|
name-to-body path cannot answer. *)
|
|
let gen () = fst (Session.create ~file:"programs/reload-generic.flan" ()) in
|
|
|
|
(* 1. [C-c C-c] on a generic used to report [installs=false, fns=[]]: it
|
|
installed nothing and did not say anything had gone wrong. Both copies
|
|
have to be named, and the copy of [put!] that [hold!] pulls in has to be
|
|
there too, which is transitivity. *)
|
|
(match Session.eval (gen ()) "(defn hold! [xs [$t] v $t] () {:where (copyable? $t)} (put! xs 0 v) (put! xs 0 v))" with
|
|
| c ->
|
|
if not c.Session.installs then
|
|
fail "redefining a generic installed nothing";
|
|
List.iter
|
|
(fun want ->
|
|
if not (List.mem want c.Session.fns) then
|
|
fail "redefining a generic did not install %s; it installed %s"
|
|
want (String.concat " " c.Session.fns))
|
|
[ "hold!-i32"; "hold!-f64" ];
|
|
(* And only its own copies: [put!] did not change, and its copies are
|
|
reached through their cells, so reinstalling them would be work with
|
|
no effect. *)
|
|
if List.mem "put!-i32" c.Session.fns then
|
|
fail "redefining a generic reinstalled an unchanged generic's copies"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "redefining a generic: %s" m);
|
|
|
|
(* The callee side of the same rule: redefining [put!] reinstalls the copies
|
|
of [put!], which exist only because [hold!] asked for them — the
|
|
instantiation that generated them was transitive, and finding them again
|
|
is one table lookup rather than a walk, because a whole-program check has
|
|
already regenerated all of them. *)
|
|
(match Session.eval (gen ()) "(defn put! [xs [$t] i i32 v $t] () {:where (copyable? $t)} (set (at xs i) v))" with
|
|
| c ->
|
|
List.iter
|
|
(fun want ->
|
|
if not (List.mem want c.Session.fns) then
|
|
fail "redefining a called generic did not install %s; it \
|
|
installed %s" want (String.concat " " c.Session.fns))
|
|
[ "put!-i32"; "put!-f64" ]
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "redefining a generic: %s" m);
|
|
|
|
(* 2. Staleness, and the answer is that there is none to have. The
|
|
instantiation cache lives in the [Check.env] that [Check.program_with_env]
|
|
builds *fresh* on every evaluation, so a redefined generic's copies are
|
|
regenerated from the new body and there is no cached copy of the old one
|
|
anywhere to invalidate. Pinned here because the alternative — a cache that
|
|
survived between evaluations — would make [C-c C-c] appear to succeed
|
|
while the program kept running the old body, which is the quiet version
|
|
of failure (1). *)
|
|
(let t = gen () in
|
|
let c =
|
|
Session.eval t
|
|
"(defn pick [xs [$t]] $t {:where (ordered? $t)} (let [m (at xs 0)] \
|
|
(dotimes [i (len xs)] (set m (max m (at xs i)))) m))"
|
|
in
|
|
if not (List.mem "pick-i32" c.Session.fns) then
|
|
fail "redefining a generic did not reinstall pick-i32";
|
|
(* The new body is the one that got emitted, not a cached copy of the old:
|
|
[max] lowers to a [>] where [min] lowered to a [<]. *)
|
|
if not (has c.Session.ir "icmp sgt") then
|
|
fail "the reinstalled copy carried the old body";
|
|
(* And again, to show the second evaluation is not served from a cache the
|
|
first one left behind. *)
|
|
let c2 = Session.eval t "(defn pick [xs [$t]] $t {:where (ordered? $t)} (at xs 0))" in
|
|
if not (List.mem "pick-i32" c2.Session.fns) then
|
|
fail "a second redefinition of a generic installed nothing");
|
|
|
|
(* 3. A redefinition that needs a copy the process was never built with. The
|
|
fixture never calls [pick] at f64, so [pick-f64] exists in no program
|
|
anywhere; redefining the *caller* to ask for it has to build and install
|
|
it. Nothing in the form names [pick-f64] — it is found by being an
|
|
instantiation the host lacks. *)
|
|
(match
|
|
Session.eval (gen ())
|
|
"(defn step [] () (let [ns [5 3 9 1] fs [2.5 0.5 1.5]] \
|
|
(set counter (+ counter (i64 (pick (slice ns 0 4)))) ) \
|
|
(set counter (+ counter (i64 (pick (slice fs 0 3)))))))"
|
|
with
|
|
| c ->
|
|
if not (List.mem "pick-f64" c.Session.fns) then
|
|
fail "a redefinition needing a new instantiation did not install \
|
|
pick-f64; it installed %s" (String.concat " " c.Session.fns)
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "a redefinition needing a new instantiation: %s" m);
|
|
|
|
(* 4. A signature change on a generic is refused, and the refusal is about a
|
|
name the source does not contain: the mangling carries only the type
|
|
variables, so every copy changes signature at once and under the same
|
|
name. It has to say where that name came from. *)
|
|
(* The change has to be one the *checker* accepts, which is the narrow case
|
|
and worth saying why. A generic whose arity or variable positions move is
|
|
refused at its call sites, in the checker, with the call site's own
|
|
location — a better error than this one and the reason this path is
|
|
reached less often than it looks. What reaches here is a change every
|
|
call site still accepts and every *copy* does not: widening the index
|
|
from i32 to i64 leaves [(put! xs 0 v)] checking, because the literal
|
|
adapts, and changes [put!-i32]'s signature underneath every compiled
|
|
caller. *)
|
|
(match
|
|
Session.eval (gen ())
|
|
"(defn put! [xs [$t] i i64 v $t] () {:where (copyable? $t)} \
|
|
(set (at xs (i32 i)) v))"
|
|
with
|
|
| _ -> fail "a generic's changed parameter type was accepted"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
if not (has m "changes signature") then
|
|
fail "a generic's changed parameter type: %S" m;
|
|
if not (has m "the copy of the generic put!") then
|
|
fail "the refusal did not say the name came from put!: %S" m;
|
|
if not (has m "every copy of it at once") then
|
|
fail "the refusal did not say every copy changed together: %S" m);
|
|
|
|
(* And what is *not* refused, which the notes expected to be: adding a
|
|
[where] clause changes no signature at all. What it changes is which call
|
|
sites are legal, and an illegal one is a checker refusal at the call site
|
|
long before the session is asked anything. *)
|
|
(match
|
|
Session.eval (gen ())
|
|
"(defn pick [xs [$t]] $t {:where [(ordered? $t) (copyable? $t)]} (at xs 0))"
|
|
with
|
|
| c ->
|
|
if not (List.mem "pick-i32" c.Session.fns) then
|
|
fail "adding a where predicate did not reinstall the copies"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "adding a where predicate was refused: %s" m);
|
|
|
|
(* [C-x C-e] checks against the *live* environment rather than re-checking
|
|
the program, so an expression that instantiates a generic at a type
|
|
nothing has used generates a copy that exists in no program. The module
|
|
has to carry it, or the thunk calls a symbol nothing defines. *)
|
|
(let t = gen () in
|
|
match Session.eval_expr t "(println (pick (slice [1.5 0.5] 0 2)))" with
|
|
| e ->
|
|
if not (has e.Session.ir "pick-f64") then
|
|
fail "an expression that instantiated a generic did not carry the copy"
|
|
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
|
fail "an expression that instantiates a generic: %s" m);
|
|
|
|
if !failures = 0 then print_endline "session: all tests passed"
|
|
else begin
|
|
Printf.printf "\n%d failure(s)\n" !failures;
|
|
exit 1
|
|
end
|