diff --git a/FIX.org b/FIX.org index 6714181..2f8aa4b 100644 --- a/FIX.org +++ b/FIX.org @@ -507,13 +507,17 @@ instead of saying something false. A lane runs the fast check and nothing more. `dune test` is the whole of a lane's obligation. It used to be judged by reading the printed output rather than by trusting the exit status, on the theory that some path through the -acceptance runner could print a FAIL and still exit 0 — the tail check itself -already exited 1, but nothing proved every skip path (no clang, no wasmtime, -no raylib, no lldb) still reached it. test_acceptance.ml now closes that class -with an `at_exit` handler that holds regardless of which path the process -leaves by, so the exit status can be trusted again and either check does. -Running one program directly to capture its real output for an acceptance row -is still expected; that is cheap. What a lane may no longer do is sweep. +acceptance runner could print a FAIL and still exit 0. That theory did not +hold up: test_acceptance.ml is one match on whether clang is on PATH, the +wasmtime/raylib/lldb probes inside it are ordinary `if`s that fall through to +the same tail rather than branches that leave early, and the tail already +turned a nonzero failure count into exit 1 — so did every other test binary's +tail, checked the same way. test_acceptance.ml now also carries an `at_exit` +guard, but it closes no open gap; it is insurance against a future case +leaving past the tail instead of through it. The exit status was already +trustworthy and stays that way, so either check does. Running one program +directly to capture its real output for an acceptance row is still expected; +that is cheap. What a lane may no longer do is sweep. The x86 survey and the sanitizer sweep run once, after several lanes have landed, and whatever they turn up is dispatched as fixes in a single batch. diff --git a/lib/check.ml b/lib/check.ml index 29a5a6b..988b75b 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -3056,18 +3056,22 @@ 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: a symbol applied to - an empty map literal, [(name {})], parses 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. If - [name] is a known function, the empty map was meant as an argument - — and there is no syntax to pass a map literal straight into a call - that way, empty or not; every real function argument is a bound - name. Naming that is more useful than "unknown struct". *) + (* [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 — a map literal cannot be passed \ - directly as an argument; bind it first, as (let [m {}] (%s m))" + "%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 else Loc.failk "check/unknown-struct" loc ~notes:(declared_note ctx.env name) @@ -4009,7 +4013,7 @@ and named_call ctx ~want loc name args = built-in equality (plan.org, Types)" name (Types.to_string a.Tast.ty) | _ -> fail loc - "%s orders machine numbers; %s has no built-in ordering \ + "%s orders machine numbers and enums; %s has no built-in ordering \ (plan.org, Types)" name (Types.to_string a.Tast.ty)); prim p Types.Bool [ a; b ] end diff --git a/lib/parse.ml b/lib/parse.ml index 98aff2f..670b660 100644 --- a/lib/parse.ml +++ b/lib/parse.ml @@ -145,29 +145,62 @@ and pitems (items : Form.t list) : Ast.pitem list = braces in a row meaning different things — [(defn f [xs [$t]] {string i32} {:where ...} body)]. The brace spelling has since been withdrawn from type position entirely ([texpr] above), so the slot after the return type can be - nothing but this. A bare [{}] in *expression* position is already refused - ([expr] below), so there is nothing for it to be confused with on the other - side either. + nothing but this. - The leading keyword is still required and still checked, because it is what - tells a constraint map from a struct literal's field list, [{.x 1}], which - is what braces mean in the position a body starts in. *) + The leading keyword is checked, but is no longer what tells a constraint + map from anything else braces can mean in the position a body starts in — + dyn maps changed what else is possible there. [{.x 1}] is still read as a + struct literal's field list and never as a constraint map, but [expr] + below says so, with its own message; this function no longer sees that + shape at all. What DOES reach here besides [:where]: a keyword-keyed map + with a different key, an empty map, or a map keyed on something that is + neither a keyword nor a [.field] symbol, and only when the body has more + after it — with nothing after, that map is the whole single-form body, a + real dyn value like [(defn f [] dyn {:a 1})] or [(defn f [] dyn {})], and + this function leaves it alone. *) let constraints (body : Form.t list) : Ast.pred list * Form.t list = match body with - (* Any map literal whose first key is a keyword is read as a constraint - map when something follows it, not just one that opens on [:where]: a - keyword-first map is never a struct literal ([is_struct_map] wants a - [.field] symbol or [Map []]), and one sitting where the body starts with - more body after it is discarded on evaluation — a map literal has no - side effects, so that spot is always a mistake and not a case a real - program uses. Reading a typo'd key, like [:wheer], as ordinary body code - used to print a baffling "unknown function ordered?" from inside what - the user meant as a predicate; reading it here instead lets [keys] below - say which key it does not recognise. The single-form body, [rest = []], - is left alone: there the map is not discarded, it IS the answer — a - [(defn f [] dyn {:a 1})] whose whole body is the dyn value to build. *) - | ({ Form.v = Form.Map (({ Form.v = Form.Kw _; _ } :: _ as kvs)); _ } as m) - :: (_ :: _ as rest) -> + (* A map literal opening on [:where] is always a constraint map, even with + nothing after it: a where-clause with no body past it is what a moved + closing paren produces, and the whole point of naming the key here is + to catch that as a constraint-map error ("a where predicate is ...", or + whatever [keys] finds wrong with it) rather than let a stray [(ordered? + $t)] surface later as "unknown function ordered?" from inside what was + meant as a predicate. Any OTHER map literal — keyed on a different + keyword, keyed on something that is not a keyword at all, or holding no + keys at all — is read as a constraint map only when something follows + it in the body: unlike [:where], nothing about the map alone says it is + a mistake and not an ordinary map literal until [rest] says whether it + is one body form among several (discarded, so worth flagging as the + typo it almost always is) or the function's entire single-form body + ([(defn f [] dyn {:a 1})], where the map is not discarded, it IS the + answer, evaluated for both its side effects and its value like any + other body form). Note that "discarded" here is about the map's + *result*, not about whether evaluating it can do anything: {:a (println + "hi")} still prints, same as any expression statement whose value + nothing uses — this arm's business is a value going unused, not + silence. An empty map, [{}], has no key to check and gets its own + message rather than running [keys] on nothing and saying nothing. + + One shape is excluded on purpose: a map opening on a [.field] symbol, + [{.x 1}], is a struct field list with no struct name in front of it, and + [expr] below already gives that its own message, "a bare map is not an + expression; write (Type {.field v})" — the one this file had before any + of the above existed. Catching it here first would bury that dedicated + diagnostic under "a constraint map is keyword/value pairs", which is + true but not what is wrong with it. *) + | ({ Form.v = Form.Map kvs; loc } as m) :: rest + when (match kvs with + | { Form.v = Form.Kw "where"; _ } :: _ -> true + | { Form.v = Form.Sym s; _ } :: _ + when String.length s > 1 && s.[0] = '.' -> false + | _ -> rest <> []) -> + if kvs = [] then + Loc.fail loc + "an empty map literal here is discarded — the body has more after \ + it, and its value going unused is almost always a typo for \ + {:where ...}; write (do {} ...) if the empty map is deliberate" + else let pred (p : Form.t) = match p.Form.v with (* [$t] at a predicate, not bare [t]: the clause talks about the diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 7870069..c98776f 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -12,24 +12,32 @@ let () = Watchdog.arm ~seconds:1200 "test_acceptance" let failures = ref 0 -(* The tail of this file exits 1 when [failures] is nonzero, but that check - is one path among several a run can take: a probe for clang, wasmtime, - raylib or lldb can skip a whole section and jump past rows that already - failed. Reading through the file to prove every path still reaches the - tail check is exactly the kind of proof that quietly stops being true the - next time a case is added. An [at_exit] guard makes the invariant hold no - matter which path the process leaves by: however this binary exits, 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. *) +(* The tail of this file already exits 1 when [failures] is nonzero, and + there is no path through this binary that skips it: it is one match on + whether clang is on PATH, and the wasmtime/raylib/lldb probes further down + are inner [if]s that fall back through to that same tail rather than + branches that leave early. The no-clang arm runs zero rows, so it cannot + be carrying an unreported failure either. So this [at_exit] guard is not + closing an open gap in this file — it is insurance against the next case + 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. *) let () = at_exit (fun () -> - if !failures > 0 then begin flush_all (); Unix._exit 1 end) + if !failures > 0 && not (Watchdog.is_dying ()) 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 d142bb8..c79bbfd 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -930,10 +930,17 @@ let () = ~needle:"odd number of forms"; (* The struct spelling is untouched on both of its sides: bare braces opening on a .field are still a struct literal that wants its type - written, and (Type {.field v}) still builds one. *) + written, and (Type {.field v}) still builds one. It is untouched at + the head of a defn body too, single-form or not — [constraints] + (parse.ml) leaves a [.field]-first map alone precisely so this + dedicated message, not "a constraint map is keyword/value pairs", + is what a program gets there. *) rejects_check "bare struct-shaped braces still refuse" "(defn main [] i32 (let [m {.x 1}] 0))" ~needle:"write (Type {.field v})"; + rejects_check "bare struct-shaped braces at a defn body's head, too" + "(defn main [] i32 {.x 1} 0)" + ~needle:"write (Type {.field v})"; accepts "a struct literal still builds" "(defstruct P [x i32])\n\ (defn main [] i32 (let [p (P {.x 1})] (.x p)))"; @@ -943,6 +950,34 @@ let () = accepts "a where clause is still a constraint map" "(defn biggest [a $t b $t] $t {:where (ordered? $t)} (if (> a b) a b))\n\ (defn main [] i32 (biggest 1 2))"; + (* A where clause with nothing after it is what a moved closing paren + produces -- the body fell outside the defn. It stays a constraint map + even alone, so this is "no body", not the "unknown function ordered?" + it used to print from a stray predicate read as ordinary body code. *) + rejects_check "a where clause with no body after it" + "(defn ordered? [x] bool true)\n\ + (defn mx [a $t b $t] $t {:where (ordered? $t)})" + ~needle:"has no body"; + (* A keyword-keyed map at the head of a multi-form body, other than + :where, is a typo almost every time -- its value is discarded, and a + map literal has no reason to sit somewhere its value goes unused. An + empty map there gets its own message, since it has no key for [keys] + to name. *) + rejects_check "a discarded keyword-keyed map at a defn body's head" + "(defn main [] i32 {:a 1} 0)" + ~needle:"is not a key a defn's constraint map takes"; + rejects_check "a discarded empty map at a defn body's head" + "(defn main [] i32 {} 0)" + ~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"; + (* 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)"; (* 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 dbc10b8..43efb2a 100644 --- a/test/watchdog.ml +++ b/test/watchdog.ml @@ -32,7 +32,18 @@ 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\