Skip to content

Commit dba737f

Browse files
authored
Merge pull request #3998 from BuckleScript/p_is_int_test
add tests for Pisint, fix #3996
2 parents 1279a00 + 817c62f commit dba737f

29 files changed

+352
-253
lines changed

jscomp/core/js_block_runtime.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -32,7 +32,7 @@ let tag_is_zero (tag : J.expression) =
3232
(tag : J.expression)
3333
(tag_info : J.tag_info) =
3434
match tag_info with
35-
| Blk_variant _
35+
| Blk_poly_var _
3636
| Blk_constructor _ -> true
3737
#if OCAML_VERSION =~ ">4.03.0" then
3838
| Blk_record_inlined _ -> true
@@ -52,7 +52,7 @@ let tag_is_zero (tag : J.expression) =
5252

5353
let needBlockRuntime (tag : J.expression) (tag_info : J.tag_info) =
5454
match tag_info with
55-
| Blk_variant _
55+
| Blk_poly_var _
5656
| Blk_module _
5757
| Blk_module_export
5858
| Blk_record _

jscomp/core/js_dump.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -851,7 +851,7 @@ and expression_desc cxt ~(level:int) f x : cxt =
851851
TODO: we still need clean up local module compilation
852852
to make it more obvious
853853
*)
854-
| Blk_variant name ->
854+
| Blk_poly_var name ->
855855
dbg_poly_var f;
856856
P.paren_group f 1 (fun _ -> arguments cxt f [
857857
E.str name;

jscomp/core/js_exp_make.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -205,7 +205,7 @@ let make_block ?comment
205205
| Blk_extension
206206
| Blk_class
207207
| Blk_constructor _
208-
| Blk_variant _
208+
| Blk_poly_var _
209209
| Blk_na _
210210
-> es
211211
in
@@ -296,7 +296,7 @@ let dummy_obj ?comment (info : Lam_tag_info.t) : t =
296296
{comment ; expression_desc = Object ([])}
297297
| Blk_constructor _
298298
| Blk_tuple | Blk_array
299-
| Blk_variant _ | Blk_extension_slot
299+
| Blk_poly_var _ | Blk_extension_slot
300300
| Blk_extension | Blk_na _
301301
| Blk_record_inlined _
302302
| Blk_record_ext _

jscomp/core/js_of_lam_block.ml

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -56,12 +56,13 @@ let field (field_info : Lam_compat.field_dbg_info) e i =
5656
| Fld_poly_var_content
5757
| Fld_record_inline _
5858
| Fld_record_extension _
59+
| Fld_extension_slot
5960
->
6061
E.array_index_by_int
6162
?comment:(Lam_compat.str_of_field_info field_info) e i
6263
| Fld_record {name}
6364
-> E.record_access e name i
64-
| Fld_module name
65+
| Fld_module {name}
6566
-> E.module_access e name i
6667
let field_by_exp e i =
6768
E.array_index e i

jscomp/core/lam.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -652,15 +652,15 @@ let prim ~primitive:(prim : Lam_primitive.t) ~args loc : t =
652652
let rec aux fields args (var : Ident.t) i =
653653
match fields, args with
654654
| [], [] -> true
655-
| f :: fields, Lprim {primitive = Pfield (pos, Fld_module f1); args = [Lglobal_module v1 | Lvar v1]} :: args
655+
| f :: fields, Lprim {primitive = Pfield (pos, Fld_module {name = f1}); args = [Lglobal_module v1 | Lvar v1]} :: args
656656
->
657657
pos = i &&
658658
f = f1 &&
659659
Ident.same var v1 && aux fields args var (i + 1)
660660
| _, _ -> false in
661661
begin match fields, args with
662662
| field1 :: rest,
663-
Lprim{primitive = Pfield (pos, Fld_module f1); args = [Lglobal_module v1 | Lvar v1 as lam]} :: args1
663+
Lprim{primitive = Pfield (pos, Fld_module {name = f1}); args = [Lglobal_module v1 | Lvar v1 as lam]} :: args1
664664
->
665665
if pos = 0 && field1 = f1 && aux rest args1 v1 1 then
666666
lam

jscomp/core/lam_arity_analysis.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -44,14 +44,14 @@ let rec get_arity (meta : Lam_stats.t) (lam : Lam.t) : Lam_arity.t =
4444
| Lvar v -> arity_of_var meta v
4545
| Lconst _ -> Lam_arity.non_function_arity_info
4646
| Llet(_,_,_, l ) -> get_arity meta l
47-
| Lprim {primitive = Pfield (_, Fld_module fld_name);
47+
| Lprim {primitive = Pfield (_, Fld_module {name = fld_name});
4848
args = [ Lglobal_module id ]; _} ->
4949
begin match (Lam_compile_env.query_external_id_info id fld_name).arity with
5050
| Single x -> x
5151
| Submodule _ -> Lam_arity.na
5252
end
5353
| Lprim {primitive = Pfield (m,_);
54-
args = [ Lprim{primitive = Pfield(n,Fld_module fld_name);
54+
args = [ Lprim{primitive = Pfield(n,Fld_module {name = fld_name});
5555
args = [ Lglobal_module id]} ]
5656
; _} ->
5757
begin match (Lam_compile_env.query_external_id_info id fld_name ).arity with

jscomp/core/lam_compat.ml

Lines changed: 12 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -184,29 +184,30 @@ type meth_kind = Lambda.meth_kind
184184

185185
type field_dbg_info = Lambda.field_dbg_info =
186186
| Fld_na
187-
| Fld_record of {name : string; mutable_flag : Asttypes.mutable_flag}
188-
| Fld_module of string
187+
| Fld_record of { name : string; mutable_flag : Asttypes.mutable_flag}
188+
| Fld_module of { name : string }
189189
#if OCAML_VERSION =~ ">4.03.0" then
190-
| Fld_record_inline of string
191-
| Fld_record_extension of string
190+
| Fld_record_inline of { name : string}
191+
| Fld_record_extension of {name : string }
192192
#end
193193
| Fld_tuple
194194
| Fld_poly_var_tag
195195
| Fld_poly_var_content
196-
196+
| Fld_extension_slot
197197

198198
let str_of_field_info (x : field_dbg_info) : string option =
199199
match x with
200200
| Fld_na
201201
| Fld_poly_var_tag
202202
| Fld_poly_var_content
203-
| Fld_tuple -> None
204-
| Fld_record {name = s}
205-
| Fld_module s
206-
| Fld_record_inline s
207-
| Fld_record_extension s
203+
| Fld_tuple
204+
| Fld_extension_slot -> None
205+
| Fld_record {name }
206+
| Fld_module {name}
207+
| Fld_record_inline {name}
208+
| Fld_record_extension {name}
208209
->
209-
Some s
210+
Some name
210211

211212
type set_field_dbg_info = Lambda.set_field_dbg_info =
212213
| Fld_set_na

jscomp/core/lam_compat.mli

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -86,15 +86,15 @@ type meth_kind = Lambda.meth_kind
8686
type field_dbg_info = Lambda.field_dbg_info =
8787
| Fld_na
8888
| Fld_record of {name : string; mutable_flag : Asttypes.mutable_flag}
89-
| Fld_module of string
89+
| Fld_module of {name : string }
9090
#if OCAML_VERSION =~ ">4.03.0" then
91-
| Fld_record_inline of string
92-
| Fld_record_extension of string
91+
| Fld_record_inline of {name : string}
92+
| Fld_record_extension of {name : string}
9393
#end
9494
| Fld_tuple
9595
| Fld_poly_var_tag
9696
| Fld_poly_var_content
97-
97+
| Fld_extension_slot
9898

9999
val str_of_field_info :
100100
field_dbg_info ->

jscomp/core/lam_compile.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1338,7 +1338,7 @@ and compile_apply
13381338
this information, we should fix [get_exp_with_args]
13391339
*)
13401340
begin match fld_info with
1341-
| Fld_module fld_name ->
1341+
| Fld_module {name = fld_name} ->
13421342
compile_external_field_apply args id fld_name lambda_cxt
13431343
| _ -> assert false
13441344
end
@@ -1407,7 +1407,7 @@ and compile_prim (prim_info : Lam.prim_info) (lambda_cxt : Lam_compile_context.t
14071407
| {primitive = Pfield (_, fld_info); args = [ Lglobal_module id ]; _}
14081408
-> (* should be before Lglobal_global *)
14091409
begin match fld_info with
1410-
| Fld_module field ->
1410+
| Fld_module {name = field} ->
14111411
compile_external_field lambda_cxt id field
14121412
| _ -> assert false
14131413
end

jscomp/core/lam_compile_util.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -45,7 +45,7 @@ let comment_of_tag_info (x : Lam_tag_info.t) =
4545
| Blk_constructor (n, _) -> Some n
4646
| Blk_tuple -> Some "tuple"
4747
| Blk_class -> Some "class"
48-
| Blk_variant x -> Some ("`" ^ x)
48+
| Blk_poly_var x -> Some ("`" ^ x)
4949
| Blk_record _ -> None
5050
#if OCAML_VERSION =~ ">4.03.0" then
5151
| Blk_record_inlined (_,ctor,_) -> Some ctor

jscomp/core/lam_constant_convert.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -68,8 +68,8 @@ let rec convert_constant ( const : Lambda.structured_constant) : Lam_constant.t
6868
| Blk_array ->
6969
let t : Lam_tag_info.t = Blk_array in
7070
Const_block (i,t, Ext_list.map xs convert_constant )
71-
| Blk_variant s ->
72-
let t : Lam_tag_info.t = Blk_variant s in
71+
| Blk_poly_var s ->
72+
let t : Lam_tag_info.t = Blk_poly_var s in
7373
Const_block (i,t, Ext_list.map xs convert_constant )
7474
| Blk_record s ->
7575
let t : Lam_tag_info.t = Blk_record s in

jscomp/core/lam_convert.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -234,8 +234,8 @@ let lam_prim ~primitive:( p : Lambda.primitive) ~args loc : Lam.t =
234234
| Blk_array ->
235235
let info : Lam_tag_info.t = Blk_array in
236236
prim ~primitive:(Pmakeblock (tag,info,mutable_flag)) ~args loc
237-
| Blk_variant s ->
238-
let info : Lam_tag_info.t = Blk_variant s in
237+
| Blk_poly_var s ->
238+
let info : Lam_tag_info.t = Blk_poly_var s in
239239
prim ~primitive:(Pmakeblock (tag,info,mutable_flag)) ~args loc
240240
| Blk_record s ->
241241
let info : Lam_tag_info.t = Blk_record s in

jscomp/core/lam_pass_remove_alias.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -115,7 +115,7 @@ let simplify_alias
115115
return [0, $$let[5],... $$let[16]]}
116116
*)
117117
| Lapply{fn =
118-
Lprim {primitive = Pfield (index, Fld_module fld_name) ;
118+
Lprim {primitive = Pfield (index, Fld_module {name = fld_name}) ;
119119
args = [ Lglobal_module ident ];
120120
_} as l1;
121121
args; loc ; status} ->

jscomp/core/lam_print.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -438,7 +438,7 @@ let lambda ppf v =
438438
"@[<2>(let@ (@[<hv 1>%a@]" bindings (List.rev args);
439439
fprintf ppf ")@ %a)@]" lam body
440440
| Lprim {
441-
primitive = Pfield (n,Fld_module s);
441+
primitive = Pfield (n,Fld_module {name = s});
442442
args = [ Lglobal_module id ]
443443
; _} ->
444444
fprintf ppf "%s.%s/%d" id.name s n

jscomp/core/lam_tag_info.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -31,7 +31,7 @@ type t =
3131
| Blk_constructor of string * int
3232
| Blk_tuple
3333
| Blk_array
34-
| Blk_variant of string
34+
| Blk_poly_var of string
3535
| Blk_record of string array
3636
| Blk_module of string list
3737
| Blk_extension_slot

jscomp/core/record_attributes_check.ml

Lines changed: 7 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -73,14 +73,17 @@ let rec check_duplicated_labels_aux
7373
| {pld_name= ({txt} as pld_name); pld_attributes}::rest ->
7474
if String_set.mem coll txt then Some pld_name
7575
else
76-
let coll = String_set.add coll txt in
76+
let coll_with_lbl = String_set.add coll txt in
7777
match Ext_list.find_opt pld_attributes find_name_with_loc with
78-
| None -> check_duplicated_labels_aux rest coll
78+
| None -> check_duplicated_labels_aux rest coll_with_lbl
7979
| Some ({txt = s;} as l) ->
80-
if String_set.mem coll s then
80+
if String_set.mem coll s
81+
(*use coll to make check a bit looser
82+
allow cases like [ x : int [@bs.as "x"]]
83+
*) then
8184
Some l
8285
else
83-
check_duplicated_labels_aux rest (String_set.add coll s)
86+
check_duplicated_labels_aux rest (String_set.add coll_with_lbl s)
8487

8588
let check_duplicated_labels lbls =
8689
check_duplicated_labels_aux lbls String_set.empty

jscomp/test/exception_rebind_test.js

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -13,9 +13,12 @@ var B = {
1313
F: E
1414
};
1515

16+
var A0 = Caml_exceptions.create("Exception_rebind_test.A0");
17+
1618
var H = Exception_def.A;
1719

1820
exports.A = A;
1921
exports.B = B;
2022
exports.H = H;
23+
exports.A0 = A0;
2124
/* Exception_def Not a pure module */

jscomp/test/exception_rebind_test.ml

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -9,3 +9,11 @@ module B = struct
99
end
1010

1111
exception H = Exception_def.A
12+
13+
14+
type u = exn
15+
16+
type exn += A0 of int
17+
#if 0 then
18+
type u += A1 of int (*Type definition u is not extensible*)
19+
#end

jscomp/test/poly_variant_test.js

Lines changed: 16 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -120,6 +120,21 @@ function test(readline, x) {
120120
return /* () */0;
121121
}
122122

123+
function p_is_int_test(x) {
124+
if (typeof x === "number") {
125+
return 2;
126+
} else {
127+
return 3;
128+
}
129+
}
130+
131+
eq("File \"poly_variant_test.ml\", line 142, characters 5-12", 2, 2);
132+
133+
eq("File \"poly_variant_test.ml\", line 143, characters 5-12", 3, p_is_int_test(/* `b */[
134+
98,
135+
2
136+
]));
137+
123138
Mt.from_pair_suites("Poly_variant_test", suites.contents);
124139

125140
function on2(prim, prim$1) {
@@ -144,4 +159,5 @@ exports.test = test;
144159
exports.on2 = on2;
145160
exports.read = read;
146161
exports.readN = readN;
162+
exports.p_is_int_test = p_is_int_test;
147163
/* Not a pure module */

jscomp/test/poly_variant_test.ml

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -130,4 +130,16 @@ let register readline =
130130
let test readline x =
131131
on readline x
132132

133+
134+
let p_is_int_test x =
135+
match x with
136+
| `a -> 2
137+
| `b _ -> 3
138+
139+
let u = `b 2
140+
141+
let () =
142+
eq __LOC__ 2 (p_is_int_test `a);
143+
eq __LOC__ 3 (p_is_int_test u)
144+
133145
let () = Mt.from_pair_suites __MODULE__ !suites

jscomp/test/poly_variant_test.mli

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -37,3 +37,6 @@ val on2 :
3737

3838
val read : string -> string
3939
val readN : string -> string
40+
41+
val p_is_int_test
42+
: [`a | `b of int] -> int

jscomp/test/record_name_test.ml

Lines changed: 9 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -64,7 +64,8 @@ and obj = {
6464

6565
let f4 ({ x; y; z = {hi }}: entry) =
6666
(x + y + hi) * 2
67-
67+
68+
6869
#if 0 then
6970
type t5 = {
7071
x : int ;
@@ -73,4 +74,10 @@ type t5 = {
7374
}
7475

7576
let v5 = {x = 3 ; y = 2}
76-
#end
77+
#end
78+
79+
type t6 = {
80+
x : int [@bs.as "x"];
81+
y : int [@bs.as "y"]
82+
}
83+
(* allow this case *)

lib/4.06.1/bsdep.ml

Lines changed: 8 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -28010,14 +28010,17 @@ let rec check_duplicated_labels_aux
2801028010
| {pld_name= ({txt} as pld_name); pld_attributes}::rest ->
2801128011
if String_set.mem coll txt then Some pld_name
2801228012
else
28013-
let coll = String_set.add coll txt in
28013+
let coll_with_lbl = String_set.add coll txt in
2801428014
match Ext_list.find_opt pld_attributes find_name_with_loc with
28015-
| None -> check_duplicated_labels_aux rest coll
28015+
| None -> check_duplicated_labels_aux rest coll_with_lbl
2801628016
| Some ({txt = s;} as l) ->
28017-
if String_set.mem coll s then
28017+
if String_set.mem coll s
28018+
(*use coll to make check a bit looser
28019+
allow cases like [ x : int [@bs.as "x"]]
28020+
*) then
2801828021
Some l
2801928022
else
28020-
check_duplicated_labels_aux rest (String_set.add coll s)
28023+
check_duplicated_labels_aux rest (String_set.add coll_with_lbl s)
2802128024

2802228025
let check_duplicated_labels lbls =
2802328026
check_duplicated_labels_aux lbls String_set.empty
@@ -40831,7 +40834,7 @@ type t =
4083140834
| Blk_constructor of string * int
4083240835
| Blk_tuple
4083340836
| Blk_array
40834-
| Blk_variant of string
40837+
| Blk_poly_var of string
4083540838
| Blk_record of string array
4083640839
| Blk_module of string list
4083740840
| Blk_extension_slot

lib/4.06.1/bsppx.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -19116,7 +19116,7 @@ type t =
1911619116
| Blk_constructor of string * int
1911719117
| Blk_tuple
1911819118
| Blk_array
19119-
| Blk_variant of string
19119+
| Blk_poly_var of string
1912019120
| Blk_record of string array
1912119121
| Blk_module of string list
1912219122
| Blk_extension_slot

0 commit comments

Comments
 (0)