A union member is refused in a constant as well as in a global

The refusal was on the defvar path alone, so (defconst c U (U {.i 1}))
still came back from the emitter as "a global's value must be a
compile-time constant — this one is computed", which is true and says
nothing about unions. Both kinds of global reach the same encoder, so
both get the same message.

It is decided on the checked value rather than on the declared type now,
which is what lets the one initialiser that *is* a constant through: (U
{}) is all-bytes-zero, the same value a declaration with no value gets,
and refusing it would have been telling someone to write the thing they
had written.

lib/check.ml

@@ -5933,6 +5933,28 @@ let no_move_only_defconst loc n (ty : Types.t) =
        declared as. Write (defvar %s %s) and fill it in a function"
       n (Types.to_string ty) (Types.to_string ty) n (Types.to_string ty)
 
+(* A union member written into a global would have to be encoded into the blob
+   at link time, which is the byte-level encoder a data type case does not have
+   either — and a global's initialiser is a constant, while a union value is a
+   store. Refused here, where the message can name the way through, rather than
+   at the emitter as "this one is computed", which is true and says nothing. A
+   zeroed union needs none of this and is the ordinary declaration. Both kinds
+   of global, because a defconst reaches the same emitter by a different
+   path. *)
+let no_union_init env loc n what (v : Tast.expr) =
+  match v.Tast.ty, v.Tast.e with
+  (* The all-bytes-zero value is a constant and needs none of this, so it is
+     the one initialiser that goes through — which is what makes (U {}) and a
+     declaration with no value the same thing here as everywhere else. *)
+  | _, (Tast.Zero _ | Tast.Uninit _) -> ()
+  | Types.Named un, _ when Hashtbl.mem env.unions un ->
+    fail loc
+      "the global %s is the union %s, and a union member cannot be written \
+       into a %s: the initialiser is a constant and storing a member is a \
+       store. Leave it zeroed and write the member in a function"
+      n un what
+  | _ -> ()
+
 let check_global env (d : Ast.decl) : Tast.global option =
   let ctx () = { env; ret = Types.Unit; slots = 0; slot_tys = []; slot_names = []; scope = []; defers = [];
       outer = []; outer_what = None; in_frames = None; loops = []; tail = false; in_defer = false; defer_ok = false; defer_block = "a nested form"; dead = []; borrow = false; owner = "<none>" } in
@@ -5966,23 +5988,8 @@ let check_global env (d : Ast.decl) : Tast.global option =
          | _ -> ());
         { Tast.e = Tast.Uninit ty; ty; loc = d.Ast.dloc }
       | Ast.Init v ->
-        (* A union member written into a global would have to be encoded into
-           the blob at link time, which is the byte-level encoder the data
-           type case above does not have either — and a global's initialiser
-           is a constant, while a union value is a store. Refused here, where
-           the message can name the way through, rather than at the emitter as
-           "this one is computed", which is true and says nothing. A zeroed
-           union needs none of this and is the ordinary declaration. *)
-        (match ty with
-         | Types.Named un when Hashtbl.mem env.unions un ->
-           fail d.Ast.dloc
-             "the global %s is the union %s, and a union member cannot be \
-              written into a global: the initialiser is a constant and \
-              storing a member is a store. Declare it zeroed — (defvar %s \
-              %s) — or uninit, and write the member in a function"
-             n un n un
-         | _ -> ());
-        check (ctx ()) ~want:ty v
+        let v = check (ctx ()) ~want:ty v in
+        no_union_init env d.Ast.dloc n "global" v; v
     in
     Some { Tast.gname = n; gty = ty; ginit; gconst = false; gfolded = false }
   | Ast.Defconst (n, _, v) ->
@@ -6003,6 +6010,7 @@ let check_global env (d : Ast.decl) : Tast.global option =
           loc = d.Ast.dloc }
       | _ -> check (ctx ()) ~want:ty v
     in
+    no_union_init env d.Ast.dloc n "constant" ginit;
     (* [env.consts] holds exactly the constants the folding pass consumed, so
        membership is the question "is this value in the program's shape?" *)
     Some { Tast.gname = n; gty = ty; ginit; gconst = true;

test/test_flan.ml

@@ -1633,6 +1633,19 @@ let () =
   rejects_check "a global initialised with a union member"
     "(defunion U [i i32])\n(defvar g U (U {.i 1}))\n(defn f [] i32 0)"
     ~needle:"cannot be written into a global";
+  (* A defconst reaches the same emitter by a different path, so it gets the
+     same refusal rather than coming back as "this one is computed". *)
+  rejects_check "a constant initialised with a union member"
+    "(defunion U [i i32])\n(defconst c U (U {.i 1}))\n(defn f [] i32 0)"
+    ~needle:"cannot be written into a constant";
+  (* The all-bytes-zero value is a constant and goes through, which is what
+     makes (U {}) and a declaration with no value the same thing. *)
+  (match checked "(defunion U [i i32])\n(defvar g U (U {}))\n\
+                  (defn f [] i32 (.i g))" with
+   | _ -> check "a global zeroed through a literal is allowed" true
+   | exception Loc.Error { Loc.dmsg = msg; _ } ->
+     incr failures;
+     Printf.printf "FAIL  a global zeroed through a literal is allowed: %s\n" msg);
   (* uninit is refused on a data type because its tag steers a match into a
      block LLVM may treat as unreachable. An untagged union steers nothing, so
      the argument does not carry over and the answer is different. *)