diff --git a/lib/check.ml b/lib/check.ml index 988b75b..21cb296 100644 --- a/lib/check.ml +++ b/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) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index c98776f..e88f217 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -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 () diff --git a/test/test_flan.ml b/test/test_flan.ml index c79bbfd..cb6abe4 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -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. *) diff --git a/test/watchdog.ml b/test/watchdog.ml index 43efb2a..fccf284 100644 --- a/test/watchdog.ml +++ b/test/watchdog.ml @@ -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. *)