Fix detection of module names on `Context.defineType()` (#8753)

* don't treat underscore as an uppercase letter

* better error messages for "is not a valid _something_ name"

* handle empty identifier exceptions

* update tests

src/context/typecore.ml

@@ -228,7 +228,7 @@ let add_local ctx k n t p =
 
 let check_identifier_name ctx name kind p =
 	if starts_with name '$' then
-		display_error ctx ((StringHelper.capitalize kind) ^ " names starting with a dollar are not allowed") p
+		display_error ctx ((StringHelper.capitalize kind) ^ " names starting with a dollar are not allowed: \"" ^ name ^ "\"") p
 	else if not (Lexer.is_valid_identifier name) then
 		display_error ctx ("\"" ^ (StringHelper.s_escape name) ^ "\" is not a valid " ^ kind ^ " name") p
 
@@ -238,13 +238,15 @@ let check_field_name ctx name p =
 	| _ -> check_identifier_name ctx name "field" p
 
 let check_uppercase_identifier_name ctx name kind p =
-	if Ast.is_lower_ident name then
-		display_error ctx ((StringHelper.capitalize kind) ^ " name should start with an uppercase letter") p
+	if String.length name = 0 then
+		display_error ctx ((StringHelper.capitalize kind) ^ " name must not be empty") p
+	else if Ast.is_lower_ident name then
+		display_error ctx ((StringHelper.capitalize kind) ^ " name should start with an uppercase letter: \"" ^ name ^ "\"") p
 	else
 		check_identifier_name ctx name kind p
 
 let check_module_path ctx path p =
-	check_uppercase_identifier_name ctx (snd path) ("module " ^ s_type_path 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;

src/core/ast.ml

@@ -324,13 +324,16 @@ type type_decl = type_def * pos
 type package = string list * type_decl list
 
 let is_lower_ident i =
-	let rec loop p =
-		match String.unsafe_get i p with
-		| 'a'..'z' -> true
-		| '_' -> if p + 1 < String.length i then loop (p + 1) else true
-		| _ -> false
-	in
-	loop 0
+	if String.length i = 0 then
+		raise (Invalid_argument "Identifier name must not be empty")
+	else
+		let rec loop p =
+			match String.unsafe_get i p with
+			| 'a'..'z' -> true
+			| '_' -> p + 1 >= String.length i || loop (p + 1)
+			| _ -> false
+		in
+		loop 0
 
 let pos = snd
 

src/core/stringHelper.ml

@@ -19,7 +19,16 @@ let capitalize s =
 		Bytes.to_string bytes
 
 let starts_uppercase_identifier x =
-	if String.length x = 0 then false else x.[0] = '_' || (x.[0] >= 'A' && x.[0] <= 'Z')
+	if String.length x = 0 then
+		raise (Invalid_argument "Identifier name must not be empty")
+	else
+		let rec loop p =
+			match String.unsafe_get x p with
+			| 'A'..'Z' -> true
+			| '_' -> p + 1 < String.length x && loop (p + 1)
+			| _ -> false
+		in
+		loop 0
 
 let check_uppercase x =
 	if String.length x = 0 then

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 StringHelper.starts_uppercase_identifier last -> List.rev l, last
+		| last :: l when String.length last > 0 && StringHelper.starts_uppercase_identifier last -> List.rev l, last
 		| _ -> pack, fst name
 	) in
 	(pack, name), tdef, pos

src/typing/typer.ml

@@ -33,6 +33,10 @@ open Calls
 (* ---------------------------------------------------------------------- *)
 (* TOOLS *)
 
+let is_lower_ident s p =
+	try Ast.is_lower_ident s
+	with Invalid_argument msg -> error msg p
+
 let check_assign ctx e =
 	match e.eexpr with
 	| TLocal {v_final = true} ->
@@ -1153,7 +1157,7 @@ and type_ident ctx i p mode =
 		type_ident_raise ctx i p mode
 	with Not_found -> try
 		(* lookup type *)
-		if is_lower_ident i then raise Not_found;
+		if is_lower_ident i p then raise Not_found;
 		let e = (try type_type ctx ([],i) p with Error (Module_not_found ([],name),_) when name = i -> raise Not_found) in
 		AKExpr e
 	with Not_found ->
@@ -1399,9 +1403,9 @@ and handle_efield ctx e p mode =
 	let rec loop acc (e,p) =
 		match e with
 		| EField (e,s) ->
-			loop ((s,not (is_lower_ident s),p) :: acc) e
+			loop ((s,not (is_lower_ident s p),p) :: acc) e
 		| EConst (Ident i) ->
-			type_path ((i,not (is_lower_ident i),p) :: acc)
+			type_path ((i,not (is_lower_ident i p),p) :: acc)
 		| _ ->
 			fields acc (type_access ctx e p)
 	in

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

@@ -1,3 +1,3 @@
-Macro2.hx:7: characters 17-18 : "" is not a valid module name
+Macro2.hx:7: characters 17-18 : Module name must not be empty
 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/Issue8750/Main.hx

@@ -0,0 +1,18 @@
+class Main {
+	static function main () {
+		#if !macro
+		define();
+		#end
+	}
+
+	macro static public function define() {
+		haxe.macro.Context.defineType({
+			pack:["hxd","_res"],
+			name:"_Ui_skills",
+			pos:haxe.macro.Context.currentPos(),
+			kind:TDStructure,
+			fields:[]
+		});
+		return macro {};
+	}
+}

tests/misc/projects/Issue8750/compile.hxml

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

tests/misc/projects/Issue8752/Main.hx

@@ -0,0 +1,11 @@
+class Main {
+	static function main () {
+		#if !macro
+		define();
+		#end
+	}
+
+	macro static public function define() {
+		return macro $i{""};
+	}
+}

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

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

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

@@ -0,0 +1 @@
+Main.hx:9: characters 18-22 : Identifier name must not be empty

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

@@ -1,4 +1,4 @@
-Main3.hx:9: characters 17-18 : Module name should start with an uppercase letter
+Main3.hx:9: characters 17-18 : Module name should start with an uppercase letter: "lowercase"
 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

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

@@ -1,4 +1,4 @@
-Main4.hx:3: characters 7-9 : Variable names starting with a dollar are not allowed
-Main4.hx:5: characters 17-19 : Catch variable names starting with a dollar are not allowed
-Main4.hx:7: characters 8-10 : For variable names starting with a dollar are not allowed
+Main4.hx:3: characters 7-9 : Variable names starting with a dollar are not allowed: "$i"
+Main4.hx:5: characters 17-19 : Catch variable names starting with a dollar are not allowed: "$i"
+Main4.hx:7: characters 8-10 : For variable names starting with a dollar are not allowed: "$i"
 Main4.hx:10: characters 9-11 : Pattern variables must be lower-case