[parser] support type path completion for metadata arguments (closes #3931)

ast.ml

@@ -754,3 +754,9 @@ let get_value_meta meta =
 		end
 	with Not_found ->
 		PMap.empty
+
+let rec string_list_of_expr_path_raise (e,p) =
+	match e with
+	| EConst (Ident i) -> [i]
+	| EField (e,f) -> f :: string_list_of_expr_path_raise e
+	| _ -> raise Exit

parser.ml

@@ -88,6 +88,10 @@ let do_resume() = !resume_display <> null_pos
 
 let display e = raise (Display e)
 
+let type_path sl in_import = match sl with
+	| n :: l when n.[0] >= 'A' && n.[0] <= 'Z' -> raise (TypePath (List.rev l,Some (n,false),in_import));
+	| _ -> raise (TypePath (List.rev sl,None,in_import))
+
 let is_resuming p =
 	let p2 = !resume_display in
 	p.pmax = p2.pmin && !use_parser_resume && Common.unique_full_path p.pfile = p2.pfile
@@ -648,9 +652,7 @@ and parse_import s p1 =
 		match s with parser
 		| [< '(Dot,p) >] ->
 			let resume() =
-				match acc with
-				| (n,_) :: l when n.[0] >= 'A' && n.[0] <= 'Z' -> raise (TypePath (List.rev (List.map fst l),Some (n,false),true));
-				| _ -> raise (TypePath (List.rev (List.map fst acc),None,true));
+				type_path (List.map fst acc) true
 			in
 			if is_resuming p then resume();
 			(match s with parser
@@ -773,8 +775,21 @@ and parse_common_flags = parser
 	| [< '(Kwd Extern,_); l = parse_common_flags >] -> (HExtern, EExtern) :: l
 	| [< >] -> []
 
+and parse_meta_argument_expr s =
+	try
+		expr s
+	with Display e -> match fst e with
+		| EDisplay(e,_) ->
+			begin try
+				type_path (string_list_of_expr_path_raise e) false
+			with Exit ->
+				e
+			end
+		| _ ->
+			e
+
 and parse_meta_params pname s = match s with parser
-	| [< '(POpen,p) when p.pmin = pname.pmax; params = psep Comma expr; '(PClose,_); >] -> params
+	| [< '(POpen,p) when p.pmin = pname.pmax; params = psep Comma parse_meta_argument_expr; '(PClose,_); >] -> params
 	| [< >] -> []
 
 and parse_meta_entry = parser

tests/misc/projects/Issue3931/Main1.hx

@@ -0,0 +1,4 @@
+@:access(pack.
+class Main1 {
+	static function main() { }
+}

tests/misc/projects/Issue3931/Main2.hx

@@ -0,0 +1,4 @@
+@:access(pack.A.
+class Main2 {
+	static function main() { }
+}

tests/misc/projects/Issue3931/compile1.hxml

@@ -0,0 +1 @@
+--display Main1.hx@14

tests/misc/projects/Issue3931/compile1.hxml.stderr

@@ -0,0 +1,4 @@
+<list>
+<i n="A"><t></t><d></d></i>
+<i n="B"><t></t><d></d></i>
+</list>

tests/misc/projects/Issue3931/compile2.hxml

@@ -0,0 +1 @@
+--display Main2.hx@16

tests/misc/projects/Issue3931/compile2.hxml.stderr

@@ -0,0 +1,4 @@
+<list>
+<i n="A"><t></t><d></d></i>
+<i n="C"><t></t><d></d></i>
+</list>

tests/misc/projects/Issue3931/pack/A.hx

@@ -0,0 +1,5 @@
+package pack;
+
+class A { }
+
+class C { }

tests/misc/projects/Issue3931/pack/B.hx

@@ -0,0 +1 @@
+class B { }

typeload.ml

@@ -1597,12 +1597,6 @@ let patch_class ctx c fields =
 		in
 		List.rev (loop [] fields)
 
-let rec string_list_of_expr_path_raise (e,p) =
-	match e with
-	| EConst (Ident i) -> [i]
-	| EField (e,f) -> f :: string_list_of_expr_path_raise e
-	| _ -> raise Exit
-
 let string_list_of_expr_path (e,p) =
 	try string_list_of_expr_path_raise (e,p)
 	with Exit -> error "Invalid path" p

typer.ml

@@ -3809,7 +3809,7 @@ and handle_display ctx e_ast iscall p =
 			in
 			let fields = List.fold_left get_field [] fields in
 			let fields = try
-				let sl = Typeload.string_list_of_expr_path_raise e_ast in
+				let sl = string_list_of_expr_path_raise e_ast in
 				fields @ get_submodule_fields (List.tl sl,List.hd sl)
 			with Exit | Not_found ->
 				fields