Browse Source

fix error emitting on `inlineCall() = value` (#8518)

Aleksandr Kuzmenko 6 years ago
parent
commit
1047c455ef

+ 1 - 1
src/compiler/main.ml

@@ -884,7 +884,7 @@ try
 		Common.log com ("Classpath: " ^ (String.concat ";" com.class_path));
 		Common.log com ("Defines: " ^ (String.concat ";" (PMap.foldi (fun k v acc -> (match v with "1" -> k | _ -> k ^ "=" ^ v) :: acc) com.defines.Define.values [])));
 		let t = Timer.timer ["typing"] in
-		Typecore.type_expr_ref := (fun ctx e with_type -> Typer.type_expr ctx e with_type);
+		Typecore.type_expr_ref := (fun ?(mode=MGet) ctx e with_type -> Typer.type_expr ~mode ctx e with_type);
 		let tctx = Typer.create com in
 		let add_signature desc =
 			Option.may (fun cs -> CompilationServer.maybe_add_context_sign cs com desc) (CompilationServer.get ());

+ 7 - 2
src/context/typecore.ml

@@ -44,6 +44,11 @@ type macro_mode =
 	| MMacroType
 	| MDisplay
 
+type access_mode =
+	| MGet
+	| MSet
+	| MCall
+
 type typer_pass =
 	| PBuildModule			(* build the module structure and setup module type parameters *)
 	| PBuildClass			(* build the class structure *)
@@ -133,7 +138,7 @@ exception Forbid_package of (string * path * pos) * pos list * string
 exception WithTypeError of error_msg * pos
 
 let make_call_ref : (typer -> texpr -> texpr list -> t -> ?force_inline:bool -> pos -> texpr) ref = ref (fun _ _ _ _ ?force_inline:bool _ -> assert false)
-let type_expr_ref : (typer -> expr -> WithType.t -> texpr) ref = ref (fun _ _ _ -> assert false)
+let type_expr_ref : (?mode:access_mode -> typer -> expr -> WithType.t -> texpr) ref = ref (fun ?(mode=MGet) _ _ _ -> assert false)
 let type_block_ref : (typer -> expr list -> WithType.t -> pos -> texpr) ref = ref (fun _ _ _ _ -> assert false)
 let unify_min_ref : (typer -> texpr list -> t) ref = ref (fun _ _ -> assert false)
 let analyzer_run_on_expr_ref : (Common.context -> texpr -> texpr) ref = ref (fun _ _ -> assert false)
@@ -153,7 +158,7 @@ let display_error ctx msg p = match ctx.com.display.DisplayMode.dms_error_policy
 
 let make_call ctx e el t p = (!make_call_ref) ctx e el t p
 
-let type_expr ctx e with_type = (!type_expr_ref) ctx e with_type
+let type_expr ?(mode=MGet) ctx e with_type = (!type_expr_ref) ~mode ctx e with_type
 
 let unify_min ctx el = (!unify_min_ref) ctx el
 

+ 3 - 1
src/core/error.ml

@@ -289,4 +289,6 @@ let error_require r p =
 	with _ ->
 		"'" ^ r ^ "' to be enabled"
 	in
-	error ("Accessing this field requires " ^ r) p
+	error ("Accessing this field requires " ^ r) p
+
+let invalid_assign p = error "Invalid assign" p

+ 12 - 7
src/typing/calls.ml

@@ -538,11 +538,14 @@ let rec acc_get ctx g p =
 	| AKMacro _ ->
 		assert false
 
-let rec build_call ctx acc el (with_type:WithType.t) p =
+let rec build_call ?(mode=MGet) ctx acc el (with_type:WithType.t) p =
+	let check_assign () = if mode = MSet then invalid_assign p in
 	match acc with
 	| AKInline (ethis,f,fmode,t) when Meta.has Meta.Generic f.cf_meta ->
+		check_assign();
 		type_generic_function ctx (ethis,fmode) el with_type p
 	| AKInline (ethis,f,fmode,t) ->
+		check_assign();
 		(match follow t with
 			| TFun (args,r) ->
 				let _,_,mk_call = unify_field_call ctx fmode el args r p true in
@@ -551,6 +554,7 @@ let rec build_call ctx acc el (with_type:WithType.t) p =
 				error (s_type (print_context()) t ^ " cannot be called") p
 		)
 	| AKUsing (et,cl,ef,eparam,forced_inline (* TOOD? *)) when Meta.has Meta.Generic ef.cf_meta ->
+		check_assign();
 		(match et.eexpr with
 		| TField(ec,fa) ->
 			type_generic_function ctx (ec,fa) el ~using_param:(Some eparam) with_type p
@@ -560,10 +564,11 @@ let rec build_call ctx acc el (with_type:WithType.t) p =
 		| Method MethMacro ->
 			let ethis = type_module_type ctx (TClassDecl cl) None p in
 			let eparam,f = push_this ctx eparam in
-			let e = build_call ctx (AKMacro (ethis,ef)) (eparam :: el) with_type p in
+			let e = build_call ~mode ctx (AKMacro (ethis,ef)) (eparam :: el) with_type p in
 			f();
 			e
 		| _ ->
+			check_assign();
 			let t = follow (field_type ctx cl [] ef p) in
 			(* for abstracts we have to apply their parameters to the static function *)
 			let t,tthis = match follow eparam.etype with
@@ -590,11 +595,11 @@ let rec build_call ctx acc el (with_type:WithType.t) p =
 		let f = (match ethis.eexpr with
 		| TTypeExpr (TClassDecl c) ->
 			(match ctx.g.do_macro ctx MExpr c.cl_path cf.cf_name el p with
-			| None -> (fun() -> type_expr ctx (EConst (Ident "null"),p) WithType.value)
+			| None -> (fun() -> type_expr ~mode ctx (EConst (Ident "null"),p) WithType.value)
 			| Some (EMeta((Meta.MergeBlock,_,_),(EBlock el,_)),_) -> (fun () -> let e = (!type_block_ref) ctx el with_type p in mk (TMeta((Meta.MergeBlock,[],p), e)) e.etype e.epos)
-			| Some e -> (fun() -> type_expr ctx e with_type))
+			| Some e -> (fun() -> type_expr ~mode ctx e with_type))
 		| _ ->
-			(* member-macro call : since we will make a static call, let's found the actual class and not its subclass *)
+			(* member-macro call : since we will make a static call, let's find the actual class and not its subclass *)
 			(match follow ethis.etype with
 			| TInst (c,_) ->
 				let rec loop c =
@@ -602,8 +607,8 @@ let rec build_call ctx acc el (with_type:WithType.t) p =
 						let eparam,f = push_this ctx ethis in
 						ethis_f := f;
 						let e = match ctx.g.do_macro ctx MExpr c.cl_path cf.cf_name (eparam :: el) p with
-							| None -> (fun() -> type_expr ctx (EConst (Ident "null"),p) WithType.value)
-							| Some e -> (fun() -> type_expr ctx e WithType.value)
+							| None -> (fun() -> type_expr ~mode ctx (EConst (Ident "null"),p) WithType.value)
+							| Some e -> (fun() -> type_expr ~mode ctx e WithType.value)
 						in
 						e
 					else

+ 1 - 1
src/typing/matcher.ml

@@ -39,7 +39,7 @@ let make_offset_list left right middle other =
 	(ExtList.List.make left other) @ [middle] @ (ExtList.List.make right other)
 
 let type_field_access ctx ?(resume=false) e name =
-	Calls.acc_get ctx (Fields.type_field (Fields.TypeFieldConfig.create resume) ctx e name e.epos TyperBase.MGet) e.epos
+	Calls.acc_get ctx (Fields.type_field (Fields.TypeFieldConfig.create resume) ctx e name e.epos MGet) e.epos
 
 let unapply_type_parameters params monos =
 	List.iter2 (fun (_,t1) t2 -> match t2,follow t2 with TMono m1,TMono m2 when m1 == m2 -> Type.unify t1 t2 | _ -> ()) params monos

+ 8 - 8
src/typing/typer.ml

@@ -42,7 +42,7 @@ let check_assign ctx e =
 	| TConst TThis | TTypeExpr _ when ctx.untyped ->
 		()
 	| _ ->
-		error "Invalid assign" e.epos
+		invalid_assign e.epos
 
 type type_class =
 	| KInt
@@ -1431,7 +1431,7 @@ and type_access ctx e p mode =
 		let resume_typing = type_expr ~mode in
 		AKExpr (TyperDisplay.handle_edisplay ~resume_typing ctx e dk WithType.value)
 	| _ ->
-		AKExpr (type_expr ctx (e,p) WithType.value)
+		AKExpr (type_expr ~mode ctx (e,p) WithType.value)
 
 and type_array_access ctx e1 e2 p mode =
 	let e1 = type_expr ctx e1 WithType.value in
@@ -2248,11 +2248,11 @@ and type_if ctx e e1 e2 with_type p =
 		in
 		mk (TIf (e,e1,Some e2)) t p)
 
-and type_meta ctx m e1 with_type p =
+and type_meta ?(mode=MGet) ctx m e1 with_type p =
 	if ctx.is_display_file then DisplayEmitter.check_display_metadata ctx [m];
 	let old = ctx.meta in
 	ctx.meta <- m :: ctx.meta;
-	let e () = type_expr ctx e1 with_type in
+	let e () = type_expr ~mode ctx e1 with_type in
 	let e = match m with
 		| (Meta.ToString,_,_) ->
 			let e = e() in
@@ -2334,10 +2334,10 @@ and type_call_target ctx e with_type inline p =
 		| _ ->
 			e
 
-and type_call ctx e el (with_type:WithType.t) inline p =
+and type_call ?(mode=MGet) ctx e el (with_type:WithType.t) inline p =
 	let def () =
 		let e = type_call_target ctx e with_type inline p in
-		build_call ctx e el with_type p
+		build_call ~mode ctx e el with_type p
 	in
 	match e, el with
 	| (EConst (Ident "trace"),p) , e :: el ->
@@ -2511,7 +2511,7 @@ and type_expr ?(mode=MGet) ctx (e,p) (with_type:WithType.t) =
 		let e = type_expr ctx e WithType.value in
 		mk (TThrow e) (mk_mono()) p
 	| ECall (e,el) ->
-		type_call ctx e el with_type false p
+		type_call ~mode ctx e el with_type false p
 	| ENew (t,el) ->
 		type_new ctx t el with_type false p
 	| EUnop (op,flag,e) ->
@@ -2544,7 +2544,7 @@ and type_expr ?(mode=MGet) ctx (e,p) (with_type:WithType.t) =
 		let e = AbstractCast.cast_or_unify ctx t e p in
 		if e.etype == t then e else mk (TCast (e,None)) t p
 	| EMeta (m,e1) ->
-		type_meta ctx m e1 with_type p
+		type_meta ~mode ctx m e1 with_type p
 
 (* ---------------------------------------------------------------------- *)
 (* TYPER INITIALIZATION *)

+ 0 - 5
src/typing/typerBase.ml

@@ -4,11 +4,6 @@ open Type
 open Typecore
 open Error
 
-type access_mode =
-	| MGet
-	| MSet
-	| MCall
-
 type access_kind =
 	| AKNo of string
 	| AKExpr of texpr

+ 7 - 0
tests/misc/projects/Issue8517/Fail.hx

@@ -0,0 +1,7 @@
+class Main {
+	public static function main():Void {
+		Macro.notAssignable() = 2;
+		Foo.bar() = 2;
+		Foo.bar() += 2;
+	}
+}

+ 4 - 0
tests/misc/projects/Issue8517/Foo.hx

@@ -0,0 +1,4 @@
+class Foo {
+	static public var a:Int;
+	static public inline function bar():Int return a;
+}

+ 4 - 0
tests/misc/projects/Issue8517/Macro.hx

@@ -0,0 +1,4 @@
+class Macro {
+	macro static public function assignable() return macro Foo.a;
+	macro static public function notAssignable() return macro Foo.bar();
+}

+ 5 - 0
tests/misc/projects/Issue8517/Main.hx

@@ -0,0 +1,5 @@
+class Main {
+	public static function main():Void {
+		Macro.assignable() = 2;
+	}
+}

+ 1 - 0
tests/misc/projects/Issue8517/compile-fail.hxml

@@ -0,0 +1 @@
+-main Fail

+ 4 - 0
tests/misc/projects/Issue8517/compile-fail.hxml.stderr

@@ -0,0 +1,4 @@
+Macro.hx:3: characters 60-69 : Invalid assign
+Fail.hx:1: lines 1-7 : Defined in this class
+Fail.hx:4: characters 3-12 : Invalid assign
+Fail.hx:5: characters 3-12 : Invalid assign

+ 1 - 0
tests/misc/projects/Issue8517/compile.hxml

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