Valid redefinition rework (#11657)

* create type hole to see which tests fail

* pair up ttps during definition unification, then check constraints

* invert mapping to allow 1:N relationships

src/core/tUnification.ml

@@ -31,6 +31,14 @@ type eq_kind =
 	| EqDoNotFollowNull (* like EqStrict, but does not follow Null<T> *)
 	| EqStricter
 
+type type_param_unification_context = {
+	mutable type_param_pairs : (typed_type_param * typed_type_param) list;
+}
+
+type type_param_mode =
+	| TpDefault
+	| TpDefinition of type_param_unification_context
+
 type unification_context = {
 	allow_transitive_cast   : bool;
 	allow_abstract_cast     : bool; (* allows a non-transitive abstract cast (from,to,@:from,@:to) *)
@@ -39,6 +47,7 @@ type unification_context = {
 	equality_kind           : eq_kind;
 	equality_underlying     : bool;
 	strict_field_kind       : bool;
+	type_param_mode         : type_param_mode;
 }
 
 type unify_min_result =
@@ -64,6 +73,7 @@ let default_unification_context = {
 	equality_kind           = EqStrict;
 	equality_underlying     = false;
 	strict_field_kind       = false;
+	type_param_mode         = TpDefault;
 }
 
 (* Unify like targets (e.g. Java) probably would. *)
@@ -75,6 +85,7 @@ let native_unification_context = {
 	equality_underlying   = false;
 	allow_arg_name_mismatch = true;
 	strict_field_kind       = false;
+	type_param_mode         = TpDefault;
 }
 
 module Monomorph = struct
@@ -519,6 +530,7 @@ let rec_stack stack value fcheck frun ferror =
 let rec_stack_default stack value fcheck frun def =
 	if not (rec_stack_exists fcheck stack) then rec_stack_loop stack value frun () else def
 
+
 let rec type_eq uctx a b =
 	let param = uctx.equality_kind in
 	let can_follow_null = match param with
@@ -575,6 +587,9 @@ let rec type_eq uctx a b =
 	| TEnum (e1,tl1) , TEnum (e2,tl2) ->
 		if e1 != e2 && not (param = EqCoreType && e1.e_path = e2.e_path) then error [cannot_unify a b];
 		type_eq_params uctx a b tl1 tl2
+	| TInst ({cl_kind = KTypeParameter ttp1},tl1) , TInst ({cl_kind = KTypeParameter ttp2},tl2) when param <> EqCoreType ->
+		assign_type_params uctx ttp1 ttp2;
+		type_eq_params uctx a b tl1 tl2
 	| TInst (c1,tl1) , TInst (c2,tl2) ->
 		if c1 != c2 && not (param = EqCoreType && c1.cl_path = c2.cl_path) && (match c1.cl_kind, c2.cl_kind with KExpr _, KExpr _ -> false | _ -> true) then error [cannot_unify a b];
 		type_eq_params uctx a b tl1 tl2
@@ -636,6 +651,19 @@ let rec type_eq uctx a b =
 	| _ , _ ->
 		error [cannot_unify a b]
 
+and assign_type_params uctx ttp1 ttp2 =
+	if ttp1 != ttp2 then begin match uctx.type_param_mode with
+		| TpDefault ->
+			error []
+		| TpDefinition tctx ->
+			begin try
+				let ttp3 = List.assq ttp2 tctx.type_param_pairs in
+				if ttp1 != ttp3 then error []
+			with Not_found ->
+				tctx.type_param_pairs <- (ttp2,ttp1) :: tctx.type_param_pairs
+			end
+	end
+
 and type_eq_params uctx a b tl1 tl2 =
 	let i = ref 0 in
 	List.iter2 (fun t1 t2 ->
@@ -732,6 +760,9 @@ let rec unify (uctx : unification_context) a b =
 		unify_to {uctx with allow_transitive_cast = false} a b ab tl
 	| TAbstract (a1,tl1) , TAbstract (a2,tl2) ->
 		unify_abstracts uctx a b a1 tl1 a2 tl2
+	| TInst ({cl_kind = KTypeParameter ttp1},tl1) , TInst ({cl_kind = KTypeParameter ttp2},tl2) when uctx.type_param_mode != TpDefault ->
+		assign_type_params uctx ttp1 ttp2;
+		unify_type_params uctx a b tl1 tl2;
 	| TInst (c1,tl1) , TInst (c2,tl2) ->
 		let rec loop c tl =
 			if c == c2 then begin

src/typing/tanon_identification.ml

@@ -69,6 +69,7 @@ object(self)
 			equality_kind = EqStricter;
 			equality_underlying = false;
 			strict_field_kind = true;
+			type_param_mode = TpDefault;
 		} else {default_unification_context with equality_kind = EqDoNotFollowNull} in
 
 		let check () =

src/typing/typeloadCheck.ml

@@ -48,8 +48,12 @@ let is_generic_parameter ctx c =
 		false
 
 let valid_redefinition map1 map2 f1 t1 f2 t2 = (* child, parent *)
+	let tctx = {
+		type_param_pairs = [];
+	} in
+	let uctx = {default_unification_context with type_param_mode = TpDefinition tctx} in
 	let valid t1 t2 =
-		Type.unify t1 t2;
+		unify_custom uctx t1 t2;
 		if is_null t1 <> is_null t2 || ((follow t1) == t_dynamic && (follow t2) != t_dynamic) then raise (Unify_error [Cannot_unify (t1,t2)]);
 	in
 	begin match PurityState.get_purity_from_meta f2.cf_meta,PurityState.get_purity_from_meta f1.cf_meta with
@@ -57,40 +61,7 @@ let valid_redefinition map1 map2 f1 t1 f2 t2 = (* child, parent *)
 		| PurityState.ExpectPure p,PurityState.MaybePure -> f1.cf_meta <- (Meta.Pure,[EConst(Ident "expect"),p],null_pos) :: f1.cf_meta
 		| _ -> ()
 	end;
-	let t1, t2 = (match f1.cf_params, f2.cf_params with
-		| [], [] -> t1, t2
-		| l1, l2 when List.length l1 = List.length l2 ->
-			let to_check = ref [] in
-			(* TPTODO: defaults *)
-			let monos = List.map2 (fun ttp1 ttp2 ->
-				let ct1 = get_constraints ttp1 in
-				let ct2 = get_constraints ttp2 in
-				(match ct1, ct2 with
-				| [], [] -> ()
-				| _, _ when List.length ct1 = List.length ct2 ->
-					(* if same constraints, they are the same type *)
-					let check monos =
-						List.iter2 (fun t1 t2  ->
-							try
-								let t1 = apply_params l1 monos (map2 t1) in
-								let t2 = apply_params l2 monos (map1 t2) in
-								type_eq EqStrict t1 t2
-							with Unify_error l ->
-								raise (Unify_error (Unify_custom "Constraints differ" :: l))
-						) ct1 ct2
-					in
-					to_check := check :: !to_check;
-				| _ ->
-					raise (Unify_error [Unify_custom "Different number of constraints"]));
-				TInst (mk_class null_module ([],ttp1.ttp_name) null_pos null_pos,[])
-			) l1 l2 in
-			List.iter (fun f -> f monos) !to_check;
-			apply_params l1 monos t1, apply_params l2 monos t2
-		| _  ->
-			(* ignore type params, will create other errors later *)
-			t1, t2
-	) in
-	match f1.cf_kind,f2.cf_kind with
+	begin match f1.cf_kind,f2.cf_kind with
 	| Method m1, Method m2 when not (m1 = MethDynamic) && not (m2 = MethDynamic) ->
 		begin match follow t1, follow t2 with
 		| TFun (args1,r1) , TFun (args2,r2) -> (
@@ -122,6 +93,25 @@ let valid_redefinition map1 map2 f1 t1 f2 t2 = (* child, parent *)
 		(* in case args differs, or if an interface var *)
 		type_eq EqStrict t1 t2;
 		if is_null t1 <> is_null t2 then raise (Unify_error [Cannot_unify (t1,t2)])
+	end;
+	let assign_ttp ttp1 ttp2 =
+		let ct1 = get_constraints ttp1 in
+		let ct2 = get_constraints ttp2 in
+		match ct1,ct2 with
+		| _,[] ->
+			()
+		| [],(t2 :: _) ->
+			raise (Unify_error ([Unify_custom (Printf.sprintf "Constraint unsatisfied for type parameter %s: %s" ttp2.ttp_name (s_type (print_context()) t2))]))
+		| ct1,ct2 ->
+			List.iter (fun t2 ->
+				let t2 = map2 t2 in
+				if not (List.exists (fun t1 -> does_unify (map1 t1) t2) ct1) then
+					raise (Unify_error ([Unify_custom (Printf.sprintf "Constraint unsatisfied for type parameter %s: %s" ttp2.ttp_name (s_type (print_context()) t2))]))
+			) ct2
+	in
+	List.iter (fun (ttp1,ttp2) ->
+		assign_ttp ttp2 ttp1
+	) tctx.type_param_pairs
 
 let copy_meta meta_src meta_target sl =
 	let meta = ref meta_target in

tests/misc/projects/Issue11411/MainArgumentVarianceBad.hx

@@ -0,0 +1,14 @@
+class Parent {}
+class Child extends Parent {}
+
+interface I {
+    public function test<T:Parent>(t:T):Void;
+}
+
+class C implements I {
+    public function test<T:Child>(t:T) { }
+}
+
+function main() {
+
+}

tests/misc/projects/Issue11411/MainArgumentVarianceGood.hx

@@ -0,0 +1,14 @@
+class Parent {}
+class Child extends Parent {}
+
+interface I {
+    public function test<T:Child>(t:T):Void;
+}
+
+class C implements I {
+    public function test<T:Parent>(t:T) { }
+}
+
+function main() {
+
+}

tests/misc/projects/Issue11411/MainArgumentVarianceMissingBad.hx

@@ -0,0 +1,14 @@
+class Parent {}
+class Child extends Parent {}
+
+interface I {
+    public function test<T>(t:T):Void;
+}
+
+class C implements I {
+    public function test<T:Child>(t:T) { }
+}
+
+function main() {
+
+}

tests/misc/projects/Issue11411/MainArgumentVarianceMissingGood.hx

@@ -0,0 +1,14 @@
+class Parent {}
+class Child extends Parent {}
+
+interface I {
+    public function test<T:Child>(t:T):Void;
+}
+
+class C implements I {
+    public function test<T>(t:T) { }
+}
+
+function main() {
+
+}

tests/misc/projects/Issue11411/MainInterfaceUnion.hx

@@ -0,0 +1,13 @@
+interface A {}
+interface B {}
+class C implements A implements B {}
+
+class Parent {
+	function f<TC:C>(a:TC, b:TC) {}
+}
+
+class Child extends Parent {
+	override function f<TA:A, TB:B>(a:TA, b:TB) {}
+}
+
+function main() {}

tests/misc/projects/Issue11411/MainNoVariance.hx

@@ -0,0 +1,11 @@
+interface I {
+    public function test<T>():Void;
+}
+
+class C implements I {
+    public function test<T:String>() { }
+}
+
+function main() {
+
+}

tests/misc/projects/Issue11411/MainReturnVarianceBad.hx

@@ -0,0 +1,16 @@
+class Parent {}
+class Child extends Parent {}
+
+interface I {
+    public function test<T:Child>():T;
+}
+
+class C implements I {
+    public function test<T:Parent>():T {
+		return null;
+	}
+}
+
+function main() {
+
+}

tests/misc/projects/Issue11411/MainReturnVarianceGood.hx

@@ -0,0 +1,16 @@
+class Parent {}
+class Child extends Parent {}
+
+interface I {
+    public function test<T:Parent>():T;
+}
+
+class C implements I {
+    public function test<T:Child>():T {
+		return null;
+	}
+}
+
+function main() {
+
+}

tests/misc/projects/Issue11411/MainReturnVarianceMissingBad.hx

@@ -0,0 +1,16 @@
+class Parent {}
+class Child extends Parent {}
+
+interface I {
+    public function test<T:Child>():T;
+}
+
+class C implements I {
+    public function test<T>():T {
+		return null;
+	}
+}
+
+function main() {
+
+}

tests/misc/projects/Issue11411/MainReturnVarianceMissingGood.hx

@@ -0,0 +1,16 @@
+class Parent {}
+class Child extends Parent {}
+
+interface I {
+    public function test<T>():T;
+}
+
+class C implements I {
+    public function test<T:Child>():T {
+		return null;
+	}
+}
+
+function main() {
+
+}

tests/misc/projects/Issue11411/compile-argument-variance-bad-fail.hxml

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

tests/misc/projects/Issue11411/compile-argument-variance-good.hxml

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

tests/misc/projects/Issue11411/compile-argument-variance-missing-bad-fail.hxml

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

tests/misc/projects/Issue11411/compile-argument-variance-missing-good.hxml

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

tests/misc/projects/Issue11411/compile-interface-union.hxml

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

tests/misc/projects/Issue11411/compile-no-variance.hxml

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

tests/misc/projects/Issue11411/compile-return-variance-bad-fail.hxml

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

tests/misc/projects/Issue11411/compile-return-variance-good.hxml

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

tests/misc/projects/Issue11411/compile-return-variance-missing-bad-fail.hxml

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

tests/misc/projects/Issue11411/compile-return-variance-missing-good.hxml

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