reorganize class relation checks (closes #4671)

codegen.ml

@@ -705,15 +705,17 @@ let build_instance ctx mtype p =
 	| TAbstractDecl a ->
 		a.a_params, a.a_path, (fun tl -> TAbstract(a,tl))
 
-let on_inherit ctx c p h =
-	match h with
-	| HExtends { tpackage = ["haxe";"remoting"]; tname = "Proxy"; tparams = [TPType(CTPath t)] } ->
+let on_inherit ctx c p (is_extends,tp) =
+	if not is_extends then
+		true
+	else match tp with
+	| { tpackage = ["haxe";"remoting"]; tname = "Proxy"; tparams = [TPType(CTPath t)] } ->
 		extend_remoting ctx c t p false true;
 		false
-	| HExtends { tpackage = ["haxe";"remoting"]; tname = "AsyncProxy"; tparams = [TPType(CTPath t)] } ->
+	| { tpackage = ["haxe";"remoting"]; tname = "AsyncProxy"; tparams = [TPType(CTPath t)] } ->
 		extend_remoting ctx c t p true true;
 		false
-	| HExtends { tpackage = ["haxe";"xml"]; tname = "Proxy"; tparams = [TPExpr(EConst (String file),p);TPType t] } ->
+	| { tpackage = ["haxe";"xml"]; tname = "Proxy"; tparams = [TPExpr(EConst (String file),p);TPType t] } ->
 		extend_xml_proxy ctx c t file p;
 		true
 	| _ ->

tests/misc/projects/Issue4671/Main1.hx

@@ -0,0 +1,6 @@
+interface IFoo extends IBar{}
+interface IBar extends IFoo{}
+
+class Main1 {
+	static function main() { }
+}

tests/misc/projects/Issue4671/Main2.hx

@@ -0,0 +1,6 @@
+class A extends B { }
+class B extends A { }
+
+class Main1 {
+	static function main() { }
+}

tests/misc/projects/Issue4671/compile1-fail.hxml

@@ -0,0 +1,2 @@
+-main Main1
+--interp

tests/misc/projects/Issue4671/compile1-fail.hxml.stderr

@@ -0,0 +1 @@
+Main1.hx:1: characters 0-29 : Recursive class

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

@@ -0,0 +1,2 @@
+-main Main2
+--interp

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

@@ -0,0 +1 @@
+Main2.hx:1: characters 0-21 : Recursive class

typecore.ml

@@ -78,7 +78,7 @@ type typer_globals = {
 	delayed_macros : (unit -> unit) DynArray.t;
 	mutable global_using : tclass list;
 	(* api *)
-	do_inherit : typer -> Type.tclass -> Ast.pos -> Ast.class_flag -> bool;
+	do_inherit : typer -> Type.tclass -> Ast.pos -> (bool * Ast.type_path) -> bool;
 	do_create : Common.context -> typer;
 	do_macro : typer -> macro_mode -> path -> string -> Ast.expr list -> Ast.pos -> Ast.expr option;
 	do_load_module : typer -> path -> pos -> module_def;

typeload.ml

@@ -1398,15 +1398,33 @@ module Inheritance = struct
 			raise Exit
 		in
 		let has_interf = ref false in
-		let rec loop = function
-			| HPrivate | HExtern | HInterface ->
-				()
-			| HExtends t ->
+		(*
+			resolve imports before calling build_inheritance, since it requires full paths.
+			that means that typedefs are not working, but that's a fair limitation
+		*)
+		let resolve_imports t =
+			match t.tpackage with
+			| _ :: _ -> t
+			| [] ->
+				try
+					let find = List.find (fun lt -> snd (t_path lt) = t.tname) in
+					let lt = try find ctx.m.curmod.m_types with Not_found -> find ctx.m.module_types in
+					{ t with tpackage = fst (t_path lt) }
+				with
+					Not_found -> t
+		in
+		let herits = ExtList.List.filter_map (function
+			| HExtends t -> Some(true,resolve_imports t)
+			| HImplements t -> Some(false,resolve_imports t)
+			| t -> None
+		) herits in
+		let herits = List.filter (ctx.g.do_inherit ctx c p) herits in
+		(* Pass 1: Check and set relations *)
+		let fl = List.map (fun (is_extends,t) ->
+			let t = load_instance ctx t p false in
+			if is_extends then begin
 				if c.cl_super <> None then error "Cannot extend several classes" p;
-				let t = load_instance ctx t p false in
 				let csup,params = check_extends ctx c t p in
-				if not (csup.cl_build()) then cancel_build csup;
-				process_meta csup;
 				if c.cl_interface then begin
 					if not csup.cl_interface then error "Cannot extend by using a class" p;
 					c.cl_implements <- (csup,params) :: c.cl_implements;
@@ -1417,50 +1435,39 @@ module Inheritance = struct
 				end else begin
 					if csup.cl_interface then error "Cannot extend by using an interface" p;
 					c.cl_super <- Some (csup,params)
-				end
-			| HImplements t ->
-				let t = load_instance ctx t p false in
-				(match follow t with
+				end;
+				(fun () ->
+					if not (csup.cl_build()) then cancel_build csup;
+					process_meta csup;
+				)
+			end else begin match follow t with
 				| TInst ({ cl_path = [],"ArrayAccess"; cl_extern = true; },[t]) ->
 					if c.cl_array_access <> None then error "Duplicate array access" p;
-					c.cl_array_access <- Some t
+					c.cl_array_access <- Some t;
+					(fun () -> ())
 				| TInst (intf,params) ->
 					if is_parent c intf then error "Recursive class" p;
-					if not (intf.cl_build()) then cancel_build intf;
 					if c.cl_interface then error "Interfaces cannot implement another interface (use extends instead)" p;
 					if not intf.cl_interface then error "You can only implement an interface" p;
-					process_meta intf;
 					c.cl_implements <- (intf, params) :: c.cl_implements;
 					if not !has_interf && not is_lib && not (Meta.has (Meta.Custom "$do_not_check_interf") c.cl_meta) then begin
 						delay ctx PForce (fun() -> check_interfaces ctx c);
 						has_interf := true;
-					end
+					end;
+					(fun () ->
+						if not (intf.cl_build()) then cancel_build intf;
+						process_meta intf;
+					)
 				| TDynamic t ->
 					if c.cl_dynamic <> None then error "Cannot have several dynamics" p;
-					c.cl_dynamic <- Some t
-				| _ -> error "Should implement by using an interface" p)
-		in
-		(*
-			resolve imports before calling build_inheritance, since it requires full paths.
-			that means that typedefs are not working, but that's a fair limitation
-		*)
-		let resolve_imports t =
-			match t.tpackage with
-			| _ :: _ -> t
-			| [] ->
-				try
-					let find = List.find (fun lt -> snd (t_path lt) = t.tname) in
-					let lt = try find ctx.m.curmod.m_types with Not_found -> find ctx.m.module_types in
-					{ t with tpackage = fst (t_path lt) }
-				with
-					Not_found -> t
-		in
-		let herits = List.map (function
-			| HExtends t -> HExtends (resolve_imports t)
-			| HImplements t -> HImplements (resolve_imports t)
-			| h -> h
+					c.cl_dynamic <- Some t;
+					(fun () -> ())
+				| _ ->
+					error "Should implement by using an interface" p
+			end
 		) herits in
-		List.iter loop (List.filter (ctx.g.do_inherit ctx c p) herits)
+		(* Pass 2: Build classes and check metadata *)
+		List.iter (fun f -> f()) fl
 end
 
 let rec type_type_param ?(enum_constructor=false) ctx path get_params p tp =