Merge pull request #3993 from BuckleScript/fix_3989

fix #3989

Author: bobzhang

jscomp/core/bs_conditional_initial.ml

@@ -38,6 +38,8 @@ let setup_env () =
   (* Turn on [-no-alias-deps] by default -- double check *)
   Oprint.out_ident := Outcome_printer_ns.out_ident;
   Builtin_attributes.check_bs_attributes_inclusion := Record_attributes_check.check_bs_attributes_inclusion;
+  Builtin_attributes.check_duplicated_labels :=
+    Record_attributes_check.check_duplicated_labels;
   Lambda.fld_record := Record_attributes_check.fld_record;
   Lambda.fld_record_set := Record_attributes_check.fld_record_set;
   Lambda.blk_record := Record_attributes_check.blk_record;

jscomp/core/record_attributes_check.ml

@@ -24,38 +24,63 @@
 
 type label = Types.label_description
 
-let fn = (fun (attr : Parsetree.attribute) -> 
-match attr with 
-| {txt = "bs.as"}, PStr 
-  [{pstr_desc = Pstr_eval ({pexp_desc = Pexp_constant (Pconst_string(s,_))},_ )}] -> 
-    (* Bs_ast_invariant.mark_used_bs_attribute attr; *)
+let find_name (attr : Parsetree.attribute) =
+  match attr with 
+  | {txt = "bs.as"}, PStr 
+      [{pstr_desc = Pstr_eval ({pexp_desc = Pexp_constant (Pconst_string(s,_))},_ )}] -> 
     Some s 
-| _ -> None
-)
+  | _ -> None
+
+
+let find_name_with_loc (attr : Parsetree.attribute) : 
+  string Asttypes.loc option =
+  match attr with 
+  | {txt = "bs.as";loc}, PStr 
+      [{pstr_desc = Pstr_eval ({pexp_desc = Pexp_constant (Pconst_string(s,_))},_ )}] -> 
+    Some {txt = s; loc} 
+  | _ -> None
+
 
 let fld_record (lbl : label) = 
   Lambda.Fld_record
-    {name = Ext_list.find_def lbl.lbl_attributes fn lbl.lbl_name; mutable_flag = lbl.Types.lbl_mut}
+    {name = Ext_list.find_def lbl.lbl_attributes find_name lbl.lbl_name; mutable_flag = lbl.Types.lbl_mut}
 
 let fld_record_set (lbl : label) = 
   Lambda.Fld_record_set 
-    (Ext_list.find_def lbl.lbl_attributes fn lbl.lbl_name)
+    (Ext_list.find_def lbl.lbl_attributes find_name lbl.lbl_name)
 
 let blk_record  fields = 
   let all_labels_info = 
     Ext_array.map fields   
       (fun ((lbl : label),_) -> 
-         Ext_list.find_def lbl.Types.lbl_attributes fn lbl.lbl_name) in  
+         Ext_list.find_def lbl.Types.lbl_attributes find_name lbl.lbl_name) in  
   Lambda.Blk_record all_labels_info
 
 let check_bs_attributes_inclusion
   (attrs1 : Parsetree.attributes)
   (attrs2 : Parsetree.attributes)
   lbl_name =   
-  let a = Ext_list.find_def attrs1 fn lbl_name in 
-  let b = Ext_list.find_def attrs2 fn lbl_name in 
+  let a = Ext_list.find_def attrs1 find_name lbl_name in 
+  let b = Ext_list.find_def attrs2 find_name lbl_name in 
   if a = b then None 
   else Some (a,b)
 
+let rec check_duplicated_labels_aux 
+  (lbls : Parsetree.label_declaration  list) 
+  (coll : String_set.t) = 
+    match lbls with 
+    | [] -> None 
+    | {pld_name= ({txt} as pld_name); pld_attributes}::rest ->
+        if String_set.mem coll txt then Some            pld_name
+        else 
+          let coll = String_set.add coll txt in
+          match Ext_list.find_opt pld_attributes find_name_with_loc with 
+          | None -> check_duplicated_labels_aux rest coll
+          | Some ({txt = s;} as l) -> 
+            if String_set.mem coll s then  
+              Some l
+            else 
+              check_duplicated_labels_aux rest (String_set.add coll s)
 
-
+let check_duplicated_labels lbls = 
+    check_duplicated_labels_aux lbls String_set.empty             

jscomp/test/record_name_test.ml

@@ -64,4 +64,13 @@ and obj = {
 
 let f4  ({ x; y; z = {hi }}: entry) = 
   (x + y + hi) * 2
-  
+  
+#if 0 then
+type t5 = {
+  x : int ;
+  y : int [@bs.as "x"] 
+  (* either x or y is a mistake *)
+}   
+
+let v5  = {x = 3 ; y = 2}
+#end