Merge pull request #3148 from BuckleScript/fix_3142

[part2] fix #3142 (with unitests)

Author: bobzhang

jscomp/all.depend

@@ -172,11 +172,12 @@ common/bs_warnings.cmi :
 common/lam_methname.cmi :
 common/ml_binary.cmi :
 syntax/bs_syntaxerr.cmx : syntax/bs_syntaxerr.cmi
-syntax/ast_compatible.cmx : ext/ext_list.cmx syntax/ast_compatible.cmi
+syntax/ast_compatible.cmx : ext/ext_pervasives.cmx ext/ext_list.cmx \
+    syntax/ast_compatible.cmi
 syntax/ast_utf8_string.cmx : ext/ext_utf8.cmx ext/ext_char.cmx \
     syntax/ast_utf8_string.cmi
-syntax/ast_utf8_string_interp.cmx : ext/literals.cmx ext/ext_utf8.cmx \
-    ext/ext_string.cmx ext/ext_char.cmx common/bs_loc.cmx \
+syntax/ast_utf8_string_interp.cmx : ext/ext_utf8.cmx ext/ext_string.cmx \
+    ext/ext_char.cmx common/bs_loc.cmx syntax/ast_utf8_string.cmx \
     syntax/ast_compatible.cmx syntax/ast_utf8_string_interp.cmi
 syntax/ast_derive_constructor.cmx :
 syntax/ast_derive_util.cmx : ext/ext_list.cmx syntax/ast_compatible.cmx \
@@ -205,15 +206,17 @@ syntax/ast_comb.cmx : ext/ext_list.cmx syntax/ast_literal.cmx \
 syntax/ast_core_type.cmx : ext/ext_list.cmx syntax/bs_syntaxerr.cmx \
     syntax/ast_literal.cmx syntax/ast_compatible.cmx syntax/ast_comb.cmx \
     syntax/ast_core_type.cmi
-syntax/bs_ast_invariant.cmx : ext/literals.cmx ext/hash_set_poly.cmx \
-    ext/ext_string.cmx common/bs_warnings.cmx syntax/bs_ast_iterator.cmx \
-    syntax/ast_core_type.cmx syntax/bs_ast_invariant.cmi
-syntax/ast_attributes.cmx : ext/ext_string.cmx syntax/bs_syntaxerr.cmx \
-    syntax/bs_ast_invariant.cmx syntax/ast_payload.cmx \
-    syntax/ast_compatible.cmx syntax/ast_attributes.cmi
-syntax/ast_polyvar.cmx : syntax/external_arg_spec.cmx ext/ext_pervasives.cmx \
-    ext/ext_list.cmx syntax/bs_syntaxerr.cmx syntax/ast_attributes.cmx \
-    syntax/ast_polyvar.cmi
+syntax/bs_ast_invariant.cmx : ext/hash_set_poly.cmx ext/ext_list.cmx \
+    common/bs_warnings.cmx syntax/bs_ast_iterator.cmx \
+    syntax/ast_utf8_string_interp.cmx syntax/ast_core_type.cmx \
+    syntax/bs_ast_invariant.cmi
+syntax/ast_attributes.cmx : ext/ext_string.cmx ext/ext_list.cmx \
+    syntax/bs_syntaxerr.cmx syntax/bs_ast_invariant.cmx \
+    syntax/ast_payload.cmx syntax/ast_compatible.cmx \
+    syntax/ast_attributes.cmi
+syntax/ast_polyvar.cmx : syntax/external_arg_spec.cmx ext/ext_list.cmx \
+    syntax/bs_syntaxerr.cmx syntax/ast_compatible.cmx \
+    syntax/ast_attributes.cmx syntax/ast_polyvar.cmi
 syntax/external_ffi_types.cmx : syntax/external_arg_spec.cmx \
     ext/ext_string.cmx ext/ext_pervasives.cmx common/bs_version.cmx \
     syntax/external_ffi_types.cmi
@@ -240,7 +243,7 @@ syntax/ast_derive_projector.cmx : ext/ext_string.cmx ext/ext_list.cmx \
 syntax/ast_derive_js_mapper.cmx : ext/ext_list.cmx syntax/ast_polyvar.cmx \
     syntax/ast_literal.cmx syntax/ast_derive_util.cmx syntax/ast_derive.cmx \
     syntax/ast_core_type.cmx syntax/ast_compatible.cmx syntax/ast_comb.cmx \
-    syntax/ast_derive_js_mapper.cmi
+    syntax/ast_attributes.cmx syntax/ast_derive_js_mapper.cmi
 syntax/ast_util.cmx : ext/literals.cmx syntax/external_process.cmx \
     ext/ext_string.cmx ext/ext_list.cmx syntax/bs_syntaxerr.cmx \
     syntax/bs_ast_mapper.cmx syntax/ast_payload.cmx syntax/ast_pat.cmx \
@@ -271,10 +274,9 @@ syntax/ast_core_type_class_type.cmx : ext/literals.cmx ext/ext_ref.cmx \
     ext/ext_list.cmx syntax/bs_ast_mapper.cmx syntax/ast_util.cmx \
     syntax/ast_literal.cmx syntax/ast_compatible.cmx syntax/ast_comb.cmx \
     syntax/ast_attributes.cmx syntax/ast_core_type_class_type.cmi
-syntax/ppx_entry.cmx : ext/string_map.cmx ext/literals.cmx \
-    common/js_config.cmx ext/ext_string.cmx syntax/bs_ast_mapper.cmx \
-    syntax/bs_ast_invariant.cmx syntax/ast_util.cmx \
-    syntax/ast_utf8_string_interp.cmx syntax/ast_utf8_string.cmx \
+syntax/ppx_entry.cmx : ext/string_map.cmx common/js_config.cmx \
+    ext/ext_list.cmx syntax/bs_ast_mapper.cmx syntax/bs_ast_invariant.cmx \
+    syntax/ast_util.cmx syntax/ast_utf8_string_interp.cmx \
     syntax/ast_tuple_pattern_flatten.cmx syntax/ast_tdcls.cmx \
     syntax/ast_structure.cmx syntax/ast_primitive.cmx syntax/ast_payload.cmx \
     syntax/ast_literal.cmx syntax/ast_exp_extension.cmx \
@@ -482,8 +484,8 @@ core/ocaml_parse.cmx : syntax/ppx_entry.cmx common/js_config.cmx \
     ext/ext_path.cmx core/ocaml_parse.cmi
 core/lam_pointer_info.cmx : core/lam_pointer_info.cmi
 core/lam_tag_info.cmx :
-core/lam_constant.cmx : ext/literals.cmx core/lam_tag_info.cmx \
-    core/lam_pointer_info.cmx ext/ext_string.cmx ext/ext_list.cmx \
+core/lam_constant.cmx : core/lam_tag_info.cmx core/lam_pointer_info.cmx \
+    ext/ext_string.cmx ext/ext_list.cmx syntax/ast_utf8_string_interp.cmx \
     core/lam_constant.cmi
 core/js_op.cmx : core/lam_tag_info.cmx core/lam_compat.cmx
 core/lam_module_ident.cmx : core/js_op.cmx core/j.cmx ext/hashtbl_make.cmx \

jscomp/bin/all_ounit_tests.ml

@@ -3798,10 +3798,6 @@ val dash_nostdlib : string
 
 val reactjs_jsx_ppx_2_exe : string 
 val reactjs_jsx_ppx_3_exe : string 
-val unescaped_j_delimiter : string 
-val escaped_j_delimiter : string 
-
-val unescaped_js_delimiter : string 
 
 val native : string
 val bytecode : string
@@ -3932,9 +3928,6 @@ let dash_nostdlib = "-nostdlib"
 
 let reactjs_jsx_ppx_2_exe = "reactjs_jsx_ppx_2.exe"
 let reactjs_jsx_ppx_3_exe  = "reactjs_jsx_ppx_3.exe"
-let unescaped_j_delimiter = "j"
-let unescaped_js_delimiter = "js"
-let escaped_j_delimiter =  "*j" (* not user level syntax allowed *)
 
 let native = "native"
 let bytecode = "bytecode"
@@ -14610,6 +14603,7 @@ module Ast_compatible : sig
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
 
+type poly_var_label = string 
 type arg_label = string 
 type label = 
   | Nolabel
@@ -14770,7 +14764,8 @@ type object_field =
 val object_field : string ->  attributes -> core_type -> object_field  
 
 
-  
+val hash_label : poly_var_label -> int 
+val label_of_name : poly_var_label -> string 
 end = struct
 #1 "ast_compatible.ml"
 (* Copyright (C) 2018 Authors of BuckleScript
@@ -14803,6 +14798,7 @@ open Parsetree
 let default_loc = Location.none
 
 
+type poly_var_label = string 
 type arg_label = string
 type label = 
   | Nolabel
@@ -15023,6 +15019,12 @@ type object_field =
 
 let object_field   l attrs ty = 
  (l,attrs,ty)  
+
+
+
+let hash_label : poly_var_label -> int = Ext_pervasives.hash_variant 
+external label_of_name : poly_var_label -> string = "%identity"
+
 end
 module Bs_loc : sig 
 #1 "bs_loc.mli"
@@ -15176,8 +15178,22 @@ type exn += Error of pos *  pos * error
 val empty_segment : segment -> bool
 
 val transform_test : string -> segment list
-val transform_interp : Location.t -> string -> Parsetree.expression
 
+
+
+val transform : 
+  Parsetree.expression -> 
+  string -> 
+  string -> 
+  Parsetree.expression
+
+val is_unicode_string :   
+  string -> 
+  bool
+
+val is_unescaped :   
+  string -> 
+  bool
 end = struct
 #1 "ast_utf8_string_interp.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
@@ -15566,8 +15582,11 @@ let to_string_ident : Longident.t =
     Ldot (Ldot (Lident "Js", "String"), "make")
 
 
+let escaped_j_delimiter =  "*j" (* not user level syntax allowed *)
+let unescaped_j_delimiter = "j"
+let unescaped_js_delimiter = "js"
 
-let escaped = Some Literals.escaped_j_delimiter 
+let escaped = Some escaped_j_delimiter 
 
 let concat_exp 
   (a : Parsetree.expression)
@@ -15622,8 +15641,7 @@ let transform_interp loc s =
     let rev_segments =  cxt.segments in 
     match rev_segments with 
     | [] -> 
-      Ast_compatible.const_exp_string ~loc 
-        ""  ~delimiter:Literals.escaped_j_delimiter
+      Ast_compatible.const_exp_string ~loc ""  ?delimiter:escaped
     | [ segment] -> 
       aux loc segment 
     | a::rest -> 
@@ -15637,6 +15655,25 @@ let transform_interp loc s =
     Location.raise_errorf ~loc:(update border start pos loc )
       "%a"  pp_error error 
 
+
+let transform (e : Parsetree.expression) s delim : Parsetree.expression = 
+    if Ext_string.equal delim unescaped_js_delimiter then
+        let js_str = Ast_utf8_string.transform e.pexp_loc s in
+        { e with pexp_desc =
+                       Pexp_constant (
+            
+            Const_string 
+                                     
+                         (js_str, escaped))}
+    else if Ext_string.equal delim unescaped_j_delimiter then
+            transform_interp e.pexp_loc s
+    else e
+
+let is_unicode_string opt = Ext_string.equal opt escaped_j_delimiter    
+
+let is_unescaped s = 
+  Ext_string.equal s unescaped_j_delimiter
+  || Ext_string.equal s unescaped_js_delimiter
 end
 module Ounit_unicode_tests
 = struct

jscomp/core/lam_constant.ml

@@ -91,13 +91,13 @@ let rec convert_constant ( const : Lambda.structured_constant) : t =
     | Const_base (Const_int i) -> (Const_int i)
     | Const_base (Const_char i) -> (Const_char i)
     | Const_base (Const_string(i,opt)) ->
-      begin match opt with
+        (match opt with
         | Some opt when
-            Ext_string.equal opt Literals.escaped_j_delimiter ->
+            Ast_utf8_string_interp.is_unicode_string opt  ->
           Const_unicode i
         | _ ->
-          Const_string i
-      end
+          Const_string i)
+      
     | Const_base (Const_float i) -> (Const_float i)
     | Const_base (Const_int32 i) -> (Const_int32 i)
     | Const_base (Const_int64 i) -> (Const_int64 i)

jscomp/ext/literals.ml

@@ -117,9 +117,6 @@ let dash_nostdlib = "-nostdlib"
 
 let reactjs_jsx_ppx_2_exe = "reactjs_jsx_ppx_2.exe"
 let reactjs_jsx_ppx_3_exe  = "reactjs_jsx_ppx_3.exe"
-let unescaped_j_delimiter = "j"
-let unescaped_js_delimiter = "js"
-let escaped_j_delimiter =  "*j" (* not user level syntax allowed *)
 
 let native = "native"
 let bytecode = "bytecode"

jscomp/ext/literals.mli

@@ -118,10 +118,6 @@ val dash_nostdlib : string
 
 val reactjs_jsx_ppx_2_exe : string 
 val reactjs_jsx_ppx_3_exe : string 
-val unescaped_j_delimiter : string 
-val escaped_j_delimiter : string 
-
-val unescaped_js_delimiter : string 
 
 val native : string
 val bytecode : string

jscomp/syntax/ast_attributes.ml

@@ -199,7 +199,7 @@ let iter_process_derive_type attrs =
   it is worse in bs.uncurry since it will introduce
   inconsistency in arity
  *)  
-let iter_process_bs_string_int_unwrap_uncurry attrs =
+let iter_process_bs_string_int_unwrap_uncurry (attrs : Parsetree.attributes) =
   let st = ref `Nothing in 
   let assign v (({loc;_}, _ ) as attr : attr) = 
     if !st = `Nothing then 
@@ -208,8 +208,7 @@ let iter_process_bs_string_int_unwrap_uncurry attrs =
       st := v ;
     end  
     else Bs_syntaxerr.err loc Conflict_attributes  in 
-  List.iter
-    (fun (({txt ; loc}, (payload : _ ) ) as attr : attr)  ->
+  Ext_list.iter attrs (fun (({txt ; loc}, (payload : _ ) ) as attr)  ->
       match  txt with
       | "bs.string"
         -> assign `String attr
@@ -223,8 +222,8 @@ let iter_process_bs_string_int_unwrap_uncurry attrs =
         ->
         assign (`Uncurry (Ast_payload.is_single_int payload)) attr
       | _ -> ()
-    ) attrs;
-    !st 
+    ) ;
+  !st 
 
 
 let iter_process_bs_string_as  (attrs : t) : string option =
@@ -248,17 +247,37 @@ let iter_process_bs_string_as  (attrs : t) : string option =
     ) ;
   !st
 
-let has_bs_optional  (attrs : t) : bool =
-  List.exists
+let iter_process_bs_string_as_ast  (attrs : t) : Parsetree.expression option =
+  let st = ref None in
+  Ext_list.iter attrs
     (fun
-      (({txt ; loc}, _payload ) as attr : attr)  ->
+      (({txt ; loc}, payload ) as attr )  ->
+      match  txt with
+      | "bs.as"
+        ->
+        if !st = None then
+          match Ast_payload.is_single_string_as_ast payload with
+          | None ->
+            Bs_syntaxerr.err loc Expect_string_literal
+          | Some _ as v ->            
+            Bs_ast_invariant.mark_used_bs_attribute attr ;
+            st:=  v
+        else
+          Bs_syntaxerr.err loc Duplicated_bs_as
+      | _  -> ()
+    ) ;
+  !st  
+
+let has_bs_optional  (attrs : t) : bool =
+  Ext_list.exists attrs (fun
+      (({txt ; }, _ ) as attr)  ->
       match  txt with
       | "bs.optional"
         ->
         Bs_ast_invariant.mark_used_bs_attribute attr ;
         true
       | _  -> false
-    ) attrs
+    ) 
 
 
 
@@ -283,11 +302,11 @@ let iter_process_bs_int_as  attrs =
     ) attrs; !st
 
 
-let iter_process_bs_string_or_int_as attrs =
+let iter_process_bs_string_or_int_as (attrs : Parsetree.attributes) =
   let st = ref None in
-  List.iter
+  Ext_list.iter attrs
     (fun
-      (({txt ; loc}, payload ) as attr : attr)  ->
+      (({txt ; loc}, payload ) as attr)  ->
       match  txt with
       | "bs.as"
         ->
@@ -311,7 +330,7 @@ let iter_process_bs_string_or_int_as attrs =
           Bs_syntaxerr.err loc Duplicated_bs_as
       | _ -> ()
 
-    ) attrs;
+    ) ;
   !st
 
 let locg = Location.none

jscomp/syntax/ast_attributes.mli

@@ -62,6 +62,10 @@ val iter_process_bs_string_int_unwrap_uncurry :
 val iter_process_bs_string_as :
   t -> string option
 
+val iter_process_bs_string_as_ast :   
+  t -> 
+  Parsetree.expression option
+  
 val has_bs_optional :
   t -> bool 
 

jscomp/syntax/ast_compatible.ml

@@ -28,6 +28,8 @@ open Parsetree
 let default_loc = Location.none
 
 #if OCAML_VERSION =~ ">4.03.0" then 
+type poly_var_label = Asttypes.label Asttypes.loc
+
 type arg_label = Asttypes.arg_label = 
   | Nolabel
   | Labelled of string
@@ -37,6 +39,7 @@ let is_arg_label_simple (s : arg_label) = s = (Nolabel : arg_label)
 type label = arg_label 
 external convert : arg_label -> label = "%identity"
 #else 
+type poly_var_label = string 
 type arg_label = string
 type label = 
   | Nolabel
@@ -323,4 +326,13 @@ type object_field =
 let object_field   l attrs ty = 
 #if OCAML_VERSION =~ ">4.03.0" then
   Parsetree.Otag 
-#end (l,attrs,ty)  
+#end (l,attrs,ty)  
+
+
+#if OCAML_VERSION =~ ">4.03.0" then 
+let hash_label (x : poly_var_label) : int = Ext_pervasives.hash_variant x.txt
+let label_of_name (x : poly_var_label) : string = x.txt
+#else
+let hash_label : poly_var_label -> int = Ext_pervasives.hash_variant 
+external label_of_name : poly_var_label -> string = "%identity"
+#end