[typer] error on invalid package and module names from macros, closes #8019 (#8721)

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

* Add a test to make sure invalid paths in expression macros error too

* Invert the check

* Check module names as well, cleanup

* Some renames

* Deal with externs

* Fine

src/compiler/main.ml

@@ -936,7 +936,7 @@ try
 	let args_callback cl =
 		begin try
 			let path,name = Path.parse_path cl in
-			if StringHelper.starts_uppercase name then
+			if StringHelper.starts_uppercase_identifier name then
 				classes := (path,name) :: !classes
 			else begin
 				force_typing := true;

src/context/typecore.ml

@@ -237,11 +237,20 @@ let check_field_name ctx name p =
 	| "new" -> () (* the only keyword allowed in field names *)
 	| _ -> check_identifier_name ctx name "field" p
 
-let check_type_name ctx name p =
+let check_uppercase_identifier_name ctx name kind p =
 	if Ast.is_lower_ident name then
-		display_error ctx "Type name should start with an uppercase letter" p
+		display_error ctx ((StringHelper.capitalize kind) ^ " name should start with an uppercase letter") p
 	else
-		check_identifier_name ctx name "type" p
+		check_identifier_name ctx name kind p
+
+let check_module_path ctx path p =
+	check_uppercase_identifier_name ctx (snd path) "module" 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
@@ -394,7 +403,7 @@ let rec can_access ctx ?(in_overload=false) c cf stat =
 				(* means it's a path of a superclass or implemented interface *)
 				not is_current_path &&
 				(* it's the last part of path in a meta && it denotes a package *)
-				l1 = [] && not (StringHelper.starts_uppercase a)
+				l1 = [] && not (StringHelper.starts_uppercase_identifier a)
 			then
 				false
 			else

src/core/path.ml

@@ -18,35 +18,41 @@ let get_path_parts f =
 	else
 		ExtString.String.nsplit f "."
 
+let check_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";
+	check_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;
+			check_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/core/stringHelper.ml

@@ -18,13 +18,13 @@ let capitalize s =
 			Bytes.set bytes 0 (Char.chr (code - 32));
 		Bytes.to_string bytes
 
-let starts_uppercase x =
-	x.[0] = '_' || (x.[0] >= 'A' && x.[0] <= 'Z')
+let starts_uppercase_identifier x =
+	if String.length x = 0 then false else x.[0] = '_' || (x.[0] >= 'A' && x.[0] <= 'Z')
 
 let check_uppercase x =
 	if String.length x = 0 then
 		failwith "empty part"
-	else if not (starts_uppercase x) then
+	else if not (starts_uppercase_identifier x) then
 		failwith "Class name must start with uppercase character"
 
 let s_escape ?(hex=true) s =

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 StringHelper.starts_uppercase_identifier 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

@@ -196,6 +196,10 @@ let module_pass_1 ctx m tdecls loadp =
 	let pt = ref None in
 	let rec make_decl acc decl =
 		let p = snd decl in
+		let check_type_name type_name =
+			let module_name = snd m.m_path in
+			if type_name <> module_name then Typecore.check_uppercase_identifier_name ctx type_name "type" p;
+		in
 		let acc = (match fst decl with
 		| EImport _ | EUsing _ ->
 			(match !pt with
@@ -203,7 +207,6 @@ 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
-			Typecore.check_type_name ctx name p;
 			pt := Some p;
 			let priv = List.mem HPrivate d.d_flags in
 			let path = make_path name priv in
@@ -220,11 +223,11 @@ let module_pass_1 ctx m tdecls loadp =
 				| HFinal -> c.cl_final <- true
 				| _ -> ()
 			) d.d_flags;
+			if not c.cl_extern then check_type_name name;
 			decls := (TClassDecl c, decl) :: !decls;
 			acc
 		| EEnum d ->
 			let name = fst d.d_name in
-			Typecore.check_type_name ctx name p;
 			pt := Some p;
 			let priv = List.mem EPrivate d.d_flags in
 			let path = make_path name priv in
@@ -244,11 +247,12 @@ let module_pass_1 ctx m tdecls loadp =
 				e_names = [];
 				e_type = enum_module_type m path p;
 			} in
+			if not e.e_extern then check_type_name name;
 			decls := (TEnumDecl e, decl) :: !decls;
 			acc
 		| ETypedef d ->
 			let name = fst d.d_name in
-			Typecore.check_type_name ctx name p;
+			check_type_name name;
 			if has_meta Meta.Using d.d_meta then error "@:using on typedef is not allowed" p;
 			pt := Some p;
 			let priv = List.mem EPrivate d.d_flags in
@@ -275,7 +279,7 @@ let module_pass_1 ctx m tdecls loadp =
 			acc
 		 | EAbstract d ->
 		 	let name = fst d.d_name in
-			Typecore.check_type_name ctx name p;
+			check_type_name name;
 			let priv = List.mem AbPrivate d.d_flags in
 			let path = make_path name priv in
 			let a = {
@@ -936,7 +940,7 @@ let type_module ctx mpath file ?(is_extern=false) tdecls p =
 	Hashtbl.add ctx.g.modules m.m_path m;
 	let tdecls = handle_import_hx ctx m tdecls p in
 	let ctx = type_types_into_module ctx m tdecls p in
-	if is_extern then m.m_extra.m_kind <- MExtern;
+	if is_extern then m.m_extra.m_kind <- MExtern else Typecore.check_module_path ctx m.m_path p;
 	begin if ctx.is_display_file then match ctx.com.display.dms_kind with
 		| DMResolve s ->
 			DisplayPath.resolve_position_by_path ctx {tname = s; tpackage = []; tsub = None; tparams = []} p

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/Macro2.hx

@@ -0,0 +1,21 @@
+import haxe.macro.Context;
+
+class Macro2 {
+	static function init() {
+		function defineModule(name:String) {
+			Context.defineModule(name, [{
+				pos: (macro 0).pos,
+				pack: [],
+				name: name,
+				kind: TDClass(),
+				fields: []
+			}]);
+		}
+
+		defineModule("Valid");
+
+		defineModule("");
+		defineModule("0");
+		defineModule("Type+");
+	}
+}

tests/misc/projects/Issue8019/Main.hx

@@ -0,0 +1,15 @@
+import haxe.macro.Expr;
+import haxe.macro.Context;
+
+class Main {
+	static function main() {
+		invalidPackage();
+	}
+
+	static macro function invalidPackage() {
+		return {
+			expr: ENew({name: "Foo", pack: ["0"]}, []),
+			pos: Context.currentPos()
+		};
+	}
+}

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

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

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

@@ -0,0 +1,18 @@
+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

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

@@ -0,0 +1 @@
+-main Main

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

@@ -0,0 +1,2 @@
+Type not found : 0.Foo
+Main.hx:4: lines 4-15 : Defined in this class

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

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

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

@@ -0,0 +1,3 @@
+Macro2.hx:7: characters 17-18 : "" is not a valid module name
+Macro2.hx:7: characters 17-18 : "0" is not a valid module name
+Macro2.hx:7: characters 17-18 : "Type+" is not a valid module name

tests/misc/projects/issue5002/compile3-fail.hxml.stderr

@@ -1,6 +1,6 @@
-Main3.hx:9: characters 17-18 : Type name should start with an uppercase letter
-Main3.hx:9: characters 17-18 : "0_class" is not a valid type name
-Main3.hx:9: characters 17-18 : "0_enum" is not a valid type name
-Main3.hx:9: characters 17-18 : "0_struct" is not a valid type name
-Main3.hx:9: characters 17-18 : "0_abstract" is not a valid type name
-Main3.hx:9: characters 17-18 : "0_abstract_Impl_" is not a valid type name
+Main3.hx:9: characters 17-18 : Module name should start with an uppercase letter
+Main3.hx:9: characters 17-18 : "0_class" is not a valid module name
+Main3.hx:9: characters 17-18 : "0_enum" is not a valid module name
+Main3.hx:9: characters 17-18 : "0_struct" is not a valid module name
+Main3.hx:9: characters 17-18 : "0_abstract_Impl_" is not a valid type name
+Main3.hx:9: characters 17-18 : "0_abstract" is not a valid module name