defvar keeps its value across re-run; the form is the contract
# Conflicts: # FIX.org # test/test_dev.ml
This commit is contained in:
commit
0b4f5e139e
52
FIX.org
52
FIX.org
@ -39,6 +39,13 @@ whether it accepts one.
|
|||||||
Globals are NOT reset between runs. That is the CL/Clojure semantics asked for:
|
Globals are NOT reset between runs. That is the CL/Clojure semantics asked for:
|
||||||
the process never died, so a second (main) sees what the first one left.
|
the process never died, so a second (main) sees what the first one left.
|
||||||
|
|
||||||
|
Held for a zeroed global from the day this merged, and did not hold for a
|
||||||
|
computed one until 2026-09-20: re-entering main re-entered the startup function
|
||||||
|
that runs the computed initialisers, so every [defvar] with a call in it was
|
||||||
|
stored back over what the last run had left. Fixed by giving each computed
|
||||||
|
initialiser a guard of its own rather than by changing what a re-run does —
|
||||||
|
see "Per-form initialisation semantics on re-run" below.
|
||||||
|
|
||||||
** 2. C-x C-e on a top-level form — QUEUED behind 1
|
** 2. C-x C-e on a top-level form — QUEUED behind 1
|
||||||
Same file as 1 (emacs/flan.el), so it waits rather than merging by hand.
|
Same file as 1 (emacs/flan.el), so it waits rather than merging by hand.
|
||||||
No design questions; the note specifies it.
|
No design questions; the note specifies it.
|
||||||
@ -806,3 +813,48 @@ script already has SURVEY_FLAGS, which hands the same extra flags to both
|
|||||||
sides, and both sides do accept -O0 — and something that walks the two prim
|
sides, and both sides do accept -O0 — and something that walks the two prim
|
||||||
match arms mechanically rather than relying on somebody reading them side by
|
match arms mechanically rather than relying on somebody reading them side by
|
||||||
side, which is how this gap survived. Neither is queued.
|
side, which is how this gap survived. Neither is queued.
|
||||||
|
|
||||||
|
* Per-form initialisation semantics on re-run, decided 2026-09-20
|
||||||
|
The defining form is the contract, and the daemon does not have a policy about
|
||||||
|
globals at all.
|
||||||
|
|
||||||
|
- [defvar] is Common Lisp's [defvar]: its initialiser runs only if the variable
|
||||||
|
is not already initialised. Its value therefore survives a re-run, which is
|
||||||
|
what the daemon has always promised in its own words — "the globals are as
|
||||||
|
the last run left them" — and what a zeroed one already got for free, since
|
||||||
|
.bss is untouched by a second entry into main.
|
||||||
|
- [defconst] is a constant and the question does not arise: it is the linker's
|
||||||
|
image on one backend and a constructor's stores on the other, and a re-run
|
||||||
|
reaches neither.
|
||||||
|
- If the language grows a [def]-style form that re-evaluates, that form
|
||||||
|
recomputes on every run. None exists today and none was invented for this;
|
||||||
|
the rule is written so that adding one is a new case and not a revision.
|
||||||
|
|
||||||
|
A re-run may therefore re-enter the startup function as freely as it re-enters
|
||||||
|
anything else. Each initialiser guards itself: [Emit.startup_plan] gives every
|
||||||
|
computed global a flag of its own — zeroed in .bss, set after the store — and
|
||||||
|
wraps the store in a test of it. Per global rather than per startup function,
|
||||||
|
because the rule belongs to the form; dev builds only, so a release build's
|
||||||
|
.ll and .s are byte for byte what they were, which was measured on both
|
||||||
|
backends rather than argued.
|
||||||
|
|
||||||
|
Verified against a live daemon on both backends with
|
||||||
|
[test/programs/dev-rerun.flan]: a computed i64 counts 41, 42, 43, 44 across
|
||||||
|
four runs where it counted 41, 41, 41, 41 before; a computed dyn map keeps the
|
||||||
|
mutations every run made to it; a zeroed [defvar] still accumulates; a
|
||||||
|
[defconst] is untouched. The block in test_dev.ml that pins it fails on the
|
||||||
|
pre-fix compiler in exactly the two computed cases and in neither of the other
|
||||||
|
two, which is the other half of the claim.
|
||||||
|
|
||||||
|
** The interaction with the park's root reset
|
||||||
|
Written when the watermark fix had not landed; both are merged now, so what
|
||||||
|
holds is this. The park's [flan_dyn_root_reset] preserves the dyn globals'
|
||||||
|
permanent roots — it cuts the stack back to [roots_base], the watermark
|
||||||
|
[flan_dyn_root_globals_end] recorded. A re-run's [flan_dyn_root_globals_begin]
|
||||||
|
empties the stack outright, the emitted main re-pushes every global's root,
|
||||||
|
and [_end] re-records the base, so push-exactly-once holds via the bracket
|
||||||
|
rather than via anything the guarded startup does. The guarded startup
|
||||||
|
skipping its stores on a re-run is safe against all of that because the
|
||||||
|
pushes take the global's slot address, never its value, and they sit before
|
||||||
|
the startup call on both backends — nothing in the bracket depends on an
|
||||||
|
initialiser having run.
|
||||||
|
|||||||
@ -2555,6 +2555,15 @@ let abort t =
|
|||||||
is a thing you ask for by hand, in one evaluation, and it cannot be had back
|
is a thing you ask for by hand, in one evaluation, and it cannot be had back
|
||||||
the other way round if this zeroed by default.
|
the other way round if this zeroed by default.
|
||||||
|
|
||||||
|
Nothing here does the keeping, and that is deliberate: a re-run re-enters
|
||||||
|
[flan_program_main] from the top, the startup function that runs the
|
||||||
|
computed initialisers included, and what each of those does the second time
|
||||||
|
is decided by the form that defined the global. A [defvar] is CL's, so its
|
||||||
|
initialiser runs only if the variable is not already initialised —
|
||||||
|
[Emit.startup_plan] emits the flag that makes that true, and FIX.org's entry
|
||||||
|
of 2026-09-20 is the rule. This op says what it sees rather than arranging
|
||||||
|
for it.
|
||||||
|
|
||||||
The state is asked twice — here, to say something useful about [Gone], and
|
The state is asked twice — here, to say something useful about [Gone], and
|
||||||
again inside [Program.rerun], which is the answer that counts. The C does
|
again inside [Program.rerun], which is the answer that counts. The C does
|
||||||
its test and its signal under one lock, so the window between them that this
|
its test and its signal under one lock, so the window between them that this
|
||||||
|
|||||||
106
lib/emit.ml
106
lib/emit.ml
@ -3247,25 +3247,105 @@ let emit_global m ?(hidden = false) (g : Tast.global) =
|
|||||||
link's. *)
|
link's. *)
|
||||||
let startup_sym = fname ".init-globals"
|
let startup_sym = fname ".init-globals"
|
||||||
|
|
||||||
let emit_startup m ?(hidden = false) (globals : Tast.global list) =
|
(* The startup function runs once per *process* in a release build, because a
|
||||||
match
|
release build's [main] is entered once. The dev daemon's re-run enters it
|
||||||
|
again: [flan_merged_park] waits for [program_asked] and the loop around it
|
||||||
|
calls [flan_program_main] from the top, so every line of [main] above runs a
|
||||||
|
second time, this call included.
|
||||||
|
|
||||||
|
What that must mean is decided by the defining form, not by the daemon. A
|
||||||
|
[defvar] is Common Lisp's [defvar]: its initialiser runs only if the
|
||||||
|
variable is not already initialised, so its value survives a re-run — which
|
||||||
|
is what the daemon has always promised ("the globals are as it left them")
|
||||||
|
and what a plain zeroed [defvar] already got for free, since .bss is
|
||||||
|
untouched by a second call. A computed one used to be the exception, wiped
|
||||||
|
back to its initial value every re-run. A [defconst] is a constant and the
|
||||||
|
question does not arise for it: it is the linker's image on one backend and
|
||||||
|
a constructor's stores on the other, and neither is reached from here.
|
||||||
|
|
||||||
|
So each computed initialiser guards itself with a flag of its own. Per
|
||||||
|
global and not per startup function, because the rule belongs to the form:
|
||||||
|
a global whose initialiser is added by a later build, or a future form that
|
||||||
|
*does* recompute, decides its own case without the other globals' having to
|
||||||
|
agree.
|
||||||
|
|
||||||
|
Dev builds only. A release build has no re-run to guard against and pays
|
||||||
|
nothing — the body below is then the bare store it always was, byte for
|
||||||
|
byte. The flag is a global of its own rather than a sentinel value in the
|
||||||
|
variable, because there is no value a [defvar] cannot hold.
|
||||||
|
|
||||||
|
Writing the flag *after* the store is safe rather than merely tidy:
|
||||||
|
[Check.no_transfer_in_init] refuses a signal or a restart out of an
|
||||||
|
initialiser, so nothing leaves the guarded branch between the two. *)
|
||||||
|
let init_flag n = ".init-once." ^ n
|
||||||
|
|
||||||
|
(* The computed globals, the flags that guard them, and the body of the
|
||||||
|
startup function — built here so that the two backends cannot disagree
|
||||||
|
about any of the three. [flags] is empty in a release build. *)
|
||||||
|
let startup_plan m (globals : Tast.global list) =
|
||||||
|
let computed =
|
||||||
List.filter
|
List.filter
|
||||||
(fun (g : Tast.global) -> not (Tast.const_init g.Tast.ginit))
|
(fun (g : Tast.global) -> not (Tast.const_init g.Tast.ginit))
|
||||||
globals
|
globals
|
||||||
with
|
in
|
||||||
| [] -> false
|
let flags =
|
||||||
| computed ->
|
if not m.dev then []
|
||||||
(* One store per global and nothing else: the initialiser itself was lifted
|
else
|
||||||
into a function of its own, so this frame holds no slots and the [let] a
|
|
||||||
programmer wrote inside an initialiser has a frame of its own to live
|
|
||||||
in. *)
|
|
||||||
let body =
|
|
||||||
List.map
|
List.map
|
||||||
(fun (g : Tast.global) ->
|
(fun (g : Tast.global) ->
|
||||||
{ Tast.e = Tast.Set (Tast.Pglobal g.Tast.gname, g.Tast.ginit);
|
{ Tast.gname = init_flag g.Tast.gname; gty = Types.Bool;
|
||||||
ty = Types.Unit; loc = g.Tast.ginit.Tast.loc })
|
ginit =
|
||||||
|
{ Tast.e = Tast.Bool false; ty = Types.Bool;
|
||||||
|
loc = g.Tast.ginit.Tast.loc };
|
||||||
|
gconst = false; gfolded = false })
|
||||||
computed
|
computed
|
||||||
in
|
in
|
||||||
|
(* Registered so that [place] and the x86 backend's [lower] can find a
|
||||||
|
flag's type the same way they find any other global's. Not added to the
|
||||||
|
program's own [globals] list: nothing the programmer wrote names one, and
|
||||||
|
the daemon's [globals] op answers from the program. *)
|
||||||
|
List.iter
|
||||||
|
(fun (g : Tast.global) -> Hashtbl.replace m.globals g.Tast.gname g.Tast.gty)
|
||||||
|
flags;
|
||||||
|
let body =
|
||||||
|
List.map2
|
||||||
|
(fun (g : Tast.global) (flag : Tast.global option) ->
|
||||||
|
let loc = g.Tast.ginit.Tast.loc in
|
||||||
|
let store =
|
||||||
|
{ Tast.e = Tast.Set (Tast.Pglobal g.Tast.gname, g.Tast.ginit);
|
||||||
|
ty = Types.Unit; loc }
|
||||||
|
in
|
||||||
|
match flag with
|
||||||
|
| None -> store
|
||||||
|
| Some f ->
|
||||||
|
let mark =
|
||||||
|
{ Tast.e =
|
||||||
|
Tast.Set
|
||||||
|
(Tast.Pglobal f.Tast.gname,
|
||||||
|
{ Tast.e = Tast.Bool true; ty = Types.Bool; loc });
|
||||||
|
ty = Types.Unit; loc }
|
||||||
|
in
|
||||||
|
{ Tast.e =
|
||||||
|
Tast.If
|
||||||
|
({ Tast.e = Tast.Global f.Tast.gname; ty = Types.Bool; loc },
|
||||||
|
{ Tast.e = Tast.Unit; ty = Types.Unit; loc },
|
||||||
|
{ Tast.e = Tast.Do [ store; mark ]; ty = Types.Unit; loc });
|
||||||
|
ty = Types.Unit; loc })
|
||||||
|
computed
|
||||||
|
(if flags = [] then List.map (fun _ -> None) computed
|
||||||
|
else List.map (fun f -> Some f) flags)
|
||||||
|
in
|
||||||
|
(computed, flags, body)
|
||||||
|
|
||||||
|
let emit_startup m ?(hidden = false) (globals : Tast.global list) =
|
||||||
|
match startup_plan m globals with
|
||||||
|
| [], _, _ -> false
|
||||||
|
| computed, flags, body ->
|
||||||
|
(* One guarded store per global and nothing else: the initialiser itself
|
||||||
|
was lifted into a function of its own, so this frame holds no slots and
|
||||||
|
the [let] a programmer wrote inside an initialiser has a frame of its
|
||||||
|
own to live in. *)
|
||||||
|
List.iter (emit_global m ~hidden) flags;
|
||||||
emit_fn m ~hidden
|
emit_fn m ~hidden
|
||||||
{ Tast.name = ".init-globals"; params = []; slots = [||]; snames = [||];
|
{ Tast.name = ".init-globals"; params = []; slots = [||]; snames = [||];
|
||||||
ret = Types.Unit; body; fdefers = []; fparent = None;
|
ret = Types.Unit; body; fdefers = []; fparent = None;
|
||||||
|
|||||||
35
lib/x86.ml
35
lib/x86.ml
@ -4012,7 +4012,7 @@ let emit_globals_data (md : Emit.m) (globals : Tast.global list) =
|
|||||||
Buffer.contents out
|
Buffer.contents out
|
||||||
|
|
||||||
|
|
||||||
let emit_globals_init ?(cfi = false) ?(ann = false) ~sym (md : Emit.m) ~externs ~fns
|
let emit_globals_init ?(cfi = false) ?(ann = false) ?body ~sym (md : Emit.m) ~externs ~fns
|
||||||
(globals : Tast.global list) =
|
(globals : Tast.global list) =
|
||||||
let b = create () in
|
let b = create () in
|
||||||
let f =
|
let f =
|
||||||
@ -4033,10 +4033,19 @@ let emit_globals_init ?(cfi = false) ?(ann = false) ~sym (md : Emit.m) ~externs
|
|||||||
let cell = ptmp f in
|
let cell = ptmp f in
|
||||||
f.xfer_off <- ptmp f;
|
f.xfer_off <- ptmp f;
|
||||||
f.xfer_lbl <- new_label f "gxfer";
|
f.xfer_lbl <- new_label f "gxfer";
|
||||||
List.iter
|
(* Two shapes, and the second is the computed initialisers in a dev build:
|
||||||
(fun (g : Tast.global) ->
|
[Emit.startup_plan] builds their stores as expressions so that the guard
|
||||||
scoped f (fun () -> lower f g.Tast.ginit (Lg (gsym g.Tast.gname, 0))))
|
it wraps each one in — see its own note, and [Emit.emit_startup] on the
|
||||||
globals;
|
LLVM side — is the same guard on both backends rather than two that have
|
||||||
|
to be kept in step. The constant image below is unguarded stores into
|
||||||
|
their symbols, exactly as it was. *)
|
||||||
|
(match body with
|
||||||
|
| Some es -> List.iter (fun (e : Tast.expr) -> scoped f (fun () -> lower f e sink)) es
|
||||||
|
| None ->
|
||||||
|
List.iter
|
||||||
|
(fun (g : Tast.global) ->
|
||||||
|
scoped f (fun () -> lower f g.Tast.ginit (Lg (gsym g.Tast.gname, 0))))
|
||||||
|
globals);
|
||||||
(* Nothing has established a handler or a restart by the time either of
|
(* Nothing has established a handler or a restart by the time either of
|
||||||
these runs — one of them is a constructor and the other is the first call
|
these runs — one of them is a constructor and the other is the first call
|
||||||
[main] makes — so a transfer out of an initialiser has nowhere to go and
|
[main] makes — so a transfer out of an initialiser has nowhere to go and
|
||||||
@ -4420,11 +4429,11 @@ let program ~checks ?(dev = false) ?(debug = false) ?(annotate = false)
|
|||||||
function: see the two symbols' own note. The split is total —
|
function: see the two symbols' own note. The split is total —
|
||||||
[Tast.const_init] is what [emit.ml] asks to decide which globals it can
|
[Tast.const_init] is what [emit.ml] asks to decide which globals it can
|
||||||
write into the object — so every global is written exactly once. *)
|
write into the object — so every global is written exactly once. *)
|
||||||
let constants, computed =
|
let constants =
|
||||||
List.partition
|
List.filter (fun (g : Tast.global) -> Tast.const_init g.Tast.ginit)
|
||||||
(fun (g : Tast.global) -> Tast.const_init g.Tast.ginit)
|
|
||||||
p.Tast.globals
|
p.Tast.globals
|
||||||
in
|
in
|
||||||
|
let computed, init_flags, init_body = Emit.startup_plan md p.Tast.globals in
|
||||||
let ginit, gr =
|
let ginit, gr =
|
||||||
emit_globals_init ~cfi:debug ~ann:annotate ~sym:data_sym md ~externs ~fns
|
emit_globals_init ~cfi:debug ~ann:annotate ~sym:data_sym md ~externs ~fns
|
||||||
constants
|
constants
|
||||||
@ -4434,8 +4443,8 @@ let program ~checks ?(dev = false) ?(debug = false) ?(annotate = false)
|
|||||||
let startup = computed <> [] in
|
let startup = computed <> [] in
|
||||||
if startup then begin
|
if startup then begin
|
||||||
let t, r =
|
let t, r =
|
||||||
emit_globals_init ~cfi:debug ~ann:annotate ~sym:init_sym md ~externs ~fns
|
emit_globals_init ~cfi:debug ~ann:annotate ~body:init_body ~sym:init_sym
|
||||||
computed
|
md ~externs ~fns computed
|
||||||
in
|
in
|
||||||
Buffer.add_string text t;
|
Buffer.add_string text t;
|
||||||
Buffer.add_string rodata r
|
Buffer.add_string rodata r
|
||||||
@ -4494,7 +4503,11 @@ let program ~checks ?(dev = false) ?(debug = false) ?(annotate = false)
|
|||||||
(asm_sym abi_marker) (asm_sym abi_marker) (asm_sym abi_marker)
|
(asm_sym abi_marker) (asm_sym abi_marker) (asm_sym abi_marker)
|
||||||
(asm_sym abi_marker));
|
(asm_sym abi_marker));
|
||||||
if dev then Buffer.add_string out (emit_cells p);
|
if dev then Buffer.add_string out (emit_cells p);
|
||||||
Buffer.add_string out (emit_globals_data md p.Tast.globals);
|
(* The program's globals, and then — in a dev build only — one zeroed byte
|
||||||
|
per computed initialiser, which is the flag [Emit.startup_plan] guards it
|
||||||
|
with. Zeroed is what "has not run yet" is, and .bss is what a re-run does
|
||||||
|
not touch. *)
|
||||||
|
Buffer.add_string out (emit_globals_data md (p.Tast.globals @ init_flags));
|
||||||
Buffer.add_string out "\n\t.section\t.rodata\n";
|
Buffer.add_string out "\n\t.section\t.rodata\n";
|
||||||
Buffer.add_buffer out rodata;
|
Buffer.add_buffer out rodata;
|
||||||
(* The per-type dyn descriptors, as runtime/flan_dyn.h's [flan_desc] laid out
|
(* The per-type dyn descriptors, as runtime/flan_dyn.h's [flan_desc] laid out
|
||||||
|
|||||||
49
test/programs/dev-rerun.flan
Normal file
49
test/programs/dev-rerun.flan
Normal file
@ -0,0 +1,49 @@
|
|||||||
|
;;;; What a re-run does to a global, which is decided by the form that
|
||||||
|
;;;; defined it and not by the daemon.
|
||||||
|
;;;;
|
||||||
|
;;;; A [defvar] is Common Lisp's [defvar]: its initialiser runs only if the
|
||||||
|
;;;; variable is not already initialised, so its value survives a re-run. A
|
||||||
|
;;;; plain zeroed one always did — .bss is untouched by a second entry into
|
||||||
|
;;;; main — and a computed one did not, because the startup function [main]
|
||||||
|
;;;; calls ran again from the top and stored the initial value back over
|
||||||
|
;;;; whatever the last run had left. A [defconst] is a constant and the
|
||||||
|
;;;; question does not arise.
|
||||||
|
;;;;
|
||||||
|
;;;; So each line printed below is a claim about one of those cases, and the
|
||||||
|
;;;; run number is the first of them: [runs] is computed, so before the fix it
|
||||||
|
;;;; counted 1, 1, 1.
|
||||||
|
(import agent "vendor:agent")
|
||||||
|
|
||||||
|
(defconst base i64 40)
|
||||||
|
|
||||||
|
;; Computed, and the whole reproduction: the initialiser is a call, so it is
|
||||||
|
;; lifted into the startup function rather than written into the image.
|
||||||
|
(defn start [] i64 base)
|
||||||
|
|
||||||
|
(defvar counter i64 (start))
|
||||||
|
|
||||||
|
;; Zero-valued, which needs no startup at all and must keep needing none.
|
||||||
|
(defvar zeroed i64)
|
||||||
|
|
||||||
|
;; A computed dyn global: the map is built by a function, rooted before the
|
||||||
|
;; startup function runs, and mutated by every run. Its contents have to
|
||||||
|
;; survive a re-run for the same reason [counter]'s value does, and its root
|
||||||
|
;; has to survive collection either way.
|
||||||
|
(defn table [] dyn {:runs 0})
|
||||||
|
|
||||||
|
(defvar state dyn (table))
|
||||||
|
|
||||||
|
(defn main [] i32
|
||||||
|
(agent/start "/tmp/flan-dev-rerun-fallback.sock")
|
||||||
|
(set counter (+ counter 1))
|
||||||
|
(set zeroed (+ zeroed 2))
|
||||||
|
(put state :runs (+ (get state :runs) 1))
|
||||||
|
(print "counter ") (print counter) (println "")
|
||||||
|
(print "zeroed ") (print zeroed) (println "")
|
||||||
|
(print "runs ") (print (get state :runs)) (println "")
|
||||||
|
(print "base ") (print base) (println "")
|
||||||
|
;; Long enough for a client to be served, short enough to park well inside
|
||||||
|
;; any watchdog — dev-macro.flan's clock, for its reason.
|
||||||
|
(dotimes [i 100]
|
||||||
|
(agent/wait 5))
|
||||||
|
0)
|
||||||
@ -4750,6 +4750,105 @@ let () =
|
|||||||
[ dsock; dout ])
|
[ dsock; dout ])
|
||||||
[ "llvm"; "x86" ];
|
[ "llvm"; "x86" ];
|
||||||
|
|
||||||
|
(* ── What a re-run does to a global ───────────────────────────────── *)
|
||||||
|
|
||||||
|
(* The rule is the defining form's: a [defvar] is Common Lisp's, so its
|
||||||
|
initialiser runs only if the variable is not already initialised and its
|
||||||
|
value survives a re-run. A zeroed one always did — .bss is untouched by
|
||||||
|
a second entry into [main] — and a computed one did not, because the
|
||||||
|
startup function [main] calls ran again from the top and stored the
|
||||||
|
initial value back over what the last run had left.
|
||||||
|
[Emit.startup_plan] guards each computed initialiser with a flag of its
|
||||||
|
own; this is the claim that guard exists for.
|
||||||
|
|
||||||
|
On the default backend, which is x86 and merged, because that is what
|
||||||
|
the dev loop takes unasked and the guard is emitted by the two backends
|
||||||
|
from one shared body. Three re-runs and not one: a guard that ran the
|
||||||
|
initialiser every *other* time would pass a single re-run.
|
||||||
|
|
||||||
|
[programs/dev-rerun.flan] prints one line per case per run, and the
|
||||||
|
whole assertion is the fourth run's four lines: [counter] computed and
|
||||||
|
incremented four times, [zeroed] uncomputed and incremented four times,
|
||||||
|
a computed dyn map whose contents were mutated four times, and a
|
||||||
|
[defconst] that no run can have changed. *)
|
||||||
|
let rsock = tmp "rerun.sock" and rout = tmp "rerun.out" in
|
||||||
|
(try Sys.remove rsock with Sys_error _ -> ());
|
||||||
|
let rfd =
|
||||||
|
Unix.openfile rout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600
|
||||||
|
in
|
||||||
|
let rpid =
|
||||||
|
Unix.create_process flan
|
||||||
|
[| flan; "dev"; "programs/dev-rerun.flan"; "-s"; rsock |]
|
||||||
|
Unix.stdin rfd Unix.stderr
|
||||||
|
in
|
||||||
|
Unix.close rfd;
|
||||||
|
if not (listening ~pid:rpid rsock) then begin
|
||||||
|
fail "the re-run daemon %s (%S)" !listen_why
|
||||||
|
(In_channel.with_open_bin rout In_channel.input_all);
|
||||||
|
(try Unix.kill rpid Sys.sigkill with Unix.Unix_error _ -> ())
|
||||||
|
end
|
||||||
|
else begin
|
||||||
|
let c = connect rsock in
|
||||||
|
let said r = Option.value ~default:"" (Wire.string_field r "message") in
|
||||||
|
(* [describe] is what drains the program's stdout into [output], so the
|
||||||
|
park is asked for rather than slept through and the lines are there
|
||||||
|
to read the moment it is parked. *)
|
||||||
|
let parked () =
|
||||||
|
match Wire.field (request c "(:op \"describe\")") "parked" with
|
||||||
|
| Some { Form.v = Form.Sym "t"; _ } -> true
|
||||||
|
| _ -> false
|
||||||
|
in
|
||||||
|
let printed s = contains_sub (Buffer.contents output) s in
|
||||||
|
if not (await ~ms:20000 parked) then
|
||||||
|
fail "the re-run fixture never parked (%S)"
|
||||||
|
(In_channel.with_open_bin rout In_channel.input_all);
|
||||||
|
if not (printed "counter 41") then
|
||||||
|
fail "the first run printed %S" (Buffer.contents output);
|
||||||
|
for _ = 1 to 3 do
|
||||||
|
let r = request c "(:op \"rerun\")" in
|
||||||
|
if status r <> "ok" then fail "rerun: %s" (said r);
|
||||||
|
if not (await ~ms:20000 parked) then
|
||||||
|
fail "a re-run never parked (%S)"
|
||||||
|
(In_channel.with_open_bin rout In_channel.input_all)
|
||||||
|
done;
|
||||||
|
let want =
|
||||||
|
[ (* A computed [defvar], which is the whole bug: 41 on the first run
|
||||||
|
and one more on each of the three after it. *)
|
||||||
|
"counter 44";
|
||||||
|
(* An uncomputed one, which survived before this and still does. *)
|
||||||
|
"zeroed 8";
|
||||||
|
(* A computed dyn global, mutated by every run: its value survives
|
||||||
|
and so does the mutation, which is the map still being the map the
|
||||||
|
first run built. *)
|
||||||
|
"runs 4";
|
||||||
|
(* And a [defconst], which no run can have changed. *)
|
||||||
|
"base 40" ]
|
||||||
|
in
|
||||||
|
List.iter
|
||||||
|
(fun s ->
|
||||||
|
if not (printed s) then
|
||||||
|
fail "after three re-runs the program never printed %S: %S" s
|
||||||
|
(Buffer.contents output))
|
||||||
|
want;
|
||||||
|
(* Read back rather than only printed, because the two can differ: a
|
||||||
|
printed line is what the run computed, and this is what the global
|
||||||
|
holds now. *)
|
||||||
|
let r =
|
||||||
|
request c
|
||||||
|
"(:op \"eval-expr\" :code \"counter\" :file \"programs/dev-rerun.flan\")"
|
||||||
|
in
|
||||||
|
(match Wire.string_field r "value" with
|
||||||
|
| Some "44" -> ()
|
||||||
|
| v ->
|
||||||
|
fail "counter reads back as %S after three re-runs"
|
||||||
|
(Option.value ~default:(status r) v));
|
||||||
|
ignore (request c "(:op \"close\")");
|
||||||
|
(try Unix.close c with Unix.Unix_error _ -> ());
|
||||||
|
(try ignore (Unix.waitpid [] rpid) with Unix.Unix_error _ -> ())
|
||||||
|
end;
|
||||||
|
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ())
|
||||||
|
[ rsock; rout ];
|
||||||
|
|
||||||
(* ── A daemon whose editor was killed ─────────────────────────────── *)
|
(* ── A daemon whose editor was killed ─────────────────────────────── *)
|
||||||
|
|
||||||
(* The defect FIX.org recorded and PDEATHSIG does not reach: an editor that
|
(* The defect FIX.org recorded and PDEATHSIG does not reach: an editor that
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user