Reject bindings of a module that get the same JavaScript name

changes/js-name-clash.fix.md

@@ -0,0 +1 @@
+- Report an error when two bindings of a module get the same JavaScript name, such as `delete` and `$$delete`, instead of emitting a duplicate or overwritten export.

compiler/core/js_implementation.ml

@@ -48,6 +48,7 @@ let after_parsing_sig ppf outputprefix ast =
       if !((Clflags.current ()).dump_typedtree) then
         fprintf ppf "%a@." Printtyped.interface tsg;
       let sg = tsg.sig_type in
+      Typemod.check_js_names ~toplevel:true sg;
       ignore (Includemod.signatures initial_env sg sg);
       Delayed_checks.force_delayed_checks ();
       Warnings.check_fatal ();

compiler/core/lam_coercion.ml

@@ -83,8 +83,6 @@ let handle_exports (meta : Lam_stats.t) (lambda_exports : Lambda.t list)
     (reverse_input : Lam_group.t list) =
   let (original_exports : Ident.t list) = meta.exports in
   let (original_export_set : Set_ident.t) = meta.export_idents in
-  let len = List.length original_exports in
-  let tbl = Hash_set_string.create len in
   let ({export_list; export_set} as result) =
     Ext_list.fold_right2 original_exports lambda_exports
       {
@@ -94,9 +92,6 @@ let handle_exports (meta : Lam_stats.t) (lambda_exports : Lambda.t list)
         groups = [];
       } (fun (original_export_id : Ident.t) (lam : Lambda.t) (acc : t) ->
         let original_name = original_export_id.name in
-        if Hash_set_string.mem tbl original_name then
-          Bs_exception.error (Bs_duplicate_exports original_name);
-        Hash_set_string.add tbl original_name ();
         match lam with
         | Lvar id ->
           if Ident.name id = original_name then

compiler/depends/bs_exception.ml

@@ -25,7 +25,6 @@
 type error =
   | Cmj_not_found of string
   | Js_not_found of string
-  | Bs_duplicate_exports of string (* gpr_974 *)
   | Missing_ml_dependency of string
   | Dependency_script_module_dependent_not of string
       (** TODO: we need add location handling *)
@@ -47,7 +46,6 @@ let report_error ppf = function
       s
   | Js_not_found s ->
     Format.fprintf ppf "%s not found, needed in script mode " s
-  | Bs_duplicate_exports str -> Format.fprintf ppf "%s is exported twice" str
 
 let () =
   Location.register_error_of_exn (function

compiler/depends/bs_exception.mli

@@ -25,7 +25,6 @@
 type error =
   | Cmj_not_found of string
   | Js_not_found of string
-  | Bs_duplicate_exports of string (* gpr_974 *)
   | Missing_ml_dependency of string
   | Dependency_script_module_dependent_not of string
 

compiler/ml/typemod.ml

@@ -34,6 +34,7 @@ type error =
   | With_changes_module_alias of Longident.t * Ident.t * Path.t
   | With_cannot_remove_constrained_type
   | Repeated_name of string * string * Warnings.loc
+  | Js_name_clash of string * string * string * Warnings.loc
   | Non_generalizable of type_expr
   | Non_generalizable_module of module_type
   | Interface_not_compiled of string
@@ -636,6 +637,42 @@ let check_sig_item names loc = function
   | Sig_typext (id, _, _) -> check_typext names loc (Ident.name id)
   | _ -> ()
 
+(* Two runtime components of a module must not get the same JavaScript name:
+   the module's fields, and the exports of a compilation unit, are named by
+   [Ext_ident.convert], which maps both [delete] and [$$delete] to [$$delete]
+   and [\"a-b"] like [a$b]. The exports of a compilation unit keep [default]
+   as written. Values are checked after [simplify_signature], so a value that
+   is shadowed by one of the same name is not a field. *)
+let check_js_names ~toplevel (sg : Types.signature) =
+  let seen = Hashtbl.create 17 in
+  List.iter
+    (fun (item : Types.signature_item) ->
+      let component =
+        match item with
+        | Sig_value (_, {val_kind = Val_prim _}) | Sig_type _ | Sig_modtype _ ->
+          None
+        | Sig_value (id, {val_loc}) -> Some ("value", id, val_loc)
+        | Sig_typext (id, {ext_loc}, _) ->
+          Some ("extension constructor", id, ext_loc)
+        | Sig_module (id, {md_loc}, _) -> Some ("module", id, md_loc)
+      in
+      match component with
+      | None -> ()
+      | Some (kind, id, loc) -> (
+        let name = Ident.name id in
+        let js_name =
+          if toplevel && name = "default" then name else Ext_ident.convert name
+        in
+        match Hashtbl.find_opt seen js_name with
+        | Some (other_kind, other_loc) ->
+          raise
+            (Error
+               ( loc,
+                 Env.empty,
+                 Js_name_clash (kind, other_kind, js_name, other_loc) ))
+        | None -> Hashtbl.add seen js_name (kind, loc)))
+    sg
+
 (* Simplify multiple specifications of a value or an extension in a signature.
    (Other signature components, e.g. types, modules, etc, are checked for
    name uniqueness.)  If multiple specifications with the same name,
@@ -702,6 +739,7 @@ and transl_modtype_aux env smty =
       env loc smty.pmty_attributes
   | Pmty_signature ssg ->
     let sg = transl_signature env ssg in
+    check_js_names ~toplevel:false sg.sig_type;
     mkmty (Tmty_signature sg) (Mty_signature sg.sig_type) env loc
       smty.pmty_attributes
   | Pmty_functor (param, sarg, sres) ->
@@ -1266,6 +1304,7 @@ and type_module_aux ~alias sttn funct_body anchor env smod =
       }
     in
     let sg' = simplify_signature sg in
+    check_js_names ~toplevel:false sg';
     if List.length sg' = List.length sg then md
     else
       wrap_constraint
@@ -1766,7 +1805,8 @@ let type_implementation_more ?check_exists sourcefile outputprefix modulename
         (Cmt_format.Implementation str) (Some sourcefile) initial_env;
       (str, coercion, finalenv, dclsig)
       (* identifier is useless might read from serialized cmi files*))
-    else
+    else (
+      check_js_names ~toplevel:true simple_sg;
       let coercion =
         Includemod.compunit initial_env sourcefile sg "(inferred signature)"
           simple_sg
@@ -1785,7 +1825,7 @@ let type_implementation_more ?check_exists sourcefile outputprefix modulename
              (outputprefix ^ ".cmi"));
         Cmt_format.save_cmt (outputprefix ^ ".cmt") modulename
           (Cmt_format.Implementation str) (Some sourcefile) initial_env);
-      (str, coercion, finalenv, simple_sg)
+      (str, coercion, finalenv, simple_sg))
   with e ->
     Cmt_format.save_cmt (outputprefix ^ ".cmt") modulename
       (Cmt_format.Partial_implementation
@@ -1855,6 +1895,11 @@ let report_error ppf = function
       "@[Multiple definition of the %s name %s @ at @{<loc>%a@}@ @ Names must \
        be unique in a given structure or signature.@]"
       kind name Location.print_loc repeated_loc
+  | Js_name_clash (kind, other_kind, js_name, other_loc) ->
+    fprintf ppf
+      "@[This %s has the same JavaScript name %s@ as the %s at @{<loc>%a@}.@ \
+       Rename one of them.@]"
+      kind js_name other_kind Location.print_loc other_loc
   | Non_generalizable typ ->
     (* modified *)
     fprintf ppf "@[<v>";

compiler/ml/typemod.mli

@@ -35,6 +35,7 @@ val type_implementation_more :
   Typedtree.structure * Typedtree.module_coercion * Env.t * Types.signature
 
 val transl_signature : Env.t -> Parsetree.signature -> Typedtree.signature
+val check_js_names : toplevel:bool -> Types.signature -> unit
 val type_open_ :
   ?used_slot:bool ref ->
   ?toplevel:bool ->
@@ -60,6 +61,7 @@ type error =
   | With_changes_module_alias of Longident.t * Ident.t * Path.t
   | With_cannot_remove_constrained_type
   | Repeated_name of string * string * Warnings.loc
+  | Js_name_clash of string * string * string * Warnings.loc
   | Non_generalizable of type_expr
   | Non_generalizable_module of module_type
   | Interface_not_compiled of string

tests/build_tests/gpr_978/input.js

@@ -8,5 +8,5 @@ const { execBuild, execClean } = setup(import.meta.dirname);
 
 const output = await execBuild();
 const stderr = stripVTControlCharacters(output.stderr);
-assert.match(stderr, /M is exported twice/);
+assert.match(stderr, /This module has the same JavaScript name M/);
 await execClean();

tests/build_tests/super_errors/expected/js_name_clash_keyword.res.expected

@@ -0,0 +1,11 @@
+
+  We've found a bug for you!
+  /.../fixtures/js_name_clash_keyword.res:2:5-12
+
+  1 │ let delete = 1
+  2 │ let $$delete = 2
+  3 │ 
+
+  This value has the same JavaScript name $$delete
+  as the value at /.../fixtures/js_name_clash_keyword.res:1:5-10.
+  Rename one of them.

tests/build_tests/super_errors/expected/js_name_clash_mangled.res.expected

@@ -0,0 +1,11 @@
+
+  We've found a bug for you!
+  /.../fixtures/js_name_clash_mangled.res:2:5-7
+
+  1 │ let \"a-b" = 1
+  2 │ let a$b = 2
+  3 │ 
+
+  This value has the same JavaScript name a$b
+  as the value at /.../fixtures/js_name_clash_mangled.res:1:5-10.
+  Rename one of them.

tests/build_tests/super_errors/expected/js_name_clash_module.res.expected

@@ -0,0 +1,13 @@
+
+  We've found a bug for you!
+  /.../fixtures/js_name_clash_module.res:2:8-4:1
+
+  1 │ exception Foo
+  2 │ module Foo = {
+  3 │   let x = 1
+  4 │ }
+  5 │ 
+
+  This module has the same JavaScript name Foo
+  as the extension constructor at /.../fixtures/js_name_clash_module.res:1:1-13.
+  Rename one of them.

tests/build_tests/super_errors/expected/js_name_clash_module_type.res.expected

@@ -0,0 +1,13 @@
+
+  We've found a bug for you!
+  /.../fixtures/js_name_clash_module_type.res:3:3-19
+
+  1 │ module type S = {
+  2 │   let delete: int
+  3 │   let $$delete: int
+  4 │ }
+  5 │ 
+
+  This value has the same JavaScript name $$delete
+  as the value at /.../fixtures/js_name_clash_module_type.res:2:3-17.
+  Rename one of them.

tests/build_tests/super_errors/expected/js_name_clash_nested.res.expected

@@ -0,0 +1,13 @@
+
+  We've found a bug for you!
+  /.../fixtures/js_name_clash_nested.res:3:7-15
+
+  1 │ module M = {
+  2 │   let default = 1
+  3 │   let $$default = 2
+  4 │ }
+  5 │ 
+
+  This value has the same JavaScript name $$default
+  as the value at /.../fixtures/js_name_clash_nested.res:2:7-13.
+  Rename one of them.

tests/build_tests/super_errors/fixtures/js_name_clash_keyword.res

@@ -0,0 +1,2 @@
+let delete = 1
+let $$delete = 2

tests/build_tests/super_errors/fixtures/js_name_clash_mangled.res

@@ -0,0 +1,2 @@
+let \"a-b" = 1
+let a$b = 2

tests/build_tests/super_errors/fixtures/js_name_clash_module.res

@@ -0,0 +1,4 @@
+exception Foo
+module Foo = {
+  let x = 1
+}

tests/build_tests/super_errors/fixtures/js_name_clash_module_type.res

@@ -0,0 +1,4 @@
+module type S = {
+  let delete: int
+  let $$delete: int
+}

tests/build_tests/super_errors/fixtures/js_name_clash_nested.res

@@ -0,0 +1,4 @@
+module M = {
+  let default = 1
+  let $$default = 2
+}

tests/build_tests/super_errors_multi/expected/Js_name_clash_interface.expected

@@ -0,0 +1,12 @@
+===== A.resi =====
+
+  We've found a bug for you!
+  /.../fixtures/Js_name_clash_interface/A.resi:2:1-17
+
+  1 │ let delete: int
+  2 │ let $$delete: int
+  3 │ 
+
+  This value has the same JavaScript name $$delete
+  as the value at /.../fixtures/Js_name_clash_interface/A.resi:1:1-15.
+  Rename one of them.

tests/build_tests/super_errors_multi/fixtures/Js_name_clash_interface/A.resi

@@ -0,0 +1,2 @@
+let delete: int
+let $$delete: int