[typer] fix typing deep inherited constructor (#9820)

src/core/tFunctions.ml

@@ -749,6 +749,12 @@ let quick_field_dynamic t s =
 	try quick_field t s
 	with Not_found -> FDynamic s
 
+let rec get_constructor_class c tl =
+	match c.cl_constructor, c.cl_super with
+	| Some cf, _ -> (cf,c,tl)
+	| None, None -> raise Not_found
+	| None, Some (csup,tlsup) -> get_constructor_class csup (List.map (apply_params c.cl_params tl) tlsup)
+
 let rec get_constructor c =
 	match c.cl_constructor, c.cl_super with
 	| Some c, _ -> c

src/generators/genjvm.ml

@@ -1879,17 +1879,14 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return
 				[jf#get_jsig]
 			)
 		| TNew(c,tl,el) ->
-			begin match get_constructor c with
-			| cf ->
-				begin match OverloadResolution.maybe_resolve_instance_overload true (apply_params c.cl_params tl) c cf el with
-				| None -> Error.error "Could not find overload" e.epos
-				| Some (c',cf,_) ->
-					let f () =
-						let tl,_ = self#call_arguments  cf.cf_type el in
-						tl
-					in
-					jm#construct ~no_value:(if not (need_val ret) then true else false) (get_construction_mode c' cf) c.cl_path f
-				end
+			begin match OverloadResolution.maybe_resolve_constructor_overload c tl el with
+			| None -> Error.error "Could not find overload" e.epos
+			| Some (c',cf,_) ->
+				let f () =
+					let tl,_ = self#call_arguments cf.cf_type el in
+					tl
+				in
+				jm#construct ~no_value:(if not (need_val ret) then true else false) (get_construction_mode c' cf) c.cl_path f
 			end
 		| TReturn None ->
 			self#emit_block_exits false;

src/typing/overloadResolution.ml

@@ -36,18 +36,7 @@ let unify_cf map_type c cf el =
 			None
 
 let find_overload map_type c cf el =
-	let matches = ref [] in
-	let rec loop cfl = match cfl with
-		| cf :: cfl ->
-			begin match unify_cf map_type c cf el with
-			| Some r -> matches := r :: !matches;
-			| None -> ()
-			end;
-			loop cfl
-		| [] ->
-			List.rev !matches
-	in
-	loop (cf :: cf.cf_overloads)
+	ExtList.List.filter_map (fun cf -> unify_cf map_type c cf el) (cf :: cf.cf_overloads)
 
 let filter_overloads candidates =
 	match Overloads.Resolution.reduce_compatible candidates with
@@ -86,10 +75,10 @@ let resolve_instance_overload is_ctor map_type c name el =
 			if has_class_field_flag cf CfOverload || cf.cf_overloads <> [] then raise Not_found
 		with Not_found ->
 			if (has_class_flag c CInterface) then
-				List.iter (fun (c,tl) -> loop (fun t -> apply_params c.cl_params (List.map map_type tl) t) c) c.cl_implements
+				List.iter (fun (c,tl) -> loop (apply_params c.cl_params (List.map map_type tl)) c) c.cl_implements
 			else match c.cl_super with
 			| None -> ()
-			| Some(c,tl) -> loop (fun t -> apply_params c.cl_params (List.map map_type tl) t) c
+			| Some(c,tl) -> loop (apply_params c.cl_params (List.map map_type tl)) c
 		end;
 	in
 	loop map_type c;
@@ -100,4 +89,8 @@ let maybe_resolve_instance_overload is_ctor map_type c cf el =
 		resolve_instance_overload is_ctor map_type c cf.cf_name el
 	else match unify_cf map_type c cf el with
 		| Some fcc -> Some (fcc.fc_data)
-		| None -> Some(c,cf,List.map snd cf.cf_params)
+		| None -> Some(c,cf,List.map snd cf.cf_params)
+
+let maybe_resolve_constructor_overload c tl el =
+	let cf,c,tl = get_constructor_class c tl in
+	maybe_resolve_instance_overload true (apply_params c.cl_params tl) c cf el

src/typing/typeloadFunction.ml

@@ -179,20 +179,10 @@ let type_function ctx args ret fmode e do_display p =
 	Std.finally save (type_function ctx args ret fmode e do_display) p
 
 let add_constructor ctx c force_constructor p =
-	let super() =
-		match c.cl_super with
-		| None -> None
-		| Some ({ cl_constructor = Some cfsup } as csup,cparams) ->
-			Some(cfsup,csup,cparams)
-		| Some (csup,cparams) ->
-			try
-				let cfsup = Type.get_constructor csup in
-				Some(cfsup,csup,cparams)
-			with Not_found ->
-				None
-	in
-	match c.cl_constructor, super() with
-	| None, Some(cfsup,csup,cparams) when not (has_class_flag c CExtern) ->
+	if c.cl_constructor <> None then () else
+	let constructor = try Some (Type.get_constructor_class c (List.map snd c.cl_params)) with Not_found -> None in
+	match constructor with
+	| Some(cfsup,csup,cparams) when not (has_class_flag c CExtern) ->
 		let cf = {
 			cfsup with
 			cf_pos = p;
@@ -254,7 +244,7 @@ let add_constructor ctx c force_constructor p =
 		) "add_constructor" in
 		cf.cf_type <- TLazy r;
 		c.cl_constructor <- Some cf;
-	| None,_ when force_constructor ->
+	| _ when force_constructor ->
 		let constr = mk (TFunction {
 			tf_args = [];
 			tf_type = ctx.t.tvoid;