fix #3519

jscomp/core/lam_compile_external_call.ml

@@ -92,7 +92,7 @@ let append_list  x xs =
 *)
 let ocaml_to_js_eff 
     ({arg_label;  arg_type }:  External_arg_spec.t)
-    (raw_arg : J.expression)
+    (raw_arg : E.t)
   : arg_expression * E.t list  =
   let arg =
     match arg_label with
@@ -146,7 +146,7 @@ let ocaml_to_js_eff
         Js_of_lam_variant.eval_as_unwrap raw_arg
     in
     Splice1 single_arg,[]
-  | Nothing  | Array ->  Splice1 arg, []
+  | Nothing  ->  Splice1 arg, []
 
 
 
@@ -211,7 +211,6 @@ let assemble_args_has_splice call_loc ffi (arg_types : specs) (args : exprs)
       let accs, eff = aux labels args in 
       begin match args, (arg : E.t) with 
         | [], {expression_desc = Array (ls,_mutable_flag) ;_ } -> 
-          assert (arg_kind.arg_type = Array);
           Ext_list.append ls accs, eff 
         | _ -> 
           if args = [] then dynamic := true ; 

jscomp/ounit_tests/ounit_cmd_tests.ml

@@ -38,6 +38,26 @@ let suites =
         perform_bsc  [| "-bs-eval"; {|let str = "'a'" |}|] in
       OUnit.assert_bool __LOC__ (v_output.exit_code = 0)
     end;
+    __LOC__ >:: begin fun _ -> 
+    let v_output = perform_bsc [|"-bs-eval"; {|type 'a arra = 'a array
+    external
+      f : 
+      int -> int -> int arra -> unit
+      = ""
+      [@@bs.send.pipe:int]
+      [@@bs.splice]|}|] in  
+      OUnit.assert_bool __LOC__ (Ext_string.contain_substring v_output.stderr "bs.splice")
+    end;
+        __LOC__ >:: begin fun _ -> 
+    let v_output = perform_bsc [|"-bs-eval"; {|external
+  f2 : 
+  int -> int -> ?y:int array -> unit  
+  = ""
+  [@@bs.send.pipe:int]
+  [@@bs.splice]  |}|] in  
+      OUnit.assert_bool __LOC__ (Ext_string.contain_substring v_output.stderr "bs.splice")
+    end;
+
     __LOC__ >:: begin fun _ ->
       let should_be_warning =
         bsc_check_eval  {|let bla4 foo x y= foo##(method1 x y [@bs]) |} in

jscomp/syntax/ast_external_process.ml

@@ -49,7 +49,11 @@ let variant_can_bs_unwrap_fields (row_fields : Parsetree.row_field list) : bool
   | `No_fields
   | `Invalid_field -> false
 
-let spec_of_ptyp nolabel (ptyp : Parsetree.core_type) = 
+(*
+  TODO: [nolabel] is only used once turn Nothing into Unit, refactor later
+*)
+let spec_of_ptyp 
+    (nolabel : bool) (ptyp : Parsetree.core_type) : External_arg_spec.attr = 
   let ptyp_desc = ptyp.ptyp_desc in
   match Ast_attributes.iter_process_bs_string_int_unwrap_uncurry ptyp.ptyp_attributes with
   | `String ->
@@ -96,8 +100,6 @@ let spec_of_ptyp nolabel (ptyp : Parsetree.core_type) =
     begin match ptyp_desc with
       | Ptyp_constr ({txt = Lident "unit"; _}, [])
         -> if nolabel then Extern_unit else  Nothing
-      | Ptyp_constr ({txt = Lident "array"; _}, [_])
-        -> Array
       | Ptyp_variant _ ->
         Bs_warnings.prerr_bs_ffi_warning ptyp.ptyp_loc Unsafe_poly_variant_type;
         Nothing
@@ -151,11 +153,11 @@ let get_opt_arg_type
     (ptyp_arg : Ast_core_type.t) :
   External_arg_spec.attr  =
   let ptyp = get_basic_type_from_option_label ptyp_arg in 
-  (if Ast_core_type.is_any ptyp then (* (_[@bs.as ])*)
-     (* extenral f : ?x:_ -> y:int -> _ = "" [@@bs.obj] is not allowed *)
-     Bs_syntaxerr.err ptyp.ptyp_loc Invalid_underscore_type_in_external
-   else (* ([`a|`b] [@bs.string]) *)    
-     spec_of_ptyp nolabel ptyp)
+  if Ast_core_type.is_any ptyp then (* (_[@bs.as ])*)
+    (* extenral f : ?x:_ -> y:int -> _ = "" [@@bs.obj] is not allowed *)
+    Bs_syntaxerr.err ptyp.ptyp_loc Invalid_underscore_type_in_external;
+  (* ([`a|`b] [@bs.string]) *)    
+  spec_of_ptyp nolabel ptyp
 
 
 
@@ -436,7 +438,7 @@ let process_obj
                     arg_type },
                    arg_types, (* ignored in [arg_types], reserved in [result_types] *)
                    ((name , [], new_ty) :: result_types)
-                 | Nothing | Array ->
+                 | Nothing  ->
                    let s = (Lam_methname.translate ~loc name) in
                    {arg_label = External_arg_spec.label s None ; arg_type },
                    {param_type with ty = new_ty}::arg_types,
@@ -469,7 +471,7 @@ let process_obj
                  | Ignore ->
                    External_arg_spec.empty_kind arg_type,
                    param_type::arg_types, result_types
-                 | Nothing | Array ->
+                 | Nothing ->
                    let s = (Lam_methname.translate ~loc name) in
                    {arg_label = External_arg_spec.optional s; arg_type},
                    param_type :: arg_types,
@@ -867,24 +869,42 @@ let handle_attributes
   else
     let splice = external_desc.splice in
     let arg_type_specs, new_arg_types_ty, arg_type_specs_length   =
-      Ext_list.fold_right arg_types_ty (match external_desc with
-          | {val_send_pipe = Some obj; _ } ->
-            let new_ty, arg_type = refine_arg_type ~nolabel:true obj in
-            (match arg_type with
-             | Arg_cst _ ->
-               Location.raise_errorf ~loc:obj.ptyp_loc "[@bs.as] is not supported in bs.send type "
-             | _ ->
-               (* more error checking *)
-               [External_arg_spec.empty_kind arg_type],
-               [({label = Ast_compatible.no_label;
+      let init : External_arg_spec.t list * Ast_compatible.param_type list * int  = 
+        match external_desc.val_send_pipe with
+        | Some obj ->
+          let new_ty, arg_type = refine_arg_type ~nolabel:true obj in
+          begin match arg_type with
+            | Arg_cst _ ->
+              Location.raise_errorf ~loc:obj.ptyp_loc "[@bs.as] is not supported in bs.send type "
+            | _ ->
+              (* more error checking *)
+              [External_arg_spec.empty_kind arg_type],
+              [{label = Ast_compatible.no_label;
                 ty = new_ty;
                 attr =  [];
-                loc = obj.ptyp_loc} : Ast_compatible.param_type)],
-                1)           
-          | {val_send_pipe = None ; _ } -> [],[], 0)
+                loc = obj.ptyp_loc} ],
+              0           
+          end
+        | None -> [],[], 0 in 
+      Ext_list.fold_right arg_types_ty init
         (fun  param_type (arg_type_specs, arg_types, i) ->
            let arg_label = Ast_compatible.convert param_type.label in
            let ty = param_type.ty in 
+           if i = 0 && splice  then
+             begin match arg_label with 
+               | Optional _ -> 
+                 Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be a non optional"
+               | Labelled _ | Nolabel 
+                -> 
+                if Ast_core_type.is_any ty then 
+                  Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be an array";                  
+                if spec_of_ptyp true ty <> Nothing then 
+                  Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be an array";
+                match ty.ptyp_desc with 
+                | Ptyp_constr({txt = Lident "array"; _}, [_])
+                  -> ()
+                | _ -> Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be an array";
+             end ; 
            let arg_label, arg_type, new_arg_types =
              match arg_label with
              | Optional s  ->
@@ -914,11 +934,7 @@ let handle_attributes
                    External_arg_spec.empty_label, arg_type, {param_type with ty = new_ty} :: arg_types
                end
            in
-           (if i = 0 && splice  then
-              match arg_type with
-              | Array  -> ()
-              | _ ->  Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be an array");
-           ({ External_arg_spec.arg_label  ;
+           ({ arg_label  ;
               arg_type
             } :: arg_type_specs,
             new_arg_types,

jscomp/syntax/external_arg_spec.ml

@@ -45,7 +45,6 @@ type attr =
   | Arg_cst of cst
   | Fn_uncurry_arity of int (* annotated with [@bs.uncurry ] or [@bs.uncurry 2]*)
     (* maybe we can improve it as a combination of {!Asttypes.constant} and tuple *)
-  | Array 
   | Extern_unit
   | Nothing
   | Ignore

jscomp/syntax/external_arg_spec.mli

@@ -44,7 +44,6 @@ type attr =
   | Arg_cst of cst
   | Fn_uncurry_arity of int (* annotated with [@bs.uncurry ] or [@bs.uncurry 2]*)
   (* maybe we can improve it as a combination of {!Asttypes.constant} and tuple *)
-  | Array 
   | Extern_unit
   | Nothing
   | Ignore

jscomp/test/build.ninja

@@ -275,6 +275,7 @@ build test/gpr_3154_test.cmi test/gpr_3154_test.cmj : cc test/gpr_3154_test.ml |
 build test/gpr_3209_test.cmi test/gpr_3209_test.cmj : cc test/gpr_3209_test.ml | $stdlib
 build test/gpr_3492_test.cmi test/gpr_3492_test.cmj : cc test/gpr_3492_test.ml | test/mt.cmj $stdlib
 build test/gpr_3502_test.cmi test/gpr_3502_test.cmj : cc test/gpr_3502_test.ml | $stdlib
+build test/gpr_3519_test.cmi test/gpr_3519_test.cmj : cc test/gpr_3519_test.ml | $stdlib
 build test/gpr_3536_test.cmi test/gpr_3536_test.cmj : cc test/gpr_3536_test.ml | test/mt.cmj $stdlib
 build test/gpr_373_test.cmi test/gpr_373_test.cmj : cc test/gpr_373_test.ml | $stdlib
 build test/gpr_405_test.cmj : cc test/gpr_405_test.ml | test/gpr_405_test.cmi $stdlib

jscomp/test/gpr_3519_test.js

@@ -0,0 +1,7 @@
+'use strict';
+
+
+var Foo = /* module */[];
+
+exports.Foo = Foo;
+/* No side effect */

jscomp/test/gpr_3519_test.ml

@@ -0,0 +1,25 @@
+
+module Foo :
+  sig
+    external makeProps : ?bar:string array -> string = ""[@@bs.obj ]
+  end =
+  struct external makeProps : ?bar:'bar -> string = ""[@@bs.obj ] end 
+
+
+type 'a arra = 'a array
+
+external
+  f0 : 
+  int -> int -> int array -> unit
+  = ""
+  [@@bs.send.pipe:int]
+  [@@bs.splice]
+
+external
+  f1 : 
+  int -> int -> y:int array -> unit
+  = ""
+  [@@bs.send.pipe:int]
+  [@@bs.splice]  
+
+

lib/4.02.3/bsdep.ml

@@ -33344,7 +33344,6 @@ type attr =
   | Arg_cst of cst
   | Fn_uncurry_arity of int (* annotated with [@bs.uncurry ] or [@bs.uncurry 2]*)
   (* maybe we can improve it as a combination of {!Asttypes.constant} and tuple *)
-  | Array 
   | Extern_unit
   | Nothing
   | Ignore
@@ -33415,7 +33414,6 @@ type attr =
   | Arg_cst of cst
   | Fn_uncurry_arity of int (* annotated with [@bs.uncurry ] or [@bs.uncurry 2]*)
     (* maybe we can improve it as a combination of {!Asttypes.constant} and tuple *)
-  | Array 
   | Extern_unit
   | Nothing
   | Ignore
@@ -35416,7 +35414,11 @@ let variant_can_bs_unwrap_fields (row_fields : Parsetree.row_field list) : bool
   | `No_fields
   | `Invalid_field -> false
 
-let spec_of_ptyp nolabel (ptyp : Parsetree.core_type) = 
+(*
+  TODO: [nolabel] is only used once turn Nothing into Unit, refactor later
+*)
+let spec_of_ptyp 
+    (nolabel : bool) (ptyp : Parsetree.core_type) : External_arg_spec.attr = 
   let ptyp_desc = ptyp.ptyp_desc in
   match Ast_attributes.iter_process_bs_string_int_unwrap_uncurry ptyp.ptyp_attributes with
   | `String ->
@@ -35463,8 +35465,6 @@ let spec_of_ptyp nolabel (ptyp : Parsetree.core_type) =
     begin match ptyp_desc with
       | Ptyp_constr ({txt = Lident "unit"; _}, [])
         -> if nolabel then Extern_unit else  Nothing
-      | Ptyp_constr ({txt = Lident "array"; _}, [_])
-        -> Array
       | Ptyp_variant _ ->
         Bs_warnings.prerr_bs_ffi_warning ptyp.ptyp_loc Unsafe_poly_variant_type;
         Nothing
@@ -35516,11 +35516,11 @@ let get_opt_arg_type
     (ptyp_arg : Ast_core_type.t) :
   External_arg_spec.attr  =
   let ptyp = get_basic_type_from_option_label ptyp_arg in 
-  (if Ast_core_type.is_any ptyp then (* (_[@bs.as ])*)
-     (* extenral f : ?x:_ -> y:int -> _ = "" [@@bs.obj] is not allowed *)
-     Bs_syntaxerr.err ptyp.ptyp_loc Invalid_underscore_type_in_external
-   else (* ([`a|`b] [@bs.string]) *)    
-     spec_of_ptyp nolabel ptyp)
+  if Ast_core_type.is_any ptyp then (* (_[@bs.as ])*)
+    (* extenral f : ?x:_ -> y:int -> _ = "" [@@bs.obj] is not allowed *)
+    Bs_syntaxerr.err ptyp.ptyp_loc Invalid_underscore_type_in_external;
+  (* ([`a|`b] [@bs.string]) *)    
+  spec_of_ptyp nolabel ptyp
 
 
 
@@ -35801,7 +35801,7 @@ let process_obj
                     arg_type },
                    arg_types, (* ignored in [arg_types], reserved in [result_types] *)
                    ((name , [], new_ty) :: result_types)
-                 | Nothing | Array ->
+                 | Nothing  ->
                    let s = (Lam_methname.translate ~loc name) in
                    {arg_label = External_arg_spec.label s None ; arg_type },
                    {param_type with ty = new_ty}::arg_types,
@@ -35834,7 +35834,7 @@ let process_obj
                  | Ignore ->
                    External_arg_spec.empty_kind arg_type,
                    param_type::arg_types, result_types
-                 | Nothing | Array ->
+                 | Nothing ->
                    let s = (Lam_methname.translate ~loc name) in
                    {arg_label = External_arg_spec.optional s; arg_type},
                    param_type :: arg_types,
@@ -36232,24 +36232,42 @@ let handle_attributes
   else
     let splice = external_desc.splice in
     let arg_type_specs, new_arg_types_ty, arg_type_specs_length   =
-      Ext_list.fold_right arg_types_ty (match external_desc with
-          | {val_send_pipe = Some obj; _ } ->
-            let new_ty, arg_type = refine_arg_type ~nolabel:true obj in
-            (match arg_type with
-             | Arg_cst _ ->
-               Location.raise_errorf ~loc:obj.ptyp_loc "[@bs.as] is not supported in bs.send type "
-             | _ ->
-               (* more error checking *)
-               [External_arg_spec.empty_kind arg_type],
-               [({label = Ast_compatible.no_label;
+      let init : External_arg_spec.t list * Ast_compatible.param_type list * int  = 
+        match external_desc.val_send_pipe with
+        | Some obj ->
+          let new_ty, arg_type = refine_arg_type ~nolabel:true obj in
+          begin match arg_type with
+            | Arg_cst _ ->
+              Location.raise_errorf ~loc:obj.ptyp_loc "[@bs.as] is not supported in bs.send type "
+            | _ ->
+              (* more error checking *)
+              [External_arg_spec.empty_kind arg_type],
+              [{label = Ast_compatible.no_label;
                 ty = new_ty;
                 attr =  [];
-                loc = obj.ptyp_loc} : Ast_compatible.param_type)],
-                1)           
-          | {val_send_pipe = None ; _ } -> [],[], 0)
+                loc = obj.ptyp_loc} ],
+              0           
+          end
+        | None -> [],[], 0 in 
+      Ext_list.fold_right arg_types_ty init
         (fun  param_type (arg_type_specs, arg_types, i) ->
            let arg_label = Ast_compatible.convert param_type.label in
            let ty = param_type.ty in 
+           if i = 0 && splice  then
+             begin match arg_label with 
+               | Optional _ -> 
+                 Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be a non optional"
+               | Labelled _ | Nolabel 
+                -> 
+                if Ast_core_type.is_any ty then 
+                  Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be an array";                  
+                if spec_of_ptyp true ty <> Nothing then 
+                  Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be an array";
+                match ty.ptyp_desc with 
+                | Ptyp_constr({txt = Lident "array"; _}, [_])
+                  -> ()
+                | _ -> Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be an array";
+             end ; 
            let arg_label, arg_type, new_arg_types =
              match arg_label with
              | Optional s  ->
@@ -36279,11 +36297,7 @@ let handle_attributes
                    External_arg_spec.empty_label, arg_type, {param_type with ty = new_ty} :: arg_types
                end
            in
-           (if i = 0 && splice  then
-              match arg_type with
-              | Array  -> ()
-              | _ ->  Location.raise_errorf ~loc "[@@@@bs.splice] expect the last type to be an array");
-           ({ External_arg_spec.arg_label  ;
+           ({ arg_label  ;
               arg_type
             } :: arg_type_specs,
             new_arg_types,