flan/test/programs/init-conditions.flan
Joseph Ferano 4c667cf062 A defer the text never reached is not cleanup the unwind owes
The report was that handler-case segfaults in a top-level global
initialiser. It does not, and never did. What crashes is one frame
further down, in a position that has nothing to do with startup:

    (defn read-file [path string] dyn
      (let [src (slurp path (heap-allocator))]
        (defer (free src))
        (read (as-slice src))))

slurp signals FileError, a handler further out unwinds, and the
transfer leaves this frame through its defers -- all of them. But src
was never written: the form that would have written it is the form
that transferred. free then reads whatever the stack held under that
slot, which at -O0 in a small program is zero and at -O2 is a live
pointer, which is why the same program looked like an optimiser bug
from one direction and a startup bug from the other.

return never had this. The checker splices the defers registered above
it and no others, and says so where it does it. The transfer exit took
the whole list, because it is one landing block per function and
nothing in the IR said where each defer had come into being.

So the count is kept. The first defer in a function mints an i64 slot
zeroed at the top of the body; each defer leaves a store of its own
number where it was written; and fdefers -- the transfer path's copy,
and only that copy -- tests the count before running each one. The
normal paths are untouched and still need no test. It is all in the
checker: what reaches a backend is a slot, a store and an if, so
neither emitter learned anything and the x86 one needed no frame of
its own.

test/programs/init-conditions.flan is the survey. The top half is the
part of the report that was never true: handler-case with its
condition firing and with its body completing, handler-bind, and a
restart-case, all four in a global initialiser, all four answering
what they answer anywhere. The bottom half is the part that was: a
defer below the signalling form, which must not run, beside one above
it, which must -- a fix that took the unregistered one off by taking
them all off would have traded the crash for a leak, and 302/2 is the
line that would catch it. Three acceptance rows, LLVM, -O0 and --x86.

The detector was valgrind, not ASan: reading a stack slot nobody wrote
is not ASan's bug class and it reported nothing on the broken binary,
while memcheck named the conditional jump in flan_vec_free with the
unwinding frame directly above it. The program is in both lists --
test_valgrind.ml because that is what saw it, test_sanitize.ml because
that is where the transfer exit's frames are already watched.

spec-conditions.md section 5 now says which defers a transfer runs.
The author's (defvar game-data dyn (handler-case (edn/read-file ...)
[(FileError [c] nil)])) works.
2026-09-19 21:57:00 +07:00

141 lines
5.0 KiB
Plaintext

;;;; Conditions where the program has not started yet, and the defer that has
;;;; not registered yet.
;;;;
;;;; The report that opened this file said handler-case segfaults in a global
;;;; initialiser. It does not, and the top half here is what says so: all three
;;;; condition forms run in that position, before main, and answer the same
;;;; numbers they would answer anywhere. §5 of spec-conditions.md is not
;;;; suspended at startup, because an initialiser is a call from main and not a
;;;; constructor the loader runs.
;;;;
;;;; What did crash was underneath, and had nothing to do with startup:
;;;;
;;;; (defn read-file [path string] dyn
;;;; (let [src (slurp path (heap-allocator))]
;;;; (defer (free src))
;;;; (read (as-slice src))))
;;;;
;;;; `slurp` signals FileError and the handler further out unwinds. The
;;;; transfer leaves this frame through its defers — and `src` was never
;;;; written, because the form that would have written it is the one that
;;;; transferred. `free` then read whatever the stack held under that slot,
;;;; which at -O0 in a small program is zero and at -O2 is a pointer.
;;;;
;;;; A [return] never had this: the checker splices the defers registered
;;;; *above* it and no others, and says so. The transfer exit took the whole
;;;; list. The bottom half of this file is that distinction, pinned from both
;;;; sides — the defer below the signal must not run, the one above it must.
;;;;
;;;; [log] is a digit trace and not a running sum, for handler-case.flan's
;;;; reason: a sum commutes and would score a wrong order right.
(import edn "vendor:edn")
(defstruct Missing [id i32])
(defstruct Late [id i32])
(defvar log i64)
;;; A counter of its own, because two computed globals that both wrote [log]
;;; would be asserting the order the initialiser sort happened to pick between
;;; two that do not depend on each other — and that order is not this file's
;;; subject.
(defvar late i64)
(defn note [n i64] () (set log (+ (* log 10) n)))
(defn raise [n i32] i32
(error (Missing {.id n}))
0)
;;; A defer written *below* the form that transfers. Nothing reached it when
;;; the unwind starts, so it must not run: there is no v for it to run on, and
;;; in the shape this was found in the cleanup was a free.
(defn unreached [n i32] i32
(let [v (raise n)]
(defer (note 1))
(+ v 1)))
;;; And one written above it, which did register. It must still run — a fix
;;; that dropped this one would turn the crash into a leak, which is the same
;;; bug wearing a quieter coat.
(defn reached [n i32] i32
(defer (note 2))
(let [v (raise n)]
(+ v 1)))
;;; Both at once, so the trace says which of the two ran rather than how many.
(defn both [n i32] i32
(defer (note 2))
(let [v (raise n)]
(defer (note 1))
(+ v 1)))
;;; And the ordinary case, where nothing transfers: every defer registers and
;;; every one runs, innermost first.
(defn no-signal [n i32] i32
(defer (note 2))
(let [v (+ n 1)]
(defer (note 1))
(+ v 1)))
;;; ── The three forms, in a global initialiser ──────────────────────
;;;
;;; Each of these runs before main. A handler-case whose condition fires, one
;;; whose body completes and whose clause therefore never runs, a handler-bind
;;; that returns normally and lets signal carry on, and a restart-case with a
;;; handler-bind inside it — which is slurp's own shape and the reason the
;;; checker lets a condition form stand here at all.
(defvar fired i32
(handler-case (both 4)
[(Missing [c] (+ 100 (.id c)))]))
(defvar quiet i32
(handler-case (+ 1 40)
[(Missing [c] -1)]))
(defvar bound i32
(handler-bind [(Late [c] (set late 5))]
(do (signal (Late {.id 1}))
7)))
(defvar restarted i32
(restart-case
(handler-bind [(Missing [c] (invoke-restart 'use-zero 9))]
(raise 3))
(use-zero [k i32] k)))
;;; The author's own form, which is what sent anyone looking: a dyn global read
;;; out of a file that is not there, with the FileError answered by nil. The
;;; path is never present in a build directory, so the condition always fires.
(defvar game-data dyn
(handler-case (edn/read-file "no-such-file-here.edn")
[(FileError [c] nil)]))
(defn main [] i32
;; The initialisers ran above; this is what they left.
(println fired)
(println quiet)
(println bound)
(println restarted)
(println game-data)
(println late)
;; The 2 is `both`'s registered defer. The 1 is the one that never
;; registered, and its absence here is the whole fix.
(println log)
(set log 0)
;; The same three shapes from an ordinary function, where they always worked
;; and must go on working.
(println (handler-case (unreached 1) [(Missing [c] (+ 200 (.id c)))]))
(println log)
(set log 0)
(println (handler-case (reached 2) [(Missing [c] (+ 300 (.id c)))]))
(println log)
(set log 0)
(println (handler-case (both 3) [(Missing [c] (+ 400 (.id c)))]))
(println log)
(set log 0)
(println (no-signal 5))
(println log)
0)