Merge pull request #4097 from BuckleScript/raw_checker

error checking for raw/re, fix #4089

Author: bobzhang

jscomp/core/js_raw_exp_info.ml

@@ -37,4 +37,11 @@ type t =
     | RegExp of RegExp.t
   ]}
   *)
-  | Js_unknown
+  | Js_unknown
+
+
+  type raw_kind = 
+    | Raw_re 
+    | Raw_exp
+    | Raw_program
+    

jscomp/snapshot.ninja

@@ -22,7 +22,7 @@ build $SNAP/whole_compiler.ml: bspack | ./bin/bspack.exe
 
 
 build $SNAP/bsppx.ml: bspack | ./bin/bspack.exe
-    flags =  ${releaseMode} -bs-MD  -module-alias Config=Config_whole_compiler  -I $OCAML_SRC_UTILS -I $OCAML_SRC_PARSING  -I stubs -I common -I ext -I syntax -I core -I main 
+    flags =  ${releaseMode} -bs-MD  -module-alias Config=Config_whole_compiler  -I $OCAML_SRC_UTILS -I $OCAML_SRC_PARSING  -I stubs -I common -I ext -I syntax -I core -I js_parser -I main 
     main = Bsppx_main
 
 

jscomp/syntax/ast_compatible.ml

@@ -34,14 +34,14 @@ type arg_label = Asttypes.arg_label =
   | Nolabel
   | Labelled of string
   | Optional of string
-let no_label : arg_label = Nolabel
+
 let is_arg_label_simple (s : arg_label) = s = (Nolabel : arg_label)  
 type label = arg_label 
 
 
 
 let arrow ?(loc=default_loc) ?(attrs = []) a b  =
-  Ast_helper.Typ.arrow ~loc ~attrs no_label a b  
+  Ast_helper.Typ.arrow ~loc ~attrs Nolabel a b  
 
 let apply_simple
  ?(loc = default_loc) 
@@ -52,7 +52,7 @@ let apply_simple
     pexp_desc = 
       Pexp_apply(
         fn, 
-        (Ext_list.map args (fun x -> no_label, x) ) ) }
+        (Ext_list.map args (fun x -> Nolabel, x) ) ) }
 
 let app1        
   ?(loc = default_loc)
@@ -63,7 +63,7 @@ let app1
     pexp_desc = 
       Pexp_apply(
         fn, 
-        [no_label, arg1]
+        [Nolabel, arg1]
         ) }
 
 let app2
@@ -76,8 +76,8 @@ let app2
       Pexp_apply(
         fn, 
         [
-          no_label, arg1;
-          no_label, arg2 ]
+          Nolabel, arg1;
+          Nolabel, arg2 ]
         ) }
 
 let app3
@@ -90,9 +90,9 @@ let app3
       Pexp_apply(
         fn, 
         [
-          no_label, arg1;
-          no_label, arg2;
-          no_label, arg3
+          Nolabel, arg1;
+          Nolabel, arg2;
+          Nolabel, arg3
         ]
         ) }
 
@@ -104,7 +104,7 @@ let fun_
   {
     pexp_loc = loc; 
     pexp_attributes = attrs;
-    pexp_desc = Pexp_fun(no_label,None, pat, exp)
+    pexp_desc = Pexp_fun(Nolabel,None, pat, exp)
   }
 
 let opt_label s =

jscomp/syntax/ast_compatible.mli

@@ -30,7 +30,7 @@ type label = arg_label
 
 
 
-val no_label: arg_label
+
 
 type loc = Location.t 
 type attrs = Parsetree.attribute list 

jscomp/syntax/ast_core_type_class_type.ml

@@ -106,7 +106,7 @@ let handle_class_type_field self
                       private_flag,
                       virtual_flag,
                       Ast_util.to_method_type
-                        loc self Ast_compatible.no_label ty
+                        loc self Nolabel ty
                         (Ast_literal.type_unit ~loc ())
                      );
        pctf_attributes} in
@@ -190,7 +190,7 @@ let typ_mapper
               | Meth_callback attr, attrs ->
                 attrs, attr +> ty
             in               
-            Ast_compatible.object_field name attrs (Ast_util.to_method_type loc self Ast_compatible.no_label core_type 
+            Ast_compatible.object_field name attrs (Ast_util.to_method_type loc self Nolabel core_type 
               (Ast_literal.type_unit ~loc ())) in
           let not_getter_setter ty =
             let attrs, core_type =

jscomp/syntax/ast_exp_apply.ml

@@ -109,7 +109,7 @@ let app_exp_mapper
        begin match fn with
          | {pexp_desc = Pexp_apply (fn, args); pexp_loc; pexp_attributes} ->
            Bs_ast_invariant.warn_discarded_unused_attributes pexp_attributes;
-           { pexp_desc = Pexp_apply(fn, (Ast_compatible.no_label, new_obj_arg) :: args);
+           { pexp_desc = Pexp_apply(fn, (Nolabel, new_obj_arg) :: args);
              pexp_attributes = [];
              pexp_loc = pexp_loc}
          | {pexp_desc = Pexp_variant(label,None); pexp_loc; pexp_attributes} -> 
@@ -128,7 +128,7 @@ let app_exp_mapper
                              | {pexp_desc = Pexp_apply (fn,args); pexp_loc; pexp_attributes }
                                ->
                                Bs_ast_invariant.warn_discarded_unused_attributes pexp_attributes;
-                               { Parsetree.pexp_desc = Pexp_apply(fn, (Ast_compatible.no_label, bounded_obj_arg) :: args);
+                               { Parsetree.pexp_desc = Pexp_apply(fn, (Nolabel, bounded_obj_arg) :: args);
                                  pexp_attributes = [];
                                  pexp_loc = pexp_loc}
                              | {pexp_desc = Pexp_construct(ctor,None); pexp_loc; pexp_attributes}    
@@ -144,7 +144,7 @@ let app_exp_mapper
                let fn = Ast_open_cxt.restore_exp e wholes in 
                let args = Ext_list.map args (fun (lab,exp) -> lab, Ast_open_cxt.restore_exp exp wholes) in 
                Bs_ast_invariant.warn_discarded_unused_attributes pexp_attributes; 
-               { pexp_desc = Pexp_apply(fn, (Ast_compatible.no_label, new_obj_arg) :: args);
+               { pexp_desc = Pexp_apply(fn, (Nolabel, new_obj_arg) :: args);
                  pexp_attributes = [];
                  pexp_loc = loc}
              | _ -> Ast_compatible.app1 ~loc fn new_obj_arg

jscomp/syntax/ast_exp_extension.ml

@@ -93,11 +93,11 @@ let handle_extension record_as_js_object e (self : Bs_ast_mapper.mapper)
               (Exp.ident ~loc {txt = Ast_raw.raw_function_id;loc})
               (Ast_compatible.const_exp_string ~loc (toString {args = List.rev acc ; block }))
          end 
-      | _ ->   Ast_util.handle_raw ~check_js_regex:false loc payload
+      | _ ->   Ast_util.handle_raw ~kind:Raw_exp loc payload
       end
     | "bs.re" | "re" ->
       Exp.constraint_ ~loc
-        (Ast_util.handle_raw ~check_js_regex:true loc payload)
+        (Ast_util.handle_raw ~kind:Raw_re loc payload)
         (Ast_comb.to_js_re_type loc)
     | "bs.external" | "external" ->
       begin match Ast_payload.as_ident payload with 

jscomp/syntax/ast_external_process.ml

@@ -875,7 +875,7 @@ let handle_attributes
             | _ ->
               (* more error checking *)
               [External_arg_spec.empty_kind arg_type],
-              [{label = Ast_compatible.no_label;
+              [{label = Nolabel;
                 ty = new_ty;
                 attr =  [];
                 loc = obj.ptyp_loc} ],

jscomp/syntax/ast_payload.ml

@@ -65,20 +65,65 @@ let is_single_int (x : t ) : int option =
       _}] -> Some (int_of_string name)
   | _  -> None
 
-type rtn = Not_String_Lteral | JS_Regex_Check_Failed | Correct of Parsetree.expression
 
-let as_string_exp ~check_js_regex (x : t ) = 
+let offset_pos 
+  ({pos_lnum; pos_bol; pos_cnum} as loc : Lexing.position) 
+    ({line; column} : Loc.position) first_line_offset : Lexing.position = 
+  if line = 1 then 
+    {loc with pos_cnum = pos_cnum + column + first_line_offset }
+  else {
+    loc with 
+    pos_lnum = pos_lnum + line - 1;
+    pos_cnum =  pos_bol + column
+  }
+
+
+(* Here the loc is  the payload loc *)
+let check_flow_errors ~(loc : Location.t)
+  deli (errors : (Loc.t * Parse_error.t) list) = 
+  match errors with 
+  | [] ->  ()
+  | ({start ;
+     _end },first_error) :: _ -> 
+    let offset =  
+      (match deli with 
+      | None -> 1  (* length of '"'*)
+      | Some deli ->
+         String.length deli + 2 (* length of "{|"*)
+      ) in   
+    Location.raise_errorf ~loc:{loc with 
+      loc_start = offset_pos loc.loc_start start 
+        offset ;
+      loc_end = offset_pos loc.loc_start _end 
+        offset } "%s"
+      (Parse_error.PP.error first_error)  
+;;      
+let raw_as_string_exp_exn 
+  ~(kind: Js_raw_exp_info.raw_kind)
+  (x : t ) : _ option = 
   match x with  (** TODO also need detect empty phrase case *)
   | PStr [ {
       pstr_desc =  
         Pstr_eval (
           {pexp_desc = 
              Pexp_constant 
-               (Pconst_string (str,_))            
+               (Pconst_string (str,deli))            
                ;
-           _} as e ,_);
-      _}] -> if check_js_regex then (if Ext_js_regex.js_regex_checker str then Correct e else JS_Regex_Check_Failed) else Correct e
-  | _  -> Not_String_Lteral
+           pexp_loc = loc} as e ,_);
+      _}] -> 
+    check_flow_errors ~loc deli (match kind with 
+        |  Raw_re -> 
+          let l s = 
+            Flow_lexer.regexp (Lex_env.new_lex_env None (Sedlexing.Utf8.from_string s) ~enable_types_in_comments:false) 
+          in  
+          (snd (l str)).lex_errors 
+        | Raw_exp ->  
+          snd (Parser_flow.parse_expression (Parser_env.init_env None str) false)
+        | Raw_program ->  
+          snd (Parser_flow.parse_program false None str)
+      );
+    Some e 
+  | _  -> None
 
 let as_core_type loc x =
   match  x with

jscomp/syntax/ast_payload.mli

@@ -40,8 +40,14 @@ val is_single_string_as_ast :
 
 val is_single_int : t -> int option 
 
-type rtn = Not_String_Lteral | JS_Regex_Check_Failed | Correct of Parsetree.expression
-val as_string_exp : check_js_regex: bool -> t -> rtn
+
+
+(** Convert %raw into expression *)
+val raw_as_string_exp_exn :
+  kind: Js_raw_exp_info.raw_kind ->
+  t ->
+  Parsetree.expression option
+  
 val as_core_type : Location.t -> t -> Parsetree.core_type    
 (* val as_empty_structure :  t -> bool  *)
 val as_ident : t -> Longident.t Asttypes.loc option