[typer] error on invalid package names from macros, closes #8019

src/context/typecore.ml

@@ -243,6 +243,14 @@ let check_type_name ctx name p =
 	else
 		check_identifier_name ctx name "type" p
 
+let check_type_path ctx path p =
+	let pack = fst path in
+	try
+		List.iter (fun part -> Path.check_package_name part) pack;
+	with Failure msg ->
+		display_error ctx ("\"" ^ (StringHelper.s_escape (String.concat "." pack)) ^ "\" is not a valid package name:") p;
+		display_error ctx msg p
+
 let check_local_variable_name ctx name origin p =
 	match name with
 	| "this" -> () (* TODO: vars named `this` should technically be VGenerated, not VUser *)

src/core/path.ml

@@ -18,35 +18,41 @@ let get_path_parts f =
 	else
 		ExtString.String.nsplit f "."
 
+let invalid_char x =
+	for i = 1 to String.length x - 1 do
+		match x.[i] with
+		| 'A'..'Z' | 'a'..'z' | '0'..'9' | '_' | '.' -> ()
+		| c -> failwith ("Invalid character: " ^ (StringHelper.s_escape (String.make 1 c)))
+	done
+
+let check_package_name x =
+	if String.length x = 0 then
+		failwith "Package name must not be empty"
+	else if (x.[0] < 'a' || x.[0] > 'z') && x.[0] <> '_' then
+		failwith "Package name must start with a lower case character";
+	invalid_char x
+
 let parse_path f =
 	let cl = get_path_parts f in
 	let error msg =
 		let msg = "Could not process argument " ^ f ^ "\n" ^ msg in
 		failwith msg
 	in
-	let invalid_char x =
-		for i = 1 to String.length x - 1 do
-			match x.[i] with
-			| 'A'..'Z' | 'a'..'z' | '0'..'9' | '_' | '.' -> ()
-			| c -> error ("invalid character: " ^ (String.make 1 c))
-		done
-	in
 	let rec loop = function
 		| [] ->
-			error "empty part"
+			error "Package name must not be empty"
 		| [x] ->
 			invalid_char x;
 			[],x
 		| x :: l ->
-			if String.length x = 0 then
-				error "empty part"
-			else if (x.[0] < 'a' || x.[0] > 'z') && x.[0] <> '_' then
-				error "Package name must start with a lower case character";
-			invalid_char x;
+			check_package_name x;
 			let path,name = loop l in
 			x :: path,name
 	in
-	loop cl
+	try
+		loop cl
+	with Failure msg ->
+		error msg
 
 let parse_type_path s =
 	let pack,name = parse_path s in

src/macro/macroApi.ml

@@ -1477,7 +1477,7 @@ let decode_type_def v =
 	) in
 	(* if our package ends with an uppercase letter, then it's the module name *)
 	let pack,name = (match List.rev pack with
-		| last :: l when not (is_lower_ident last) -> List.rev l, last
+		| last :: l when (Lexer.is_valid_identifier last) && not (is_lower_ident last) -> List.rev l, last
 		| _ -> pack, fst name
 	) in
 	(pack, name), tdef, pos

src/syntax/lexer.ml

@@ -97,17 +97,21 @@ let keywords =
 		Operator;Overload];
 	h
 
-let is_valid_identifier s = try
-	for i = 0 to String.length s - 1 do
-		match String.unsafe_get s i with
-		| 'a'..'z' | 'A'..'Z' | '_' -> ()
-		| '0'..'9' when i > 0 -> ()
-		| _ -> raise Exit
-	done;
-	if Hashtbl.mem keywords s then raise Exit;
-	true
-with Exit ->
-	false
+let is_valid_identifier s =
+	if String.length s = 0 then
+		false
+	else
+		try
+			for i = 0 to String.length s - 1 do
+				match String.unsafe_get s i with
+				| 'a'..'z' | 'A'..'Z' | '_' -> ()
+				| '0'..'9' when i > 0 -> ()
+				| _ -> raise Exit
+			done;
+			if Hashtbl.mem keywords s then raise Exit;
+			true
+		with Exit ->
+			false
 
 let init file =
 	let f = make_file file in

src/typing/typeloadModule.ml

@@ -207,6 +207,7 @@ let module_pass_1 ctx m tdecls loadp =
 			pt := Some p;
 			let priv = List.mem HPrivate d.d_flags in
 			let path = make_path name priv in
+			Typecore.check_type_path ctx path p;
 			let c = mk_class m path p (pos d.d_name) in
 			(* we shouldn't load any other type until we propertly set cl_build *)
 			c.cl_build <- (fun() -> error (s_type_path c.cl_path ^ " is not ready to be accessed, separate your type declarations in several files") p);
@@ -228,6 +229,7 @@ let module_pass_1 ctx m tdecls loadp =
 			pt := Some p;
 			let priv = List.mem EPrivate d.d_flags in
 			let path = make_path name priv in
+			Typecore.check_type_path ctx path p;
 			if Meta.has (Meta.Custom ":fakeEnum") d.d_meta then error "@:fakeEnum enums is no longer supported in Haxe 4, use extern enum abstract instead" p;
 			let e = {
 				e_path = path;
@@ -253,6 +255,7 @@ let module_pass_1 ctx m tdecls loadp =
 			pt := Some p;
 			let priv = List.mem EPrivate d.d_flags in
 			let path = make_path name priv in
+			Typecore.check_type_path ctx path p;
 			let t = {
 				t_path = path;
 				t_module = m;
@@ -278,6 +281,7 @@ let module_pass_1 ctx m tdecls loadp =
 			Typecore.check_type_name ctx name p;
 			let priv = List.mem AbPrivate d.d_flags in
 			let path = make_path name priv in
+			Typecore.check_type_path ctx path p;
 			let a = {
 				a_path = path;
 				a_private = priv;

tests/misc/projects/Issue8019/Macro.hx

@@ -0,0 +1,34 @@
+import haxe.macro.Expr;
+import haxe.macro.Context;
+
+class Macro {
+	static function init() {
+		function defineType(pack, kind) {
+			Context.defineType({
+				pos: (macro 0).pos,
+				pack: pack,
+				name: 'Test',
+				kind: kind,
+				fields: []
+			});
+		}
+
+		function defineClass(pack) {
+			defineType(pack, TDClass());
+		}
+
+		defineClass(["Module"]);
+		defineClass(["pack", "Module"]);
+
+		defineClass([""]);
+		defineClass(["\n"]);
+		defineClass(["pack\n"]);
+		defineClass(["pack~"]);
+		defineClass(["Foo", "Bar"]);
+		
+		defineClass(["0_class"]);
+		defineType(["0_enum"], TDEnum);
+		defineType(["0_structure"], TDStructure);
+		defineType(["0_abstract"], TDAbstract(TPath({pack: [], name: "Int"})));
+	}
+}

tests/misc/projects/Issue8019/compile-fail.hxml

@@ -0,0 +1 @@
+--macro Macro.init()

tests/misc/projects/Issue8019/compile-fail.hxml.stderr

@@ -0,0 +1,20 @@
+Macro.hx:8: characters 17-18 : "" is not a valid package name:
+Macro.hx:8: characters 17-18 : Package name must not be empty
+Macro.hx:8: characters 17-18 : "\n" is not a valid package name:
+Macro.hx:8: characters 17-18 : Package name must start with a lower case character
+Macro.hx:8: characters 17-18 : "pack\n" is not a valid package name:
+Macro.hx:8: characters 17-18 : Invalid character: \n
+Macro.hx:8: characters 17-18 : "pack~" is not a valid package name:
+Macro.hx:8: characters 17-18 : Invalid character: ~
+Macro.hx:8: characters 17-18 : "Foo" is not a valid package name:
+Macro.hx:8: characters 17-18 : Package name must start with a lower case character
+Macro.hx:8: characters 17-18 : "0_class" is not a valid package name:
+Macro.hx:8: characters 17-18 : Package name must start with a lower case character
+Macro.hx:8: characters 17-18 : "0_enum" is not a valid package name:
+Macro.hx:8: characters 17-18 : Package name must start with a lower case character
+Macro.hx:8: characters 17-18 : "0_structure" is not a valid package name:
+Macro.hx:8: characters 17-18 : Package name must start with a lower case character
+Macro.hx:8: characters 17-18 : "0_abstract" is not a valid package name:
+Macro.hx:8: characters 17-18 : Package name must start with a lower case character
+Macro.hx:8: characters 17-18 : "0_abstract._Test" is not a valid package name:
+Macro.hx:8: characters 17-18 : Package name must start with a lower case character