Parcourir la source

sanitize some first char string checks

closes #7126
Simon Krajewski il y a 7 ans
Parent
commit
b327fe7c9e

+ 1 - 1
src/codegen/genxml.ml

@@ -317,7 +317,7 @@ let rec create_dir acc = function
 
 let conv_path p =
 	match List.rev (fst p) with
-	| x :: l when x.[0] = '_' -> List.rev (("priv" ^ x) :: l), snd p
+	| x :: l when starts_with x '_' -> List.rev (("priv" ^ x) :: l), snd p
 	| _ -> p
 
 let get_real_path meta path =

+ 4 - 1
src/core/globals.ml

@@ -70,4 +70,7 @@ let platform_list_help = function
 
 let null_pos = { pfile = "?"; pmin = -1; pmax = -1 }
 
-let s_type_path (p,s) = match p with [] -> s | _ -> String.concat "." p ^ "." ^ s
+let s_type_path (p,s) = match p with [] -> s | _ -> String.concat "." p ^ "." ^ s
+
+let starts_with s c =
+	String.length s > 0 && s.[0] = c

+ 1 - 1
src/macro/macroApi.ml

@@ -1732,7 +1732,7 @@ let macro_api ccom get_api =
 			let data = Bytes.unsafe_to_string data in
 			if name = "" then failwith "Empty resource name";
 			Hashtbl.replace (ccom()).resources name data;
-			let m = if name.[0] = '$' then (get_api()).current_macro_module() else (get_api()).current_module() in
+			let m = if Globals.starts_with name '$' then (get_api()).current_macro_module() else (get_api()).current_module() in
 			m.m_extra.m_binded_res <- PMap.add name data m.m_extra.m_binded_res;
 			vnull
 		);

+ 1 - 1
src/syntax/parser.ml

@@ -145,7 +145,7 @@ let would_skip_display_position p1 s =
 let cut_pos_at_display p = { p with pmax = !display_position.pmax }
 
 let is_dollar_ident e = match fst e with
-	| EConst (Ident n) when n.[0] = '$' ->
+	| EConst (Ident n) when starts_with n '$' ->
 		true
 	| _ ->
 		false

+ 1 - 1
src/typing/typeloadFields.ml

@@ -1154,7 +1154,7 @@ let init_field (ctx,cctx,fctx) f =
 	let name = fst f.cff_name in
 	TypeloadCheck.check_global_metadata ctx f.cff_meta (fun m -> f.cff_meta <- m :: f.cff_meta) c.cl_module.m_path c.cl_path (Some name);
 	let p = f.cff_pos in
-	if name.[0] = '$' then display_error ctx "Field names starting with a dollar are not allowed" p;
+	if starts_with name '$' then display_error ctx "Field names starting with a dollar are not allowed" p;
 	List.iter (fun acc ->
 		match (fst acc, f.cff_kind) with
 		| APublic, _ | APrivate, _ | AStatic, _ | AFinal, _ | AExtern, _ -> ()

+ 1 - 1
src/typing/typeloadFunction.ml

@@ -82,7 +82,7 @@ let save_function_state ctx =
 
 let type_function ctx args ret fmode f do_display p =
 	let fargs = List.map2 (fun (n,c,t) ((_,pn),_,m,_,_) ->
-		if n.[0] = '$' then error "Function argument names starting with a dollar are not allowed" p;
+		if starts_with n '$' then error "Function argument names starting with a dollar are not allowed" p;
 		let c = type_function_arg_value ctx t c do_display in
 		let v,c = add_local_with_origin ctx n t pn (TVarOrigin.TVOArgument), c in
 		v.v_meta <- v.v_meta @ m;

+ 4 - 4
src/typing/typeloadModule.ml

@@ -202,7 +202,7 @@ let module_pass_1 ctx m tdecls loadp =
 			| Some _ -> error "import and using may not appear after a type declaration" p)
 		| EClass d ->
 			let name = fst d.d_name in
-			if String.length name > 0 && name.[0] = '$' then error "Type names starting with a dollar are not allowed" p;
+			if starts_with name '$' then error "Type names starting with a dollar are not allowed" p;
 			pt := Some p;
 			let priv = List.mem HPrivate d.d_flags in
 			let path = make_path name priv in
@@ -217,7 +217,7 @@ let module_pass_1 ctx m tdecls loadp =
 			acc
 		| EEnum d ->
 			let name = fst d.d_name in
-			if String.length name > 0 && name.[0] = '$' then error "Type names starting with a dollar are not allowed" p;
+			if starts_with name '$' then error "Type names starting with a dollar are not allowed" p;
 			pt := Some p;
 			let priv = List.mem EPrivate d.d_flags in
 			let path = make_path name priv in
@@ -239,7 +239,7 @@ let module_pass_1 ctx m tdecls loadp =
 			acc
 		| ETypedef d ->
 			let name = fst d.d_name in
-			if String.length name > 0 && name.[0] = '$' then error "Type names starting with a dollar are not allowed" p;
+			if starts_with name '$' then error "Type names starting with a dollar are not allowed" p;
 			pt := Some p;
 			let priv = List.mem EPrivate d.d_flags in
 			let path = make_path name priv in
@@ -264,7 +264,7 @@ let module_pass_1 ctx m tdecls loadp =
 			acc
 		 | EAbstract d ->
 		 	let name = fst d.d_name in
-			if String.length name > 0 && name.[0] = '$' then error "Type names starting with a dollar are not allowed" p;
+			if starts_with name '$' then error "Type names starting with a dollar are not allowed" p;
 			let priv = List.mem AbPrivate d.d_flags in
 			let path = make_path name priv in
 			let a = {

+ 6 - 6
src/typing/typer.ml

@@ -1485,7 +1485,7 @@ and type_vars ctx vl p =
 					let e = AbstractCast.cast_or_unify ctx t e p in
 					Some e
 			) in
-			if v.[0] = '$' then display_error ctx "Variables names starting with a dollar are not allowed" p;
+			if starts_with v '$' then display_error ctx "Variables names starting with a dollar are not allowed" p;
 			let v = add_local_with_origin ctx v t pv TVarOrigin.TVOLocalVariable in
 			v.v_meta <- (Meta.UserVariable,[],pv) :: v.v_meta;
 			if ctx.in_display && DisplayPosition.encloses_display_position pv then
@@ -1681,7 +1681,7 @@ and type_object_decl ctx fl with_type p =
 				type_expr ctx e Value
 			in
 			if is_valid then begin
-				if String.length n > 0 && n.[0] = '$' then error "Field names starting with a dollar are not allowed" p;
+				if starts_with n '$' then error "Field names starting with a dollar are not allowed" p;
 				let cf = mk_field n e.etype (punion pn e.epos) pn in
 				fields := PMap.add n cf !fields;
 			end;
@@ -1709,7 +1709,7 @@ and type_object_decl ctx fl with_type p =
 			let cf = mk_field f e.etype (punion pf e.epos) pf in
 			if ctx.in_display && DisplayPosition.encloses_display_position pf then DisplayEmitter.display_field ctx Unknown CFSMember cf pf;
 			(((f,pf,qs),e) :: l, if is_valid then begin
-				if String.length f > 0 && f.[0] = '$' then error "Field names starting with a dollar are not allowed" p;
+				if starts_with f '$' then error "Field names starting with a dollar are not allowed" p;
 				PMap.add f cf acc
 			end else acc)
 		in
@@ -1886,7 +1886,7 @@ and type_try ctx e1 catches with_type p =
 			| _ -> error "Catch type must be a class, an enum or Dynamic" (pos e_ast)
 		in
 		let name,t2 = loop t in
-		if v.[0] = '$' then display_error ctx "Catch variable names starting with a dollar are not allowed" p;
+		if starts_with v '$' then display_error ctx "Catch variable names starting with a dollar are not allowed" p;
 		check_unreachable acc1 t2 (pos e_ast);
 		let locals = save_locals ctx in
 		let v = add_local_with_origin ctx v t pv (TVarOrigin.TVOCatchVariable) in
@@ -2030,7 +2030,7 @@ and type_local_function ctx name f with_type p =
 	let v = (match v with
 		| None -> None
 		| Some v ->
-			if v.[0] = '$' then display_error ctx "Variable names starting with a dollar are not allowed" p;
+			if starts_with v '$' then display_error ctx "Variable names starting with a dollar are not allowed" p;
 			let v = (add_local_with_origin ctx v ft p (TVarOrigin.TVOLocalFunction)) (* TODO: var pos *) in
 			if params <> [] then v.v_extra <- Some (params,None);
 			Some v
@@ -2353,7 +2353,7 @@ and type_expr ctx (e,p) (with_type:with_type) =
 	| EField ((EConst (String s),ps),"code") ->
 		if UTF8.length s <> 1 then error "String must be a single UTF8 char" ps;
 		mk (TConst (TInt (Int32.of_int (UChar.code (UTF8.get s 0))))) ctx.t.tint p
-	| EField(_,n) when n.[0] = '$' ->
+	| EField(_,n) when starts_with n '$' ->
 		error "Field names starting with $ are not allowed" p
 	| EConst (Ident s) ->
 		if s = "super" && with_type <> NoValue && not ctx.in_display then error "Cannot use super as value" p;