Merge pull request #660 from bloomberg/error_checking_external

Error checking external

Author: bobzhang

jscomp/bin/bs_ppx.ml

@@ -251,7 +251,7 @@ let translate_ffi (ffi : Ast_external_attributes.ffi ) prim_name
 
 let translate cxt 
     ({prim_name ;  prim_native_name} 
-     : Ast_external_attributes.prim) args  = 
+     : Primitive.description) args  = 
   if Ast_external_attributes.is_bs_external_prefix prim_native_name then 
     begin 
       match Ast_external_attributes.unsafe_from_string prim_native_name with 

jscomp/bin/compiler.ml

@@ -70,7 +70,49 @@ type ffi =
   | Js_get_index
   | Js_set_index
 
-type prim =  Primitive.description
+
+
+let valid_js_char =
+  let a = Array.init 256 (fun i ->
+    let c = Char.chr i in
+    (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || (c >= '0' && c <= '9') || c = '_' || c = '$'
+  ) in
+  (fun c -> Array.unsafe_get a (Char.code c))
+
+let valid_first_js_char = 
+  let a = Array.init 256 (fun i ->
+    let c = Char.chr i in
+    (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || c = '_' || c = '$'
+  ) in
+  (fun c -> Array.unsafe_get a (Char.code c))
+
+(** Approximation could be improved *)
+let valid_ident (s : string) =
+  let len = String.length s in
+  len > 0 && valid_js_char s.[0] && valid_first_js_char s.[0] &&
+  (let module E = struct exception E end in
+   try
+     for i = 1 to len - 1 do
+       if not (valid_js_char (String.unsafe_get s i)) then
+         raise E.E         
+     done ;
+     true     
+   with E.E -> false )  
+  
+let valid_global_name ?loc txt =
+  if not (valid_ident txt) then
+    let v = Ext_string.split_by ~keep_empty:true (fun x -> x = '.') txt in
+    List.iter
+      (fun s ->
+         if not (valid_ident s) then
+           Location.raise_errorf ?loc "Not a valid  name %s"  txt
+      ) v      
+
+let valid_method_name ?loc txt =         
+  if not (valid_ident txt) then
+    Location.raise_errorf ?loc "Not a valid  name %s"  txt
+
+
 
 let check_external_module_name ?loc x = 
   match x with 
@@ -85,13 +127,12 @@ let check_external_module_name_opt ?loc x =
 
 let check_ffi ?loc ffi = 
   match ffi with 
-  | Js_global {txt = ""} 
-  | Js_send {name = ""}
-  | Js_set  ""
-  | Js_get ""
-    -> Location.raise_errorf ?loc "empty name encountered"
-  | Js_global _ | Js_send _ | Js_set _ | Js_get _  
-  | Obj_create _
+  | Js_global {txt} -> valid_global_name ?loc  txt 
+  | Js_send {name } 
+  | Js_set  name
+  | Js_get name
+    ->  valid_method_name ?loc name
+  | Obj_create _ -> ()
   | Js_get_index | Js_set_index 
     -> ()
 
@@ -101,10 +142,8 @@ let check_ffi ?loc ffi =
   | Js_new {external_module_name ; txt = name}
   | Js_call {external_module_name ; txt = {name ; _}}
     -> 
-    check_external_module_name_opt ?loc external_module_name ; 
-    if name = "" then
-      Location.raise_errorf ?loc "empty name in externals"
-
+    check_external_module_name_opt ?loc external_module_name ;
+    valid_global_name ?loc name     
 
 
 (** 

jscomp/lam_compile_external_call.ml

@@ -74,7 +74,7 @@ type t  =
   | Bs of arg_kind list  * arg_type *   ffi
   | Normal 
 
-type prim =  Primitive.description
+
 
 
 

jscomp/syntax/ast_external_attributes.ml

@@ -269,6 +269,8 @@ gpr_459_test.cmj : mt.cmi
 gpr_459_test.cmx : mt.cmx
 gpr_627_test.cmj : mt.cmi
 gpr_627_test.cmx : mt.cmx
+gpr_658.cmj : ../runtime/js.cmj
+gpr_658.cmx : ../runtime/js.cmx
 guide_for_ext.cmj :
 guide_for_ext.cmx :
 hamming_test.cmj : ../stdlib/printf.cmi mt.cmi ../stdlib/lazy.cmi \
@@ -1041,6 +1043,8 @@ gpr_459_test.cmo : mt.cmi
 gpr_459_test.cmj : mt.cmj
 gpr_627_test.cmo : mt.cmi
 gpr_627_test.cmj : mt.cmj
+gpr_658.cmo : ../runtime/js.cmo
+gpr_658.cmj : ../runtime/js.cmj
 guide_for_ext.cmo :
 guide_for_ext.cmj :
 hamming_test.cmo : ../stdlib/printf.cmi mt.cmi ../stdlib/lazy.cmi \

jscomp/syntax/ast_external_attributes.mli

@@ -60,7 +60,7 @@ OTHERS := literals a test_ari test_export2 test_internalOO test_obj_simple_ffi t
 	bs_rest_test infer_type_test fs_test module_as_function\
 	test_case_set test_mutliple string_bound_get_test inline_string_test\
 	ppx_this_obj_test unsafe_obj_external gpr_627_test jsoo_485_test jsoo_400_test	\
-	test_require more_uncurry earger_curry_test poly_type bench mutable_obj_test
+	test_require more_uncurry earger_curry_test poly_type bench mutable_obj_test gpr_658
 
 
 

jscomp/test/.depend

@@ -0,0 +1,5 @@
+'use strict';
+
+
+
+/* No side effect */

jscomp/test/Makefile

@@ -0,0 +1,8 @@
+
+
+
+(* external obj : < hi : int  > Js.t  = "{hi:1}" [@@bs.val] *)
+
+external mk : hi:int -> unit ->  < hi : int  > Js.t  = "" [@@bs.obj]
+
+(* external set_name : < > ->  string -> unit = "1name" [@@bs.set]  *)