Retyping a global across a reload, which nothing had ever done

flan_dev_global hands back the allocation it made the first time a name
was asked for, and compares the size it recorded against the size it is
asked for. Nothing exercised the comparison: v5 is v4 with extra as an
i32, loaded on top of v3, and what it does is abort the process — so it
gets a host run of its own. The message is asserted alongside the exit
status, because a process that died for some other reason is not this
guard firing and the status alone cannot tell them apart.

test/programs/reload-v5.flan

@@ -0,0 +1,29 @@
+;;;; v5 is v4 with one difference: [extra] is an i32 rather than an i64.
+;;;;
+;;;; [extra] does not exist in the host — v3 introduced it at run time, so its
+;;;; storage was allocated by runtime/flan_dev.c the first time a module asked
+;;;; for it, and every later module that mentions the name is handed back that
+;;;; same allocation. Handing it back for a differently shaped type is layout
+;;;; drift: the new body would read and write at offsets the old allocation was
+;;;; never laid out for, and nothing downstream could ever say so. The registry
+;;;; compares the size it recorded against the size it is asked for and aborts
+;;;; instead — retyping a var needs a restart, and this is the file that says
+;;;; the guard is real.
+;;;;
+;;;; Loaded on top of v3, and never alongside v4: the process it aborts is the
+;;;; whole of the test.
+(defvar counter i64)
+(defvar extra i32)
+
+(defn helper [x i64] i64 (* x 2))
+
+(defn added [] i32
+  (set extra (+ extra 100))
+  extra)
+
+(defn bump [] i64
+  (println "v5")
+  (set counter (+ counter (i64 (added))))
+  (helper counter))
+
+(defn outer [] i64 (bump))

test/test_reload.ml

@@ -82,6 +82,10 @@ let () =
        not exist. This is the C-c C-k unit. *)
     let so3, ir3, _, _ = module_of p3 [ "bump"; "added" ] "v3.so" in
     let so4, ir4, _, _ = module_of p4 [ "added" ] "v4.so" in
+    (* v5 retypes [extra], which v3 introduced at run time. It is built here
+       and loaded in a process of its own below: what it does is abort. *)
+    let p5 = checked "programs/reload-v5.flan" in
+    let so5, _, _, _ = module_of p5 [ "added" ] "v5.so" in
 
     (* A redefinition module must not define what the host already owns:
        defining [counter] would give the loaded object a private copy and the
@@ -196,6 +200,32 @@ let () =
     if code <> 0 || text <> want then
       fail "reload\n        got: %S (exit %d)\n     wanted: %S" text code want;
 
+    (* The layout-drift guard, which needs a process of its own because what it
+       does is abort one. [extra] does not exist in the host: v3 introduced it
+       at run time, so flan_dev.c allocated its storage and recorded its size,
+       and every later module asking for that name is handed the same
+       allocation back. v5 asks for it as an i32. Handing back eight bytes for
+       a four-byte type is not an error anything downstream can detect — the
+       new body simply reads fields at offsets the allocation was never laid
+       out for — so the registry compares sizes and dies at the first chance
+       it has.
+
+       Asserted on the message as well as on the exit status: a process that
+       died for some other reason is not this guard firing, and the exit code
+       alone cannot tell the two apart. *)
+    let out5 = tmp "out5" and err5 = tmp "err5" in
+    let code5 =
+      Sys.command
+        (Printf.sprintf "%s %s %s %s > %s 2> %s" (Filename.quote host)
+           (Filename.quote so1) (Filename.quote so3) (Filename.quote so5)
+           (Filename.quote out5) (Filename.quote err5))
+    in
+    let said = In_channel.with_open_bin err5 In_channel.input_all in
+    if code5 = 0 then
+      fail "a global retyped across a reload was accepted (exit 0)";
+    if not (has said "size changed") then
+      fail "a retyped global did not stop on the size guard: %S" said;
+
     Printf.printf
       "reload: emit %.1fms  llc %.1fms  ld %.1fms  (v2: emit %.1fms  llc %.1fms  ld %.1fms)  host run %.1fms\n"
       emit_ms t1.Build.llc_ms t1.Build.link_ms emit2_ms t2.Build.llc_ms
@@ -203,7 +233,7 @@ let () =
     print_string timings;
 
     List.iter (fun p -> try Sys.remove p with Sys_error _ -> ())
-      [ host; so1; so2; so3; so4; out; tmp "err" ];
+      [ host; so1; so2; so3; so4; so5; out; out5; err5; tmp "err" ];
     if !failures = 0 then print_endline "reload: all tests passed"
     else begin
       Printf.printf "\n%d failure(s)\n" !failures;