allow retry of build of child class when parent not ready (close Haxe…

…Foundation#2117)

codegen.ml

@@ -198,7 +198,7 @@ let extend_remoting ctx c t p async prot =
 		error ("Module " ^ s_type_path path ^ " does not define type " ^ t.tname) p
 	) in
 	match t with
-	| TClassDecl c2 when c2.cl_params = [] -> c2.cl_build(); c.cl_super <- Some (c2,[]);
+	| TClassDecl c2 when c2.cl_params = [] -> ignore(c2.cl_build()); c.cl_super <- Some (c2,[]);
 	| _ -> error "Remoting proxy must be a class without parameters" p
 
 (* -------------------------------------------------------------------------- *)
@@ -325,7 +325,7 @@ let rec build_generic ctx c p tl =
 	with Error(Module_not_found path,_) when path = (pack,name) ->
 		let m = (try Hashtbl.find ctx.g.modules (Hashtbl.find ctx.g.types_module c.cl_path) with Not_found -> assert false) in
 		let ctx = { ctx with m = { ctx.m with module_types = m.m_types @ ctx.m.module_types } } in
-		c.cl_build(); (* make sure the super class is already setup *)
+		ignore(c.cl_build()); (* make sure the super class is already setup *)
 		let mg = {
 			m_id = alloc_mid();
 			m_path = (pack,name);
@@ -418,7 +418,7 @@ let rec build_generic ctx c p tl =
 						(* extended type parameter: concrete type must have a constructor, but generic base class must not have one *)
 						begin match follow t,c.cl_constructor with
 							| TInst(cs,_),None ->
-								cs.cl_build();
+								ignore(cs.cl_build());
 								begin match cs.cl_constructor with
 									| None -> error ("Cannot use " ^ (s_type_path cs.cl_path) ^ " as type parameter because it is extended and has no constructor") p
 									| _ -> ()
@@ -623,7 +623,7 @@ let build_macro_build ctx c pl cfl p =
 let build_instance ctx mtype p =
 	match mtype with
 	| TClassDecl c ->
-		if ctx.pass > PBuildClass then c.cl_build();
+		if ctx.pass > PBuildClass then ignore(c.cl_build());
 		let build f s =
 			let r = exc_protect ctx (fun r ->
 				let t = mk_mono() in

interp.ml

@@ -4435,7 +4435,7 @@ and encode_class_kind k =
 	enc_enum IClassKind tag pl
 
 and encode_tclass c =
-	c.cl_build();
+	ignore(c.cl_build());
 	encode_mtype (TClassDecl c) [
 		"kind", encode_class_kind c.cl_kind;
 		"isExtern", VBool c.cl_extern;

type.ml

@@ -204,7 +204,7 @@ and tclass = {
 	mutable cl_init : texpr option;
 	mutable cl_overrides : tclass_field list;
 
-	mutable cl_build : unit -> unit;
+	mutable cl_build : unit -> bool;
 	mutable cl_restore : unit -> unit;
 }
 
@@ -372,7 +372,7 @@ let mk_class m path pos =
 		cl_constructor = None;
 		cl_init = None;
 		cl_overrides = [];
-		cl_build = (fun() -> ());
+		cl_build = (fun() -> true);
 		cl_restore = (fun() -> ());
 	}
 

typeload.ml

@@ -1138,6 +1138,7 @@ let rec add_constructor ctx c force_constructor p =
 
 let set_heritance ctx c herits p =
 	let ctx = { ctx with curclass = c; type_params = c.cl_params; } in
+	let old_meta = c.cl_meta in
 	let process_meta csup =
 		List.iter (fun m ->
 			match m with
@@ -1146,6 +1147,16 @@ let set_heritance ctx c herits p =
 			| _ -> ()
 		) csup.cl_meta
 	in
+	let cancel_build csup =
+		(* for macros reason, our super class is not yet built - see #2177 *)
+		(* let's reset our build and delay it until we are done *)
+		c.cl_meta <- old_meta;
+		c.cl_array_access <- None;
+		c.cl_dynamic <- None;
+		c.cl_implements <- [];
+		c.cl_super <- None;
+		raise Exit
+	in
 	let has_interf = ref false in
 	let rec loop = function
 		| HPrivate | HExtern | HInterface ->
@@ -1154,7 +1165,7 @@ let set_heritance ctx c herits p =
 			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
-			csup.cl_build();
+			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;
@@ -1174,7 +1185,7 @@ let set_heritance ctx c herits p =
 				if c.cl_array_access <> None then error "Duplicate array access" p;
 				c.cl_array_access <- Some t
 			| TInst (intf,params) ->
-				intf.cl_build();
+				if not (intf.cl_build()) then cancel_build intf;
 				if is_parent c intf then error "Recursive class" p;
 				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;
@@ -2523,7 +2534,7 @@ let rec init_module_type ctx context_init do_init (decl,p) =
 				let name = (match name with None -> s | Some n -> n) in
 				match resolve_typedef t with
 				| TClassDecl c ->
-					c.cl_build();
+					ignore(c.cl_build());
 					ignore(PMap.find s c.cl_statics);
 					ctx.m.module_globals <- PMap.add name (TClassDecl c,s) ctx.m.module_globals
 				| TEnumDecl e ->
@@ -2579,7 +2590,7 @@ let rec init_module_type ctx context_init do_init (decl,p) =
 					match resolve_typedef t with
 					| TClassDecl c
 					| TAbstractDecl {a_impl = Some c} ->
-						c.cl_build();
+						ignore(c.cl_build());
 						PMap.iter (fun _ cf -> if not (has_meta Meta.NoImportGlobal cf.cf_meta) then ctx.m.module_globals <- PMap.add cf.cf_name (TClassDecl c,cf.cf_name) ctx.m.module_globals) c.cl_statics
 					| TEnumDecl e ->
 						PMap.iter (fun _ c -> if not (has_meta Meta.NoImportGlobal c.ef_meta) then ctx.m.module_globals <- PMap.add c.ef_name (TEnumDecl e,c.ef_name) ctx.m.module_globals) e.e_constrs
@@ -2624,18 +2635,28 @@ let rec init_module_type ctx context_init do_init (decl,p) =
 		if c.cl_path = (["haxe";"macro"],"MacroType") then c.cl_kind <- KMacroType;
 		c.cl_extern <- List.mem HExtern herits;
 		c.cl_interface <- List.mem HInterface herits;
-		let build() =
-			c.cl_build <- (fun()->());
-			set_heritance ctx c herits p;
-			init_class ctx c p do_init d.d_flags d.d_data;
-			List.iter (fun (_,t) -> ignore(follow t)) c.cl_params;
+		let rec build() =
+			c.cl_build <- (fun()-> false);
+			try
+				set_heritance ctx c herits p;
+				init_class ctx c p do_init d.d_flags d.d_data;
+				c.cl_build <- (fun()-> true);
+				List.iter (fun (_,t) -> ignore(follow t)) c.cl_params;
+				true;
+			with Exit ->
+				c.cl_build <- make_pass ctx build;
+				delay ctx PTypeField (fun() -> ignore(c.cl_build())); (* delay after PBuildClass, not very good but better than forgotten *)
+				false
+			| exn ->
+				c.cl_build <- (fun()-> true);
+				raise exn
 		in
 		ctx.pass <- PBuildClass;
 		ctx.curclass <- c;
 		c.cl_build <- make_pass ctx build;
 		ctx.pass <- PBuildModule;
 		ctx.curclass <- null_class;
-		delay ctx PBuildClass (fun() -> c.cl_build());
+		delay ctx PBuildClass (fun() -> ignore(c.cl_build()));
 	| EEnum d ->
 		let e = (match get_type d.d_name with TEnumDecl e -> e | _ -> assert false) in
 		let ctx = { ctx with type_params = e.e_params } in