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:
parent
87aeb7b0da
commit
c3e0703642
48
lib/check.ml
48
lib/check.ml
@ -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)
|
||||
|
||||
@ -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 ()
|
||||
|
||||
|
||||
@ -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. *)
|
||||
|
||||
@ -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. *)
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user