Address review: payload names in printed externals, key display, coverage

- Print the attribute payload when it names a different JS entity than the
  external's primitive string (@Val("foo"), @send("bar"), ...): two
  declarations differing only in payload were correctly rejected but
  displayed identically in inclusion errors. Pinned by the new
  Cross_external_payload_name fixture.
- Map the stored import-attribute key `type` back to its source form
  `type_` when printing @module({from, with}) payloads, so the displayed
  record is writable source.
- Register Cross_external_spec_mismatch and Cross_external_payload_name in
  the ERROR_VARIANTS.md Value_descriptions fixture list.
- Add ounit coverage for External_ffi_types.inclusion_compatible: the
  optional-field codegen flag is ignored in both directions, and names,
  optionality, and field counts must match.

Signed-Off-By: Cristiano Calcagno <ccrisccris@gmail.com>
Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
Claude-Session: https://claude.ai/code/session_01PCtQiaDijUqA2fujQXvKUw

Author: cristianoc

compiler/syntax/src/res_outcome_printer.ml

@@ -513,6 +513,9 @@ let print_external_module_doc (emn : External_ffi_types.external_module_name) =
       let with_fields =
         import_attributes
         |> List.map (fun (k, v) ->
+               (* digestion stores the source key [type_] as [type]; map it
+                  back so the printed record is writable source *)
+               let k = if k = "type" then "type_" else k in
                Doc.concat
                  [Doc.text k; Doc.text ": "; print_string_literal_doc v])
       in
@@ -555,18 +558,31 @@ let print_return_wrapper_doc (w : External_ffi_types.return_wrapper) =
   | Return_null_undefined_to_opt -> Doc.text "@return(nullable) "
 
 let print_decl_kind_doc (kind : External_ffi_types.decl_kind)
-    (module_ : External_ffi_types.module_source option) =
+    (module_ : External_ffi_types.module_source option) ~prim_name =
+  (* the attribute payload names the JS entity when it differs from the
+     external's primitive string; print it back, or two declarations
+     differing only in payload would display identically *)
+  let with_payload attr name =
+    if name = prim_name then Doc.text ("@" ^ attr ^ " ")
+    else
+      Doc.concat
+        [
+          Doc.text ("@" ^ attr ^ "(");
+          print_string_literal_doc name;
+          Doc.text ") ";
+        ]
+  in
   match kind with
-  | Decl_val _ -> (
+  | Decl_val {name} -> (
     (* [@val] conflicts with bare [@module]; elsewhere it is the default and
        always legal to write *)
     match module_ with
     | Some Module_itself -> Doc.nil
-    | _ -> Doc.text "@val ")
-  | Decl_send _ -> Doc.text "@send "
-  | Decl_new _ -> Doc.text "@new "
-  | Decl_get _ -> Doc.text "@get "
-  | Decl_set _ -> Doc.text "@set "
+    | _ -> with_payload "val" name)
+  | Decl_send {name} -> with_payload "send" name
+  | Decl_new {name} -> with_payload "new" name
+  | Decl_get {name} -> with_payload "get" name
+  | Decl_set {name} -> with_payload "set" name
   | Decl_get_index -> Doc.text "@get_index "
   | Decl_set_index -> Doc.text "@set_index "
 
@@ -578,10 +594,10 @@ let print_module_source_doc (module_ : External_ffi_types.module_source option)
   | Some (Module_named emn) -> print_external_module_doc emn
 
 let print_external_decl_attrs_doc (decl : External_ffi_types.external_decl)
-    (return_wrapper : External_ffi_types.return_wrapper) =
+    (return_wrapper : External_ffi_types.return_wrapper) ~prim_name =
   Doc.concat
     [
-      print_decl_kind_doc decl.kind decl.module_;
+      print_decl_kind_doc decl.kind decl.module_ ~prim_name;
       print_module_source_doc decl.module_;
       print_scopes_doc decl.scopes;
       print_variadic_doc decl.variadic;
@@ -608,7 +624,7 @@ let rec print_out_sig_item_doc ?(print_name_as_is = false)
         match spec with
         | Ffi_obj_create _ -> (Doc.text "@obj ", "external ", Some name)
         | Ffi_bs (_params, return_wrapper, decl) ->
-          ( print_external_decl_attrs_doc decl return_wrapper,
+          ( print_external_decl_attrs_doc decl return_wrapper ~prim_name:name,
             "external ",
             Some name ))
     in

tests/ERROR_VARIANTS.md

@@ -357,7 +357,7 @@ Wrapper symptoms attached to inclusion failures. Source: [includemod.ml:23](../c
 | Variant | Status | Fixture | Notes |
 |---|---|---|---|
 | `Missing_field` | ✓ | `super_errors_multi/Iface_missing_value` | |
-| `Value_descriptions` | ✓ | `super_errors_multi/Iface_value_descriptions`, `super_errors_multi/Iface_value_arity_mismatch`, `super_errors_multi/Smoke_interface_mismatch`, `module_sig_value_arity_mismatch*.res` | Arity mismatches print a dedicated hint (implementation vs interface argument counts), including through aliases and nested function types. |
+| `Value_descriptions` | ✓ | `super_errors_multi/Iface_value_descriptions`, `super_errors_multi/Iface_value_arity_mismatch`, `super_errors_multi/Smoke_interface_mismatch`, `super_errors_multi/Cross_external_spec_mismatch`, `super_errors_multi/Cross_external_payload_name`, `module_sig_value_arity_mismatch*.res` | Arity mismatches print a dedicated hint (implementation vs interface argument counts), including through aliases and nested function types. |
 | `Type_declarations` | ✓ | `super_errors_multi/Iface_type_decl_record`, `super_errors_multi/Iface_type_decl_variant`, `RecordInclusion.res`, `type_decl_function_arity_mismatch.res` | |
 | `Extension_constructors` | ✓ | `super_errors_multi/Iface_extension_constructors` | |
 | `Module_types` | ✓ | `super_errors_multi/Iface_module_types` | |

tests/build_tests/super_errors_multi/expected/Cross_external_payload_name.expected

@@ -0,0 +1,18 @@
+===== Payload.res =====
+
+  We've found a bug for you!
+  /.../fixtures/Cross_external_payload_name/Payload.res:1:1-39
+
+  1 │ @val("foo") external f: int => int = ""
+  2 │ 
+
+  The implementation /.../fixtures/Cross_external_payload_name/Payload.res
+  does not match the interface /.../fixtures/Cross_external_payload_name/payload.cmi:
+  Values do not match:
+    @val("foo") external f: int => int = ""
+  is not included in
+    @val("bar") external f: int => int = ""
+  /.../fixtures/Cross_external_payload_name/Payload.resi:1:1-39:
+    Expected declaration
+  /.../fixtures/Cross_external_payload_name/Payload.res:1:1-39:
+    Actual declaration

tests/build_tests/super_errors_multi/fixtures/Cross_external_payload_name/Payload.res

@@ -0,0 +1 @@
+@val("foo") external f: int => int = ""

tests/build_tests/super_errors_multi/fixtures/Cross_external_payload_name/Payload.resi

@@ -0,0 +1 @@
+@val("bar") external f: int => int = ""

tests/ounit_tests/ounit_ffi_inclusion_tests.ml

@@ -0,0 +1,44 @@
+let ( >:: ), ( >::: ) = OUnit.(( >:: ), ( >::: ))
+
+let obj_params (fields : (string * bool option) list) :
+    External_arg_spec.obj_params =
+  Ext_list.map fields (fun (name, opt) ->
+      {
+        External_arg_spec.obj_arg_type = Nothing;
+        obj_arg_label =
+          (match opt with
+          | None -> External_arg_spec.obj_label name
+          | Some for_sure -> External_arg_spec.optional for_sure name);
+      })
+
+let obj fields = External_ffi_types.ffi_obj_create (obj_params fields)
+
+let compatible = External_ffi_types.inclusion_compatible
+
+let suites =
+  __FILE__
+  >::: [
+         (* [for_sure_no_nested_option] is per-module codegen conservatism
+            derived from each side's own view of the field's type; it plays
+            no role in declaration compatibility, in either direction. *)
+         ( __LOC__ >:: fun _ ->
+           OUnit.assert_bool "impl false, intf true"
+             (compatible (obj [("x", Some false)]) (obj [("x", Some true)])) );
+         ( __LOC__ >:: fun _ ->
+           OUnit.assert_bool "impl true, intf false"
+             (compatible (obj [("x", Some true)]) (obj [("x", Some false)])) );
+         ( __LOC__ >:: fun _ ->
+           OUnit.assert_bool "field names must match"
+             (not
+                (compatible (obj [("x", Some true)]) (obj [("y", Some true)])))
+         );
+         ( __LOC__ >:: fun _ ->
+           OUnit.assert_bool "optional vs required must match"
+             (not (compatible (obj [("x", Some true)]) (obj [("x", None)]))) );
+         ( __LOC__ >:: fun _ ->
+           OUnit.assert_bool "field count must match"
+             (not
+                (compatible
+                   (obj [("x", None)])
+                   (obj [("x", None); ("y", None)]))) );
+       ]

tests/ounit_tests/ounit_tests_main.ml

@@ -25,6 +25,7 @@ let suites =
       Ounit_jsx_loc_tests.suites;
       Ounit_analysis_config_tests.suites;
       Ounit_analysis_references_tests.suites;
+      Ounit_ffi_inclusion_tests.suites;
     ]
 
 let _ = OUnit.run_test_tt_main suites