[typer] rework Constructible handling

closes #6714

src/typing/typer.ml

@@ -1767,9 +1767,13 @@ and type_new ctx path el with_type force_inline p =
 	try begin match t with
 	| TInst ({cl_kind = KTypeParameter tl} as c,params) ->
 		if not (TypeloadCheck.is_generic_parameter ctx c) then error "Only generic type parameters can be constructed" p;
-		let el = List.map (fun e -> type_expr ctx e WithType.value) el in
- 		if not (has_constructible_constraint ctx tl el p) then raise_error (No_constructor (TClassDecl c)) p;
-		mk (TNew (c,params,el)) t p
+ 		begin match get_constructible_constraint ctx tl p with
+		| None ->
+			raise_error (No_constructor (TClassDecl c)) p
+		| Some(tl,tr) ->
+			let el,_ = unify_call_args ctx el tl tr p false false in
+			mk (TNew (c,params,el)) t p
+		end
 	| TAbstract({a_impl = Some c} as a,tl) when not (Meta.has Meta.MultiType a.a_meta) ->
 		let el,cf,ct = build_constructor_call c tl in
 		let ta = TAnon { a_fields = c.cl_statics; a_status = ref (Statics c) } in

src/typing/typerBase.ml

@@ -148,20 +148,33 @@ let s_access_kind acc =
 	| AKAccess(a,tl,c,e1,e2) -> Printf.sprintf "AKAccess(%s, [%s], %s, %s, %s)" (s_type_path a.a_path) (String.concat ", " (List.map st tl)) (s_type_path c.cl_path) (se e1) (se e2)
 	| AKFieldSet(_) -> ""
 
-let has_constructible_constraint ctx tl el p =
-	let ct = (tfun (List.map (fun e -> e.etype) el) ctx.t.tvoid) in
-	let rec loop t = match follow t with
-		| TAnon a ->
-			(try
-				unify ctx (PMap.find "new" a.a_fields).cf_type ct p;
-				true
-			with Not_found ->
-					false)
-		| TAbstract({a_path = ["haxe"],"Constructible"},_) -> true
-		| TInst({cl_kind = KTypeParameter tl},_) -> List.exists loop tl
-		| _ -> false
+let get_constructible_constraint ctx tl p =
+	let extract_function t = match follow t with
+		| TFun(tl,tr) -> tl,tr
+		| _ -> error "Constructible type parameter should be function" p
+	in
+	let rec loop tl = match tl with
+		| [] -> None
+		| t :: tl ->
+			begin match follow t with
+			| TAnon a ->
+				begin try
+					Some (extract_function (PMap.find "new" a.a_fields).cf_type);
+				with Not_found ->
+					loop tl
+				end;
+			| TAbstract({a_path = ["haxe"],"Constructible"},[t1]) ->
+				Some (extract_function t1)
+			| TInst({cl_kind = KTypeParameter tl1},_) ->
+				begin match loop tl1 with
+				| None -> loop tl
+				| Some _ as t -> t
+				end
+			| _ ->
+				loop tl
+			end
 	in
-	List.exists loop tl
+	loop tl
 
 let unify_static_extension ctx e t p =
 	let multitype_involed t1 t2 =

src/typing/typerDisplay.ml

@@ -488,7 +488,7 @@ let handle_display ctx e_ast dk with_type =
 						false
 					end
 				end
-			| ITTypeParameter {cl_kind = KTypeParameter tl} when has_constructible_constraint ctx tl [] null_pos ->
+			| ITTypeParameter {cl_kind = KTypeParameter tl} when get_constructible_constraint ctx tl null_pos <> None ->
 				true
 			| _ -> false
 		) l in

tests/misc/projects/Issue6714/Main.hx

@@ -0,0 +1,19 @@
+import haxe.Constraints;
+
+class Main {
+	static public function main() {
+		create(C);
+	}
+
+	@:generic
+	public static function create<T:Constructible<(a:Bool)->Void>>(type:Class<T>):Void {
+		var string = new T("test");
+		var bool = new T(true);
+	}
+}
+
+class C {
+	public function new(a:Bool) {
+
+	}
+}

tests/misc/projects/Issue6714/compile-fail.hxml

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

tests/misc/projects/Issue6714/compile-fail.hxml.stderr

@@ -0,0 +1,2 @@
+Main.hx:10: characters 22-28 : String should be Bool
+Main.hx:10: characters 22-28 : For function argument 'a'