Skip to content

Commit bec802d

Browse files
bobzhangbobzhang
committed
tentative fix #3519 
1 parent f514c5e commit bec802d

9 files changed

+145
-28
lines changed

‎jscomp/ounit_tests/ounit_cmd_tests.ml

+10
Original file line numberDiff line numberDiff line change
@@ -48,6 +48,16 @@ let suites =
4848
[@@bs.splice]|}|] in
4949
OUnit.assert_bool __LOC__ (Ext_string.contain_substring v_output.stderr "bs.splice")
5050
end;
51+
__LOC__ >:: begin fun _ ->
52+
let v_output = perform_bsc [|"-bs-eval"; {|external
53+
f2 :
54+
int -> int -> ?y:int array -> unit
55+
= ""
56+
[@@bs.send.pipe:int]
57+
[@@bs.splice] |}|] in
58+
OUnit.assert_bool __LOC__ (Ext_string.contain_substring v_output.stderr "bs.splice")
59+
end;
60+
5161
__LOC__ >:: begin fun _ ->
5262
let should_be_warning =
5363
bsc_check_eval {|let bla4 foo x y= foo##(method1 x y [@bs]) |} in

‎jscomp/syntax/ast_external_process.ml

+19-4
Original file line numberDiff line numberDiff line change
@@ -97,8 +97,8 @@ let spec_of_ptyp
9797
begin match ptyp_desc with
9898
| Ptyp_constr ({txt = Lident "unit"; _}, [])
9999
-> if nolabel then Extern_unit else Nothing
100-
| Ptyp_constr ({txt = Lident "array"; _}, [_])
101-
-> Extern_arg_array
100+
(* | Ptyp_constr ({txt = Lident "array"; _}, [_])
101+
-> Extern_arg_array *)
102102
| Ptyp_variant _ ->
103103
Bs_warnings.prerr_bs_ffi_warning ptyp.ptyp_loc Unsafe_poly_variant_type;
104104
Nothing
@@ -889,6 +889,21 @@ let handle_attributes
889889
(fun param_type (arg_type_specs, arg_types, i) ->
890890
let arg_label = Ast_compatible.convert param_type.label in
891891
let ty = param_type.ty in
892+
if i = 0 && splice then
893+
begin match arg_label with
894+
| Optional _ ->
895+
Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be a non optional"
896+
| Labelled _ | Nolabel
897+
->
898+
if Ast_core_type.is_any ty then
899+
Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be an array";
900+
if spec_of_ptyp true ty <> Nothing then
901+
Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be an array";
902+
match ty.ptyp_desc with
903+
| Ptyp_constr({txt = Lident "array"; _}, [_])
904+
-> ()
905+
| _ -> Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be an array";
906+
end ;
892907
let arg_label, arg_type, new_arg_types =
893908
match arg_label with
894909
| Optional s ->
@@ -918,8 +933,8 @@ let handle_attributes
918933
External_arg_spec.empty_label, arg_type, {param_type with ty = new_ty} :: arg_types
919934
end
920935
in
921-
(if i = 0 && splice && arg_type <> Extern_arg_array then
922-
Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be an array");
936+
(* (if i = 0 && splice && arg_type <> Extern_arg_array then
937+
Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be an array"); *)
923938
({ arg_label ;
924939
arg_type
925940
} :: arg_type_specs,

‎jscomp/test/gpr_3519_test.ml

+11-2
Original file line numberDiff line numberDiff line change
@@ -9,8 +9,17 @@ module Foo :
99
type 'a arra = 'a array
1010

1111
external
12-
f :
12+
f0 :
1313
int -> int -> int array -> unit
1414
= ""
1515
[@@bs.send.pipe:int]
16-
[@@bs.splice]
16+
[@@bs.splice]
17+
18+
external
19+
f1 :
20+
int -> int -> y:int array -> unit
21+
= ""
22+
[@@bs.send.pipe:int]
23+
[@@bs.splice]
24+
25+
(* This should error out*)

‎lib/4.02.3/bsdep.ml

+19-4
Original file line numberDiff line numberDiff line change
@@ -35464,8 +35464,8 @@ let spec_of_ptyp
3546435464
begin match ptyp_desc with
3546535465
| Ptyp_constr ({txt = Lident "unit"; _}, [])
3546635466
-> if nolabel then Extern_unit else Nothing
35467-
| Ptyp_constr ({txt = Lident "array"; _}, [_])
35468-
-> Extern_arg_array
35467+
(* | Ptyp_constr ({txt = Lident "array"; _}, [_])
35468+
-> Extern_arg_array *)
3546935469
| Ptyp_variant _ ->
3547035470
Bs_warnings.prerr_bs_ffi_warning ptyp.ptyp_loc Unsafe_poly_variant_type;
3547135471
Nothing
@@ -36254,6 +36254,21 @@ let handle_attributes
3625436254
(fun param_type (arg_type_specs, arg_types, i) ->
3625536255
let arg_label = Ast_compatible.convert param_type.label in
3625636256
let ty = param_type.ty in
36257+
if i = 0 && splice then
36258+
begin match arg_label with
36259+
| Optional _ ->
36260+
Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be a non optional"
36261+
| Labelled _ | Nolabel
36262+
->
36263+
if Ast_core_type.is_any ty then
36264+
Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be an array";
36265+
if spec_of_ptyp true ty <> Nothing then
36266+
Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be an array";
36267+
match ty.ptyp_desc with
36268+
| Ptyp_constr({txt = Lident "array"; _}, [_])
36269+
-> ()
36270+
| _ -> Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be an array";
36271+
end ;
3625736272
let arg_label, arg_type, new_arg_types =
3625836273
match arg_label with
3625936274
| Optional s ->
@@ -36283,8 +36298,8 @@ let handle_attributes
3628336298
External_arg_spec.empty_label, arg_type, {param_type with ty = new_ty} :: arg_types
3628436299
end
3628536300
in
36286-
(if i = 0 && splice && arg_type <> Extern_arg_array then
36287-
Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be an array");
36301+
(* (if i = 0 && splice && arg_type <> Extern_arg_array then
36302+
Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be an array"); *)
3628836303
({ arg_label ;
3628936304
arg_type
3629036305
} :: arg_type_specs,

‎lib/4.02.3/bsppx.ml

+19-4
Original file line numberDiff line numberDiff line change
@@ -17580,8 +17580,8 @@ let spec_of_ptyp
1758017580
begin match ptyp_desc with
1758117581
| Ptyp_constr ({txt = Lident "unit"; _}, [])
1758217582
-> if nolabel then Extern_unit else Nothing
17583-
| Ptyp_constr ({txt = Lident "array"; _}, [_])
17584-
-> Extern_arg_array
17583+
(* | Ptyp_constr ({txt = Lident "array"; _}, [_])
17584+
-> Extern_arg_array *)
1758517585
| Ptyp_variant _ ->
1758617586
Bs_warnings.prerr_bs_ffi_warning ptyp.ptyp_loc Unsafe_poly_variant_type;
1758717587
Nothing
@@ -18370,6 +18370,21 @@ let handle_attributes
1837018370
(fun param_type (arg_type_specs, arg_types, i) ->
1837118371
let arg_label = Ast_compatible.convert param_type.label in
1837218372
let ty = param_type.ty in
18373+
if i = 0 && splice then
18374+
begin match arg_label with
18375+
| Optional _ ->
18376+
Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be a non optional"
18377+
| Labelled _ | Nolabel
18378+
->
18379+
if Ast_core_type.is_any ty then
18380+
Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be an array";
18381+
if spec_of_ptyp true ty <> Nothing then
18382+
Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be an array";
18383+
match ty.ptyp_desc with
18384+
| Ptyp_constr({txt = Lident "array"; _}, [_])
18385+
-> ()
18386+
| _ -> Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be an array";
18387+
end ;
1837318388
let arg_label, arg_type, new_arg_types =
1837418389
match arg_label with
1837518390
| Optional s ->
@@ -18399,8 +18414,8 @@ let handle_attributes
1839918414
External_arg_spec.empty_label, arg_type, {param_type with ty = new_ty} :: arg_types
1840018415
end
1840118416
in
18402-
(if i = 0 && splice && arg_type <> Extern_arg_array then
18403-
Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be an array");
18417+
(* (if i = 0 && splice && arg_type <> Extern_arg_array then
18418+
Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be an array"); *)
1840418419
({ arg_label ;
1840518420
arg_type
1840618421
} :: arg_type_specs,

‎lib/4.02.3/unstable/all_ounit_tests.ml

+10
Original file line numberDiff line numberDiff line change
@@ -8071,6 +8071,16 @@ let suites =
80718071
[@@bs.splice]|}|] in
80728072
OUnit.assert_bool __LOC__ (Ext_string.contain_substring v_output.stderr "bs.splice")
80738073
end;
8074+
__LOC__ >:: begin fun _ ->
8075+
let v_output = perform_bsc [|"-bs-eval"; {|external
8076+
f2 :
8077+
int -> int -> ?y:int array -> unit
8078+
= ""
8079+
[@@bs.send.pipe:int]
8080+
[@@bs.splice] |}|] in
8081+
OUnit.assert_bool __LOC__ (Ext_string.contain_substring v_output.stderr "bs.splice")
8082+
end;
8083+
80748084
__LOC__ >:: begin fun _ ->
80758085
let should_be_warning =
80768086
bsc_check_eval {|let bla4 foo x y= foo##(method1 x y [@bs]) |} in

‎lib/4.02.3/unstable/js_compiler.ml

+19-5
Original file line numberDiff line numberDiff line change
@@ -17461,8 +17461,8 @@ let spec_of_ptyp
1746117461
begin match ptyp_desc with
1746217462
| Ptyp_constr ({txt = Lident "unit"; _}, [])
1746317463
-> if nolabel then Extern_unit else Nothing
17464-
| Ptyp_constr ({txt = Lident "array"; _}, [_])
17465-
-> Extern_arg_array
17464+
(* | Ptyp_constr ({txt = Lident "array"; _}, [_])
17465+
-> Extern_arg_array *)
1746617466
| Ptyp_variant _ ->
1746717467
Bs_warnings.prerr_bs_ffi_warning ptyp.ptyp_loc Unsafe_poly_variant_type;
1746817468
Nothing
@@ -18251,6 +18251,21 @@ let handle_attributes
1825118251
(fun param_type (arg_type_specs, arg_types, i) ->
1825218252
let arg_label = Ast_compatible.convert param_type.label in
1825318253
let ty = param_type.ty in
18254+
if i = 0 && splice then
18255+
begin match arg_label with
18256+
| Optional _ ->
18257+
Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be a non optional"
18258+
| Labelled _ | Nolabel
18259+
->
18260+
if Ast_core_type.is_any ty then
18261+
Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be an array";
18262+
if spec_of_ptyp true ty <> Nothing then
18263+
Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be an array";
18264+
match ty.ptyp_desc with
18265+
| Ptyp_constr({txt = Lident "array"; _}, [_])
18266+
-> ()
18267+
| _ -> Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be an array";
18268+
end ;
1825418269
let arg_label, arg_type, new_arg_types =
1825518270
match arg_label with
1825618271
| Optional s ->
@@ -18280,8 +18295,8 @@ let handle_attributes
1828018295
External_arg_spec.empty_label, arg_type, {param_type with ty = new_ty} :: arg_types
1828118296
end
1828218297
in
18283-
(if i = 0 && splice && arg_type <> Extern_arg_array then
18284-
Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be an array");
18298+
(* (if i = 0 && splice && arg_type <> Extern_arg_array then
18299+
Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be an array"); *)
1828518300
({ arg_label ;
1828618301
arg_type
1828718302
} :: arg_type_specs,
@@ -104389,7 +104404,6 @@ let assemble_args_has_splice call_loc ffi (arg_types : specs) (args : exprs)
104389104404
let accs, eff = aux labels args in
104390104405
begin match args, (arg : E.t) with
104391104406
| [], {expression_desc = Array (ls,_mutable_flag) ;_ } ->
104392-
assert (arg_kind.arg_type = Extern_arg_array);
104393104407
Ext_list.append ls accs, eff
104394104408
| _ ->
104395104409
if args = [] then dynamic := true ;

‎lib/4.02.3/unstable/native_ppx.ml

+19-4
Original file line numberDiff line numberDiff line change
@@ -16700,8 +16700,8 @@ let spec_of_ptyp
1670016700
begin match ptyp_desc with
1670116701
| Ptyp_constr ({txt = Lident "unit"; _}, [])
1670216702
-> if nolabel then Extern_unit else Nothing
16703-
| Ptyp_constr ({txt = Lident "array"; _}, [_])
16704-
-> Extern_arg_array
16703+
(* | Ptyp_constr ({txt = Lident "array"; _}, [_])
16704+
-> Extern_arg_array *)
1670516705
| Ptyp_variant _ ->
1670616706
Bs_warnings.prerr_bs_ffi_warning ptyp.ptyp_loc Unsafe_poly_variant_type;
1670716707
Nothing
@@ -17490,6 +17490,21 @@ let handle_attributes
1749017490
(fun param_type (arg_type_specs, arg_types, i) ->
1749117491
let arg_label = Ast_compatible.convert param_type.label in
1749217492
let ty = param_type.ty in
17493+
if i = 0 && splice then
17494+
begin match arg_label with
17495+
| Optional _ ->
17496+
Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be a non optional"
17497+
| Labelled _ | Nolabel
17498+
->
17499+
if Ast_core_type.is_any ty then
17500+
Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be an array";
17501+
if spec_of_ptyp true ty <> Nothing then
17502+
Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be an array";
17503+
match ty.ptyp_desc with
17504+
| Ptyp_constr({txt = Lident "array"; _}, [_])
17505+
-> ()
17506+
| _ -> Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be an array";
17507+
end ;
1749317508
let arg_label, arg_type, new_arg_types =
1749417509
match arg_label with
1749517510
| Optional s ->
@@ -17519,8 +17534,8 @@ let handle_attributes
1751917534
External_arg_spec.empty_label, arg_type, {param_type with ty = new_ty} :: arg_types
1752017535
end
1752117536
in
17522-
(if i = 0 && splice && arg_type <> Extern_arg_array then
17523-
Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be an array");
17537+
(* (if i = 0 && splice && arg_type <> Extern_arg_array then
17538+
Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be an array"); *)
1752417539
({ arg_label ;
1752517540
arg_type
1752617541
} :: arg_type_specs,

‎lib/4.02.3/whole_compiler.ml

+19-5
Original file line numberDiff line numberDiff line change
@@ -95015,7 +95015,6 @@ let assemble_args_has_splice call_loc ffi (arg_types : specs) (args : exprs)
9501595015
let accs, eff = aux labels args in
9501695016
begin match args, (arg : E.t) with
9501795017
| [], {expression_desc = Array (ls,_mutable_flag) ;_ } ->
95018-
assert (arg_kind.arg_type = Extern_arg_array);
9501995018
Ext_list.append ls accs, eff
9502095019
| _ ->
9502195020
if args = [] then dynamic := true ;
@@ -105880,8 +105879,8 @@ let spec_of_ptyp
105880105879
begin match ptyp_desc with
105881105880
| Ptyp_constr ({txt = Lident "unit"; _}, [])
105882105881
-> if nolabel then Extern_unit else Nothing
105883-
| Ptyp_constr ({txt = Lident "array"; _}, [_])
105884-
-> Extern_arg_array
105882+
(* | Ptyp_constr ({txt = Lident "array"; _}, [_])
105883+
-> Extern_arg_array *)
105885105884
| Ptyp_variant _ ->
105886105885
Bs_warnings.prerr_bs_ffi_warning ptyp.ptyp_loc Unsafe_poly_variant_type;
105887105886
Nothing
@@ -106670,6 +106669,21 @@ let handle_attributes
106670106669
(fun param_type (arg_type_specs, arg_types, i) ->
106671106670
let arg_label = Ast_compatible.convert param_type.label in
106672106671
let ty = param_type.ty in
106672+
if i = 0 && splice then
106673+
begin match arg_label with
106674+
| Optional _ ->
106675+
Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be a non optional"
106676+
| Labelled _ | Nolabel
106677+
->
106678+
if Ast_core_type.is_any ty then
106679+
Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be an array";
106680+
if spec_of_ptyp true ty <> Nothing then
106681+
Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be an array";
106682+
match ty.ptyp_desc with
106683+
| Ptyp_constr({txt = Lident "array"; _}, [_])
106684+
-> ()
106685+
| _ -> Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be an array";
106686+
end ;
106673106687
let arg_label, arg_type, new_arg_types =
106674106688
match arg_label with
106675106689
| Optional s ->
@@ -106699,8 +106713,8 @@ let handle_attributes
106699106713
External_arg_spec.empty_label, arg_type, {param_type with ty = new_ty} :: arg_types
106700106714
end
106701106715
in
106702-
(if i = 0 && splice && arg_type <> Extern_arg_array then
106703-
Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be an array");
106716+
(* (if i = 0 && splice && arg_type <> Extern_arg_array then
106717+
Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be an array"); *)
106704106718
({ arg_label ;
106705106719
arg_type
106706106720
} :: arg_type_specs,

0 commit comments

Comments
 (0)