add a test case for p_is_int

bobzhang · bobzhang · commit 939a4450de34 · 2019-12-02T11:42:07.000+08:00
diff --git a/jscomp/test/exception_rebind_test.js b/jscomp/test/exception_rebind_test.js
@@ -13,9 +13,12 @@ var B = {
   F: E
 };
 
+var A0 = Caml_exceptions.create("Exception_rebind_test.A0");
+
 var H = Exception_def.A;
 
 exports.A = A;
 exports.B = B;
 exports.H = H;
+exports.A0 = A0;
 /* Exception_def Not a pure module */
diff --git a/jscomp/test/exception_rebind_test.ml b/jscomp/test/exception_rebind_test.ml
@@ -9,3 +9,11 @@ module B = struct
 end
 
 exception H = Exception_def.A
+
+
+type u = exn 
+
+type exn += A0 of int 
+#if 0 then
+type u += A1 of int (*Type definition u is not extensible*)
+#end
diff --git a/jscomp/test/poly_variant_test.js b/jscomp/test/poly_variant_test.js
@@ -120,6 +120,21 @@ function test(readline, x) {
   return /* () */0;
 }
 
+function p_is_int_test(x) {
+  if (typeof x === "number") {
+    return 2;
+  } else {
+    return 3;
+  }
+}
+
+eq("File \"poly_variant_test.ml\", line 142, characters 5-12", 2, 2);
+
+eq("File \"poly_variant_test.ml\", line 143, characters 5-12", 3, p_is_int_test(/* `b */[
+          98,
+          2
+        ]));
+
 Mt.from_pair_suites("Poly_variant_test", suites.contents);
 
 function on2(prim, prim$1) {
@@ -144,4 +159,5 @@ exports.test = test;
 exports.on2 = on2;
 exports.read = read;
 exports.readN = readN;
+exports.p_is_int_test = p_is_int_test;
 /*  Not a pure module */
diff --git a/jscomp/test/poly_variant_test.ml b/jscomp/test/poly_variant_test.ml
@@ -130,4 +130,16 @@ let register readline =
 let test readline x  = 
   on readline x 
 
+
+let p_is_int_test x = 
+  match x with 
+  | `a -> 2 
+  | `b _ -> 3 
+
+let u = `b 2  
+
+let () = 
+  eq __LOC__ 2 (p_is_int_test `a);
+  eq __LOC__ 3 (p_is_int_test u)
+
 let () = Mt.from_pair_suites __MODULE__ !suites
diff --git a/jscomp/test/poly_variant_test.mli b/jscomp/test/poly_variant_test.mli
@@ -37,3 +37,6 @@ val on2 :
 
 val read : string -> string
 val readN : string -> string
+
+val p_is_int_test 
+  : [`a | `b of int] -> int
diff --git a/lib/4.06.1/unstable/js_compiler.ml b/lib/4.06.1/unstable/js_compiler.ml
@@ -35636,13 +35636,13 @@ val ref_tag_info : tag_info
 type field_dbg_info = 
   | Fld_na
   | Fld_record of {name : string; mutable_flag : Asttypes.mutable_flag}
-  | Fld_module of string     
-  | Fld_record_inline of string 
-  | Fld_record_extension of string 
+  | Fld_module of {name : string}     
+  | Fld_record_inline of {name : string}
+  | Fld_record_extension of {name : string}
   | Fld_tuple
   | Fld_poly_var_tag
   | Fld_poly_var_content
-  
+  | Fld_extension_slot  
 val fld_record :
   (Types.label_description -> 
   field_dbg_info) ref
@@ -36098,13 +36098,13 @@ let ref_tag_info : tag_info = Blk_record [| "contents" |]
 type field_dbg_info = 
   | Fld_na
   | Fld_record of {name : string; mutable_flag : Asttypes.mutable_flag}
-  | Fld_module of string     
-  | Fld_record_inline of string   
-  | Fld_record_extension of string 
+  | Fld_module of {name : string }
+  | Fld_record_inline of { name : string}   
+  | Fld_record_extension of {name : string}
   | Fld_tuple  
   | Fld_poly_var_tag
   | Fld_poly_var_content
-  
+  | Fld_extension_slot 
 let fld_record = ref (fun (lbl : Types.label_description) ->
   Fld_record {name = lbl.lbl_name; mutable_flag = Mutable})
 
@@ -36637,7 +36637,7 @@ let rec transl_normal_path = function
       then Lprim(Pgetglobal id, [], Location.none)
       else Lvar id
   | Pdot(p, s, pos) ->
-      Lprim(Pfield (pos, Fld_module s), [transl_normal_path p], Location.none)
+      Lprim(Pfield (pos, Fld_module {name = s}), [transl_normal_path p], Location.none)
   | Papply _ ->
       fatal_error "Lambda.transl_path"
 
@@ -101029,6 +101029,16 @@ let block_shape ppf shape = match shape with
         t;
       Format.fprintf ppf ")"
 
+
+let str_of_field_info (fld_info : Lambda.field_dbg_info)= 
+  match fld_info with 
+  | (Fld_module {name } | Fld_record {name} | Fld_record_inline {name} | Fld_record_extension {name})
+    -> name
+  | Fld_na  -> "na"
+  | Fld_tuple -> "[]"
+  | Fld_poly_var_tag->"`"
+  | Fld_poly_var_content -> "#"
+  | Fld_extension_slot -> "ext"
 let primitive ppf = function
   | Pidentity -> fprintf ppf "id"
   | Pbytes_to_string -> fprintf ppf "bytes_to_string"
@@ -101043,8 +101053,7 @@ let primitive ppf = function
       fprintf ppf "makeblock %i%a" tag block_shape shape
   | Pmakeblock(tag, _, Mutable, shape) ->
       fprintf ppf "makemutable %i%a" tag block_shape shape
-  | Pfield (n, (Fld_module s | Fld_record {name=s})) -> fprintf ppf "field:%s/%i" s n      
-  | Pfield (n,_) -> fprintf ppf "field %i" n
+  | Pfield (n, fld) -> fprintf ppf "field:%s/%i" (str_of_field_info fld) n      
   | Pfield_computed -> fprintf ppf "field_computed"
   | Psetfield(n, ptr, init, _) ->
       let instr =
@@ -104056,7 +104065,7 @@ let get_mod_field modname field =
       with Not_found ->
         fatal_error ("Primitive "^modname^"."^field^" not found.")
       in
-      Lprim(Pfield (p, Fld_module field),
+      Lprim(Pfield (p, Fld_module {name = field}),
             [Lprim(Pgetglobal mod_ident, [], Location.none)],
             Location.none)
     with Not_found -> fatal_error ("Module "^modname^" unavailable.")
@@ -104227,10 +104236,10 @@ let make_record_matching loc all_labels def = function
             | Record_regular  -> 
               Lprim (Pfield (lbl.lbl_pos, !Lambda.fld_record lbl), [arg], loc) 
             | Record_inlined _ ->
-              Lprim (Pfield (lbl.lbl_pos, Fld_record_inline lbl.lbl_name), [arg], loc)
+              Lprim (Pfield (lbl.lbl_pos, Fld_record_inline {name = lbl.lbl_name}), [arg], loc)
             | Record_unboxed _ -> arg
             | Record_float -> Lprim (Pfloatfield (lbl.lbl_pos, !Lambda.fld_record lbl), [arg], loc)
-            | Record_extension -> Lprim (Pfield (lbl.lbl_pos + 1, Fld_record_extension lbl.lbl_name), [arg], loc) 
+            | Record_extension -> Lprim (Pfield (lbl.lbl_pos + 1, Fld_record_extension {name = lbl.lbl_name}), [arg], loc) 
           in
           let str =
             match lbl.lbl_mut with
@@ -104929,7 +104938,7 @@ let combine_constructor sw_names loc arg ex_pat cstr partial ctx def
                 nonconsts
                 default
             in
-              Llet(Alias, Pgenval,tag, Lprim(Pfield (0, Fld_na), [arg], loc), tests)
+              Llet(Alias, Pgenval,tag, Lprim(Pfield (0, Fld_extension_slot), [arg], loc), tests)
       in
         List.fold_right
           (fun (path, act) rem ->
@@ -105532,9 +105541,9 @@ let partial_function loc () =
     Filename.basename fname
   in   
     
-  Lprim(Praise Raise_regular, [Lprim(Pmakeblock(0, Lambda.Blk_extension, Immutable, None),
+  Lprim(Praise Raise_regular, [Lprim(Pmakeblock(0, Blk_extension, Immutable, None),
           [transl_normal_path Predef.path_match_failure;
-           Lconst(Const_block(0, Lambda.Blk_tuple,
+           Lconst(Const_block(0, Blk_tuple,
               [Const_base(Const_string (fname, None));
                Const_base(Const_int line);
                Const_base(Const_int char)]))], loc)], loc)
@@ -106923,9 +106932,9 @@ let assert_failed exp =
   in   
      
   Lprim(Praise Raise_regular, [event_after exp
-    (Lprim(Pmakeblock(0, Lambda.Blk_extension, Immutable, None),
+    (Lprim(Pmakeblock(0, Blk_extension, Immutable, None),
           [transl_normal_path Predef.path_assert_failure;
-           Lconst(Const_block(0, Lambda.Blk_tuple,
+           Lconst(Const_block(0, Blk_tuple,
               [Const_base(Const_string (fname, None));
                Const_base(Const_int line);
                Const_base(Const_int char)]))], exp.exp_loc))], exp.exp_loc)
@@ -107181,11 +107190,11 @@ and transl_exp0 e =
           Record_regular -> 
           Lprim (Pfield (lbl.lbl_pos, !Lambda.fld_record lbl), [targ], e.exp_loc) 
         | Record_inlined _ ->
-          Lprim (Pfield (lbl.lbl_pos, Fld_record_inline lbl.lbl_name), [targ], e.exp_loc)
+          Lprim (Pfield (lbl.lbl_pos, Fld_record_inline {name = lbl.lbl_name}), [targ], e.exp_loc)
         | Record_unboxed _ -> targ
         | Record_float -> Lprim (Pfloatfield (lbl.lbl_pos, !Lambda.fld_record lbl), [targ], e.exp_loc)
         | Record_extension ->
-          Lprim (Pfield (lbl.lbl_pos + 1, Fld_record_extension lbl.lbl_name), [targ], e.exp_loc) 
+          Lprim (Pfield (lbl.lbl_pos + 1, Fld_record_extension {name = lbl.lbl_name}), [targ], e.exp_loc) 
       end
   | Texp_setfield(arg, _, lbl, newval) ->
       let access =
@@ -107586,9 +107595,9 @@ and transl_record loc env fields repres opt_init_expr =
                let access =
                  match repres with
                    Record_regular ->   Pfield (i, !Lambda.fld_record lbl) 
-                 | Record_inlined _ -> Pfield (i, Fld_record_inline lbl.lbl_name) 
+                 | Record_inlined _ -> Pfield (i, Fld_record_inline {name = lbl.lbl_name}) 
                  | Record_unboxed _ -> assert false
-                 | Record_extension -> Pfield (i + 1, Fld_record_extension lbl.lbl_name) 
+                 | Record_extension -> Pfield (i + 1, Fld_record_extension {name = lbl.lbl_name}) 
                  | Record_float -> Pfloatfield (i, !Lambda.fld_record lbl) in
                Lprim(access, [Lvar init_id], loc), field_kind
            | Overridden (_lid, expr) ->
@@ -108814,9 +108823,9 @@ let rec apply_coercion loc strict restr arg =
       assert (List.length runtime_fields = List.length pos_cc_list);
       let names = Array.of_list runtime_fields in 
       name_lambda strict arg (fun id ->
-        let get_field_i i pos = Lprim(Pfield (pos, Fld_module names.(i)),[Lvar id], loc) in
+        let get_field_i i pos = Lprim(Pfield (pos, Fld_module {name = names.(i)}),[Lvar id], loc) in
         let get_field_name name pos =
-            Lprim (Pfield (pos, Fld_module name), [Lvar id], loc) in 
+            Lprim (Pfield (pos, Fld_module {name}), [Lvar id], loc) in 
         let lam =
           Lprim(Pmakeblock(0, Lambda.Blk_module runtime_fields, Immutable, None),
                 List.mapi (fun i x -> apply_coercion_field loc (get_field_i i) x) pos_cc_list,
@@ -109407,7 +109416,7 @@ and transl_structure loc fields cc rootpath final_env = function
                   rebind_idents (pos + 1) (id :: newfields) ids
                 in
                 Llet(Alias, Pgenval, id,
-                     Lprim(Pfield (pos, Fld_module (Ident.name id)) , [Lvar mid], incl.incl_loc), body),
+                     Lprim(Pfield (pos, Fld_module {name = Ident.name id}) , [Lvar mid], incl.incl_loc), body),
                 size
           in
           let body, size = rebind_idents 0 fields ids in
diff --git a/lib/4.06.1/unstable/js_refmt_compiler.ml b/lib/4.06.1/unstable/js_refmt_compiler.ml
diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml
