Five more, and the pattern held: the messages were right, the prose wasn't

check_struct's comment claimed a nonempty map is never mistaken for a
struct literal; is_struct_map (parse.ml) says otherwise for any size of
.field-first map, not just {} -- (g {.x 1}) on a function g still reported
bare "unknown struct g" with none of the help {} gets. Extended the
helpful message to that shape too rather than only fixing the comment,
since it is the same trap one shape over. The two shapes need different
advice, not the same one reworded: an empty map can be bound to a variable
and passed as an ordinary argument, (let [m {}] (g m)); a .field-keyed one
cannot, because expr itself refuses a bare {.field v} outside a
struct-literal position, so there is no let-binding that rescues it. The
message for that shape says so instead of repeating advice that would not
work.

Watchdog.is_dying is gone. The reviewer's own probe settled it: forcing
watchdog.ml's dying to flush_all and Unix._exit 2 directly, bypassing
at_exit entirely, gives the same exit 2 with no shared flag, no LIFO
assumption, and no window for a raise between setting a flag and exiting
to leave failures recorded and the process at exit 0. test_acceptance.exe
has no other at_exit registration (grep confirms), so nothing depends on
the watchdog path running through that chain.

test_acceptance.ml's own comment claimed calling exit inside an at_exit
handler recurses through do_at_exit. Checked directly against this
compiler (OCaml 5.2.0): it does not -- each handler gets a run-once guard
since 4.14, two stacked handlers with the inner one calling exit 7 both
ran exactly once and exited 7. Unix._exit is kept, but for the true
reason: it is not about correctness, it is about being the last word --
_exit terminates immediately and skips whatever the rest of the at_exit
chain would otherwise still do, so a handler this file grows later cannot
change the outcome underneath this one.

test_flan.ml's loose needle "keyword/value pairs" matched both the
odd-number-of-forms message and the wrong-key message; tightened to
"keyword/value pairs — found", which only the row's actual message
contains.

And {:where 1} as a defn's whole single-form dyn-map body now refuses,
where {:a 1} and {} in the same position do not -- :where is peeled
unconditionally, with no single-form exception, because that is what lets
it catch a moved closing paren leaving a stray predicate as ordinary body
code. Deliberate, and now pinned, so the next edit to this arm has to
notice it is choosing to narrow the language again rather than finding out
from a bug report.

Verified every case by compiling, including the two-handler exit(7) probe
run directly against this OCaml. dune test --force: exit 0, clean grep for
FAIL and Fatal error.
This commit is contained in:
Joseph Ferano 2026-09-19 21:51:31 +07:00
parent 87aeb7b0da
commit c3e0703642
4 changed files with 76 additions and 47 deletions

View File

@ -3056,23 +3056,37 @@ and check_struct ctx ~want loc name kvs =
"%s is a data type, and a data type value names the case as well as the \
type write (%s.%s {.field value ...}) for one of %s"
name name (first_case_name ctx.env name) (case_list ctx.env name)
(* [kvs = []] is the parser's one blind spot here, and only the empty
map: [is_struct_map] (parse.ml) reads [(name {})] as a struct
literal with no fields regardless of what [name] turns out to be,
because the parser has no table to tell a struct name from a
function name at that point -- but [(name {:a 1})] keeps [name] an
ordinary call, since a nonempty map is never mistaken for a struct
literal. So this is a narrow parser quirk about {} specifically,
not a rule that a map literal cannot be an argument -- a nonempty
one is. If [name] is a known function, the {} was meant as that
one argument, and naming the real trap is more useful than
"unknown struct". *)
else if kvs = [] && Hashtbl.mem ctx.env.fns name then
fail loc
"%s is a function, not a struct — {} on its own is read as the \
zero-field struct literal, so it cannot be passed here as an \
empty map; bind it first, as (let [m {}] (%s m))"
name name
(* [is_struct_map] (parse.ml) has two blind spots, not one: [(name
{})] reads as a struct literal with no fields regardless of what
[name] turns out to be, and so does [(name {.f v ...})] at ANY
size a [.field]-first map is never a dyn map argument, only ever
this struct-literal shape, whatever [name] is. [(name {:a 1})] is
the one that keeps [name] an ordinary call, because a
keyword-keyed map is never mistaken for a struct literal. So both
shapes below get the helpful message, not just the empty one: if
[name] is a known function, "unknown struct" is the wrong report
either way, and the two shapes need different advice, because only
one of them has a fix. An empty map can be bound to a variable and
passed as an ordinary dyn map argument, [(let [m {}] (name m))]. A
[.field]-keyed one cannot [expr] itself refuses a bare
[{.field v}] outside a struct-literal position ("a bare map is not
an expression"), so there is no let-binding that rescues it. The
syntax was never a map's; a dyn map's keys are keywords. *)
else if Hashtbl.mem ctx.env.fns name then
(match kvs with
| [] ->
fail loc
"%s is a function, not a struct — {} on its own is read as \
the zero-field struct literal, so it cannot be passed here \
as an empty map; bind it first, as (let [m {}] (%s m))"
name name
| _ ->
fail loc
"%s is a function, not a struct — {.field value ...} only \
ever builds a struct literal, never a map value, so it \
cannot be passed here as an argument; a dyn map's keys are \
keywords, as {:field value ...}"
name)
else
Loc.failk "check/unknown-struct" loc ~notes:(declared_note ctx.env name)
"unknown struct %s" name)

View File

@ -22,22 +22,23 @@ let failures = ref 0
this file grows doing what none of the current ones do: returning or
raising past the tail instead of falling through to it. However this
binary exits from that point on, if it printed a FAIL it exits nonzero.
[Unix._exit] and not [exit] calling [exit] from inside an [at_exit]
handler recurses through [do_at_exit] but [_exit] skips the channel
flush stdlib's own [at_exit] handler does, and handlers run LIFO, so this
one would fire first and throw away every row that already printed FAIL,
buffered in stdout, before it ever reached the pipe. [flush_all] first is
what [watchdog.ml]'s [dying] does for the same reason: a report that eats
the rows that failed is worse than the hang it is there to catch. And
[Watchdog.is_dying] is checked first for a reason specific to stacking two
[at_exit] handlers: a hang that follows a few already-failed rows should
still leave through the watchdog's own exit 2, not have this handler
relabel it as an ordinary exit 1 failing run. *)
[flush_all] first for the same reason [watchdog.ml]'s [dying] flushes
before it exits: the rows that did pass are sitting in stdout's buffer,
and a guard that threw them away on the way out would be worse than
whatever it is guarding against. [Unix._exit] rather than [exit] after
that is not about correctness OCaml >= 4.14 gives every [at_exit]
closure a run-once guard, so calling [exit] from inside one does not
recurse or double-run anything, verified directly against this compiler
(two handlers, the inner calling [exit 7], both ran exactly once). It is
about keeping this the last word: [_exit] terminates immediately and
skips whatever the rest of the at_exit chain would otherwise still do,
so a handler this file grows later cannot change the outcome underneath
it, and nobody reading this one has to reason about what a future
handler's [exit] call would do to it. *)
let () =
at_exit (fun () ->
if !failures > 0 && not (Watchdog.is_dying ()) then begin
flush_all (); Unix._exit 1
end)
if !failures > 0 then begin flush_all (); Unix._exit 1 end)
let scratch = Filename.get_temp_dir_name ()

View File

@ -971,13 +971,29 @@ let () =
~needle:"an empty map literal here is discarded";
rejects_check "a discarded string-keyed map at a defn body's head"
"(defn main [] i32 {\"a\" 1} 0)"
~needle:"keyword/value pairs";
~needle:"keyword/value pairs — found";
(* Not discarded, because nothing follows it: the map IS the single-form
body, a real dyn value and not a mistake to flag. *)
accepts "a keyword-keyed map as a defn's whole body"
"(defn f [] dyn {:a 1})\n(defn main [] i32 0)";
accepts "an empty map as a defn's whole body"
"(defn f [] dyn {})\n(defn main [] i32 0)";
(* :where does not get the same exception :a and {} get above -- it is
peeled unconditionally, even as a defn's whole single-form body, so
{:where 1} here is read as a constraint map with a malformed predicate
and not as a dyn map with one key named :where. That does narrow the
language: a dyn map genuinely wanting :where as a key has no way to
write one at a defn body's head (it still can anywhere else -- (let
[m {:where 1}] m) is untouched, since [constraints] only ever looks at
a defn's own body). The trade is deliberate: :where is what catches a
moved closing paren leaving a stray predicate as ordinary body code
(see above), and that only works if :where means constraint map with no
exceptions, single-form body included. Pinned so the next edit to this
arm has to notice it is choosing to narrow the language again, rather
than finding out from a bug report. *)
rejects_check ":where is reserved at a defn body's head, even alone"
"(defn f [] dyn {:where 1})\n(defn main [] i32 0)"
~needle:"a where predicate is";
(* Keywords: dyn where nothing else is asked, still an enum member where an
enum is, and refused where a concrete non-dyn type is wanted. *)

View File

@ -32,27 +32,25 @@ let label = ref "test"
let budget = ref 0
let deadline = ref 0.0
(* Set the instant [dying] starts unwinding, and read by any [at_exit]
handler a binary registers of its own (test_acceptance.ml's failure-count
guard is the one that exists) so it knows not to relabel this exit as an
ordinary failing run: the watchdog's 2 is a distinct code from a FAIL's 1,
and an [at_exit] handler that forced 1 whenever [failures > 0] would
overwrite it out from under a hang that happened to come after a few rows
had already failed. *)
let dying_flag = ref false
let is_dying () = !dying_flag
let dying _ =
dying_flag := true;
Printf.eprintf
"\nFAIL %s: no result after %ds — stopped by the test watchdog.\n\
\ A test that hangs reports nothing at all; this is that outcome\n\
\ turned into a failing run.\n"
!label !budget;
flush stderr;
(* [exit] rather than [_exit]: the rows that did pass are in stdout's buffer
and a watchdog that threw them away would be worse than the hang. *)
exit 2
(* [flush_all] and [Unix._exit], not [exit]: the rows that did pass are in
stdout's buffer and a watchdog that threw them away would be worse than
the hang, so both channels are flushed explicitly here rather than left
to [exit]'s own at_exit-registered flush. [_exit] then skips the rest of
that at_exit chain entirely, which matters now that test_acceptance.ml
registers a handler of its own: that handler forces exit 1 whenever
[failures > 0], and calling plain [exit] here would hand it a chance to
relabel this exit after the alarm already fired as an ordinary
failing run instead of a hang. Going around the chain is simpler than
coordinating with what is in it, and does not depend on how many
handlers get added there later. *)
flush_all ();
Unix._exit 2
(* Re-arm the backstop for whatever is left of its budget. One second is the
floor, because [alarm 0] cancels rather than fires. *)