Merge pull request #3764 from HaxeFoundation/generic_delay

Generic delay

codegen.ml

@@ -360,25 +360,36 @@ let rec build_generic ctx c p tl =
 			List.iter loop tl
 		in
 		List.iter loop tl;
-		let delays = ref [] in
-		let build_field f =
-			let t = generic_substitute_type gctx f.cf_type in
-			let f = { f with cf_type = t} in
-			(* delay the expression mapping to make sure all cf_type fields are set correctly first *)
-			(delays := (fun () ->
-				try (match f.cf_expr with
+		let build_field cf_old =
+			let cf_new = {cf_old with cf_pos = cf_old.cf_pos} in (* copy *)
+			let f () =
+				let t = generic_substitute_type gctx cf_old.cf_type in
+				ignore (follow t);
+				begin try (match cf_old.cf_expr with
 					| None ->
-						begin match f.cf_kind with
+						begin match cf_old.cf_kind with
 							| Method _ when not c.cl_interface && not c.cl_extern ->
-								display_error ctx (Printf.sprintf "Field %s has no expression (possible typing order issue)" f.cf_name) f.cf_pos;
+								display_error ctx (Printf.sprintf "Field %s has no expression (possible typing order issue)" cf_new.cf_name) cf_new.cf_pos;
 								display_error ctx (Printf.sprintf "While building %s" (s_type_path cg.cl_path)) p;
 							| _ ->
 								()
 						end
-					| Some e -> f.cf_expr <- Some (generic_substitute_expr gctx e)
+					| Some e ->
+						cf_new.cf_expr <- Some (generic_substitute_expr gctx e)
 				) with Unify_error l ->
-					error (error_msg (Unify l)) f.cf_pos) :: !delays);
-			f
+					error (error_msg (Unify l)) cf_new.cf_pos
+				end;
+				t
+			in
+			let r = exc_protect ctx (fun r ->
+				let t = mk_mono() in
+				r := (fun() -> t);
+				unify_raise ctx (f()) t p;
+				t
+			) "build_generic" in
+			delay ctx PForce (fun() -> ignore ((!r)()));
+			cf_new.cf_type <- TLazy r;
+			cf_new
 		in
 		if c.cl_init <> None || c.cl_dynamic <> None then error "This class can't be generic" p;
 		if c.cl_ordered_statics <> [] then error "A generic class can't have static fields" p;
@@ -396,7 +407,12 @@ let rec build_generic ctx c p tl =
 						let t = loop subst in
 						(* 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({cl_constructor = None} as cs,_),None -> error ("Cannot use " ^ (s_type_path cs.cl_path) ^ " as type parameter because it is extended and has no constructor") p
+							| TInst(cs,_),None ->
+								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
+									| _ -> ()
+								end;
 							| _,Some cf -> error "Generics extending type parameters cannot have constructors" cf.cf_pos
 							| _ -> ()
 						end;
@@ -417,7 +433,7 @@ let rec build_generic ctx c p tl =
 		cg.cl_kind <- KGenericInstance (c,tl);
 		cg.cl_interface <- c.cl_interface;
 		cg.cl_constructor <- (match cg.cl_constructor, c.cl_constructor, c.cl_super with
-			| _, Some c, _ -> Some (build_field c)
+			| _, Some cf, _ -> Some (build_field cf)
 			| Some ctor, _, _ -> Some ctor
 			| None, None, None -> None
 			| _ -> error "Please define a constructor for this class in order to use it as generic" c.cl_pos
@@ -432,7 +448,6 @@ let rec build_generic ctx c p tl =
 			cg.cl_fields <- PMap.add f.cf_name f cg.cl_fields;
 			f
 		) c.cl_ordered_fields;
-		List.iter (fun f -> f()) !delays;
 		TInst (cg,[])
 	end
 

tests/unit/src/unit/issues/Issue2085.hx

@@ -0,0 +1,22 @@
+package unit.issues;
+
+private class Object extends Node<Object,Ar<Object>> { }
+
+@:generic
+private class Node<T,Array_t:Ar<T>> {
+    public var ar:Array_t;
+}
+
+@:generic
+private class Ar<T> {
+    public var nongen:Array<T>;
+    public function length():Void {
+        nongen.length;
+    }
+}
+
+class Issue2085 extends Test {
+	function test() {
+
+	}
+}

tests/unit/src/unit/issues/Issue2902.hx

@@ -0,0 +1,26 @@
+package unit.issues;
+
+@:generic
+private class G<T> {
+	var t:T;
+	public function new(t:T) {
+		this.t = t;
+	}
+    public function f(){
+        haxe.Log;
+		return t;
+    }
+}
+
+private class G2 extends G<String> { }
+
+private class G1 extends G<Int> { }
+
+class Issue2902 extends Test {
+	function test() {
+		var g1 = new G1(12);
+		var g2 = new G2("foo");
+		eq(12, g1.f());
+		eq("foo", g2.f());
+	}
+}

tests/unit/src/unit/issues/Issue3557.hx

@@ -0,0 +1,26 @@
+package unit.issues;
+
+private class MyBaseClass {
+	public function new():Void {}
+}
+
+private class MyClass extends Generic<MyBaseClass> {
+	public function new():Void {
+		super();
+	}
+}
+
+private interface Interface {}
+
+@:generic
+private class Generic<Default:{ public function new():Void; }>
+	extends Default
+	implements Interface {}
+
+class Issue3557 extends Test {
+	function test() {
+		new MyBaseClass();
+		new Generic<MyBaseClass>();
+		new MyClass();
+	}
+}

tests/unit/src/unit/issues/Issue3615.hx

@@ -0,0 +1,26 @@
+package unit.issues;
+
+@:generic
+private class BaseClass<T>
+{
+    public function new()
+    {
+        haxe.Log;
+    }
+}
+
+private class SubClassOne extends BaseClass<Int>
+{
+    public function new() { super(); haxe.Log; }
+}
+
+private class SubClassTwo extends BaseClass<String>
+{
+    public function new() { super(); haxe.Log; }
+}
+
+class Issue3615 extends Test {
+	function test() {
+
+	}
+}