A call through a null CFn parks a dev program in the break loop with NullCall named and continue takeable, on LLVM and x86

test/programs/dev-break-nullcall.flan

@@ -0,0 +1,26 @@
+;;;; A program that stops on a call through a null CFn, for driving the break
+;;;; loop over one. Nothing handles NullCall here, so the signal reaches the
+;;;; break hook and the program parks, as a bad index does in
+;;;; dev-break-bounds.flan; the program's own continue is the way on.
+(import agent "vendor:agent")
+
+(defonce table [2 (CFn [i32] i32)])
+(defonce skipped i64)
+(defonce ticks i64)
+
+(defn call-slot [i i32] i32 ((at table i) 5))
+
+(defn frame [i i32] ()
+  (restart-case
+    (do (println (call-slot i)) (println "frame done"))
+    (continue [] (set skipped (+ skipped 1)))))
+
+(defn main [] i32
+  (agent/start "/tmp/flan-dev-break-nullcall-fallback.sock")
+  ;; Slot 1 was never set, so it is null.
+  (frame 1)
+  (print skipped) (println "")
+  (dotimes [i 4000]
+    (agent/wait 5)
+    (set ticks (+ ticks 1)))
+  0)

test/test_dev.ml

@@ -2162,6 +2162,88 @@ let () =
        pointer: the bytes-view write that first crashed no longer compiles. *)
     trap_park ~refault:true "segfault" "dev-segv.flan" "SegFault" [];
 
+    (* ── A break over a call through a null CFn ─────────────────────────
+
+       NullCall is a condition, signalled as a bad index is: nothing handles
+       it in dev-break-nullcall.flan, so the program parks with NullCall
+       named, the program's own continue on offer and takeable, and taking it
+       resumes — the transcript's 1 is continue's clause having run. On both
+       backends, since the null test before the call is emitted by each. *)
+    let null_park backend =
+      let nsock = tmp ("nullcall" ^ backend ^ ".sock")
+      and nout = tmp ("nullcall" ^ backend ^ ".out") in
+      (try Sys.remove nsock with Sys_error _ -> ());
+      let nfd =
+        Unix.openfile nout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600
+      in
+      let npid =
+        Unix.create_process flan
+          [| flan; "dev"; "programs/dev-break-nullcall.flan"; "-s"; nsock; backend |]
+          Unix.stdin nfd Unix.stderr
+      in
+      Unix.close nfd;
+      if not (listening ~pid:npid nsock) then begin
+        fail "the null-call daemon (%s) %s" backend !listen_why;
+        (try Unix.kill npid Sys.sigkill with Unix.Unix_error _ -> ())
+      end
+      else begin
+        let out = Buffer.create 64 in
+        let c = connect nsock in
+        let ask sexp =
+          let r = Wire.parse (Wire.send c sexp; Wire.recv c) in
+          (match Wire.string_field r "output" with
+           | Some t -> Buffer.add_string out t
+           | None -> ());
+          r
+        in
+        let stopped r =
+          match Wire.field r "stopped" with
+          | Some { Form.v = Form.Sym "t"; _ } -> true
+          | _ -> false
+        in
+        let last = ref (Wire.parse "()") in
+        if not (await (fun () -> last := ask "(:op \"describe\")"; stopped !last))
+        then fail "a null CFn call never stopped the program (%s)" backend
+        else begin
+          (match Wire.string_field !last "condition" with
+           | Some "NullCall" -> ()
+           | c ->
+             fail "a null CFn call is reported as %S (%s)"
+               (Option.value ~default:"" c) backend);
+          let r = ask "(:op \"break\")" in
+          (match Wire.field r "restarts" with
+           | Some { Form.v = Form.List l; _ }
+             when List.exists
+                    (fun (n : Form.t) -> n.Form.v = Form.Str "continue") l -> ()
+           | _ -> fail "a null CFn call offers no continue (%s)" backend);
+          let r = ask "(:op \"restart\" :name \"continue\")" in
+          if status r <> "ok" then
+            fail "continuing past a null CFn call (%s): %s" backend
+              (Option.value ~default:"" (Wire.string_field r "message"));
+          if not
+               (await (fun () ->
+                  ignore (ask "(:op \"describe\")");
+                  List.mem "1"
+                    (String.split_on_char '\n' (Buffer.contents out))))
+          then fail "the program never resumed past a null CFn call (%s)" backend
+        end;
+        ignore (ask "(:op \"close\")");
+        Unix.close c;
+        if not
+             (await ~ms:5000 (fun () ->
+                match Unix.waitpid [ Unix.WNOHANG ] npid with
+                | 0, _ -> false
+                | _ -> true
+                | exception Unix.Unix_error _ -> true))
+        then begin
+          (try Unix.kill npid Sys.sigkill with Unix.Unix_error _ -> ());
+          (try ignore (Unix.waitpid [] npid) with Unix.Unix_error _ -> ())
+        end
+      end
+    in
+    null_park "--llvm";
+    null_park "--x86";
+
     (* ── The locals of a stopped frame ─────────────────────────────── *)
 
     (* A third daemon, over a program that stops with something worth looking