Split up `check_overriding` (#11415)

* parity

* don't check overloads multiple times

src/typing/typeloadCheck.ml

@@ -165,71 +165,102 @@ let check_native_name_override ctx child base =
 			error base.cf_name_pos child_pos
 	with Not_found -> ()
 
+type redefinition_context = {
+	c_new : tclass;
+	cf_new : tclass_field;
+	c_old : tclass;
+	cf_old : tclass_field;
+	map : Type.t -> Type.t;
+	t_old : Type.t;
+}
+
+let check_override_field ctx p rctx =
+	let i = rctx.cf_new.cf_name in
+	let f_has_override = has_class_field_flag rctx.cf_new CfOverride in
+	check_native_name_override ctx rctx.cf_new rctx.cf_old;
+	(* allow to define fields that are not defined for this platform version in superclass *)
+	(match rctx.cf_new.cf_kind with
+	| Var { v_read = AccRequire _ } -> raise Not_found;
+	| _ -> ());
+	if has_class_field_flag rctx.cf_old CfAbstract then begin
+		if f_has_override then
+			display_error ctx.com ("Field " ^ i ^ " is declared 'override' but parent field " ^ i ^ " is 'abstract' and does not provide any implementation to override") p
+		else
+			add_class_field_flag rctx.cf_new CfOverride (* our spec requires users to not "override" abstract functions, but our implementation depends on implementations to be declared with "override" ¯\_(ツ)_/¯ *)
+	end;
+	if (has_class_field_flag rctx.cf_old CfOverload && not (has_class_field_flag rctx.cf_new CfOverload)) then
+		display_error ctx.com ("Field " ^ i ^ " should be declared with overload since it was already declared as overload in superclass") p
+	else if not f_has_override && not (has_class_field_flag rctx.cf_old CfAbstract) then begin
+		if has_class_flag rctx.c_new CExtern then add_class_field_flag rctx.cf_new CfOverride
+		else display_error ctx.com ("Field " ^ i ^ " should be declared with 'override' since it is inherited from superclass " ^ s_type_path rctx.c_old.cl_path) p
+	end else if not (has_class_field_flag rctx.cf_new CfPublic) && (has_class_field_flag rctx.cf_old CfPublic) then
+		display_error ctx.com ("Field " ^ i ^ " has less visibility (public/private) than superclass one") p
+	else (match rctx.cf_new.cf_kind, rctx.cf_old.cf_kind with
+	| _, Method MethInline ->
+		display_error ctx.com ("Field " ^ i ^ " is inlined and cannot be overridden") p
+	| a, b when a = b -> ()
+	| Method MethInline, Method MethNormal ->
+		() (* allow to redefine a method as inlined *)
+	| _ ->
+		display_error ctx.com ("Field " ^ i ^ " has different property access than in superclass") p);
+	if (has_class_field_flag rctx.cf_old CfFinal) then display_error ctx.com ("Cannot override final method " ^ i) p;
+	try
+		valid_redefinition ctx rctx.map rctx.map rctx.cf_new rctx.cf_new.cf_type rctx.cf_old rctx.t_old;
+	with
+		Unify_error l ->
+			(* TODO construct error with sub *)
+			display_error ctx.com ("Field " ^ i ^ " overrides parent class with different or incomplete type") p;
+			display_error ~depth:1 ctx.com (compl_msg "Base field is defined here") rctx.cf_old.cf_name_pos;
+			display_error ~depth:1 ctx.com (compl_msg (error_msg (Unify l))) p
+
+let find_override_field ctx c_new cf_new c_old tl get_super_field is_overload p =
+	let i = cf_new.cf_name in
+	try
+		if is_overload && not (has_class_field_flag cf_new CfOverload) then
+			display_error ctx.com ("Missing overload declaration for field " ^ i) p;
+		let t, f2 = get_super_field c_old i in
+		let map = TClass.get_map_function c_old tl in
+		let rctx = {
+			c_new = c_new;
+			cf_new = cf_new;
+			c_old = c_old;
+			cf_old = f2;
+			map = map;
+			t_old = map t;
+		} in
+		Some rctx
+	with Not_found ->
+		if has_class_field_flag cf_new CfOverride then begin
+			let msg = if is_overload then
+				("Field " ^ i ^ " is declared 'override' but no compatible overload was found")
+			else begin
+				let fields = TClass.get_all_super_fields c_new in
+				let fields = PMap.fold (fun (_,cf) acc -> match cf.cf_kind with
+					| Method MethNormal when not (has_class_field_flag cf CfFinal) -> cf.cf_name :: acc
+					| _ -> acc
+				) fields [] in
+				StringError.string_error i fields ("Field " ^ i ^ " is declared 'override' but doesn't override any field")
+			end in
+			display_error ctx.com msg p;
+		end;
+		None
+
+type check_override_kind =
+	| NothingToDo
+	| NormalOverride of redefinition_context
+	| OverloadOverride of (unit -> unit)
+
 let check_overriding ctx c f =
 	match c.cl_super with
 	| None ->
-		if has_class_field_flag f CfOverride then display_error ctx.com ("Field " ^ f.cf_name ^ " is declared 'override' but doesn't override any field") f.cf_pos
-	| _ when (has_class_flag c CExtern) && Meta.has Meta.CsNative c.cl_meta -> () (* -net-lib specific: do not check overrides on extern CsNative classes *)
+		if has_class_field_flag f CfOverride then
+			display_error ctx.com ("Field " ^ f.cf_name ^ " is declared 'override' but doesn't override any field") f.cf_pos;
+		NothingToDo
+	| _ when (has_class_flag c CExtern) && Meta.has Meta.CsNative c.cl_meta ->
+		NothingToDo (* -net-lib specific: do not check overrides on extern CsNative classes *)
 	| Some (csup,params) ->
 		let p = f.cf_name_pos in
 		let i = f.cf_name in
-		let check_field f get_super_field is_overload = try
-			(if is_overload && not (has_class_field_flag f CfOverload) then
-				display_error ctx.com ("Missing overload declaration for field " ^ i) p);
-			let f_has_override = has_class_field_flag f CfOverride in
-			let t, f2 = get_super_field csup i in
-			check_native_name_override ctx f f2;
-			(* allow to define fields that are not defined for this platform version in superclass *)
-			(match f2.cf_kind with
-			| Var { v_read = AccRequire _ } -> raise Not_found;
-			| _ -> ());
-			if has_class_field_flag f2 CfAbstract then begin
-				if f_has_override then
-					display_error ctx.com ("Field " ^ i ^ " is declared 'override' but parent field " ^ i ^ " is 'abstract' and does not provide any implementation to override") p
-				else
-					add_class_field_flag f CfOverride (* our spec requires users to not "override" abstract functions, but our implementation depends on implementations to be declared with "override" ¯\_(ツ)_/¯ *)
-			end;
-			if (has_class_field_flag f2 CfOverload && not (has_class_field_flag f CfOverload)) then
-				display_error ctx.com ("Field " ^ i ^ " should be declared with overload since it was already declared as overload in superclass") p
-			else if not f_has_override && not (has_class_field_flag f2 CfAbstract) then begin
-				if has_class_flag c CExtern then add_class_field_flag f CfOverride
-				else display_error ctx.com ("Field " ^ i ^ " should be declared with 'override' since it is inherited from superclass " ^ s_type_path csup.cl_path) p
-			end else if not (has_class_field_flag f CfPublic) && (has_class_field_flag f2 CfPublic) then
-				display_error ctx.com ("Field " ^ i ^ " has less visibility (public/private) than superclass one") p
-			else (match f.cf_kind, f2.cf_kind with
-			| _, Method MethInline ->
-				display_error ctx.com ("Field " ^ i ^ " is inlined and cannot be overridden") p
-			| a, b when a = b -> ()
-			| Method MethInline, Method MethNormal ->
-				() (* allow to redefine a method as inlined *)
-			| _ ->
-				display_error ctx.com ("Field " ^ i ^ " has different property access than in superclass") p);
-			if (has_class_field_flag f2 CfFinal) then display_error ctx.com ("Cannot override final method " ^ i) p;
-			try
-				let t = apply_params csup.cl_params params t in
-				let map = TClass.get_map_function csup params in
-				valid_redefinition ctx map map f f.cf_type f2 t;
-			with
-				Unify_error l ->
-					(* TODO construct error with sub *)
-					display_error ctx.com ("Field " ^ i ^ " overrides parent class with different or incomplete type") p;
-					display_error ~depth:1 ctx.com (compl_msg "Base field is defined here") f2.cf_name_pos;
-					display_error ~depth:1 ctx.com (compl_msg (error_msg (Unify l))) p;
-		with
-			Not_found ->
-				if has_class_field_flag f CfOverride then
-					let msg = if is_overload then
-						("Field " ^ i ^ " is declared 'override' but no compatible overload was found")
-					else begin
-						let fields = TClass.get_all_super_fields c in
-						let fields = PMap.fold (fun (_,cf) acc -> match cf.cf_kind with
-							| Method MethNormal when not (has_class_field_flag cf CfFinal) -> cf.cf_name :: acc
-							| _ -> acc
-						) fields [] in
-						StringError.string_error i fields ("Field " ^ i ^ " is declared 'override' but doesn't override any field")
-					end in
-					display_error ctx.com msg p
-		in
 		if has_class_field_flag f CfOverload then begin
 			let overloads = Overloads.get_overloads ctx.com csup i in
 			List.iter (fun (t,f2) ->
@@ -237,20 +268,27 @@ let check_overriding ctx c f =
 				match f2.cf_kind with
 				| Var _ ->
 					display_error ctx.com ("A variable named '" ^ f2.cf_name ^ "' was already declared in a superclass") f.cf_pos
-				| _ -> ()
+				| _ ->
+					()
 			) overloads;
-			List.iter (fun f ->
+			OverloadOverride (fun () ->
 				(* find the exact field being overridden *)
-				check_field f (fun csup i ->
+				Option.may (check_override_field ctx p) (find_override_field ctx c f csup params (fun csup i ->
 					List.find (fun (t,f2) ->
 						Overloads.same_overload_args f.cf_type (apply_params csup.cl_params params t) f f2
 					) overloads
-				) true
-			) (f :: f.cf_overloads)
+				) true p)
+			)
 		end else
-			check_field f (fun csup i ->
+			let rctx = find_override_field ctx c f csup params (fun csup i ->
 				let _, t, f2 = raw_class_field (fun f -> f.cf_type) csup params i in
-				t, f2) false
+				t, f2
+			) false p in
+			match rctx with
+			| None ->
+				NothingToDo
+			| Some rctx ->
+				NormalOverride rctx
 
 let class_field_no_interf c i =
 	try

src/typing/typeloadFields.ml

@@ -951,11 +951,23 @@ module TypeBinding = struct
 					cf.cf_type <- t
 				| _ ->
 					if Meta.has Meta.DisplayOverride cf.cf_meta then DisplayEmitter.check_field_modifiers ctx c cf fctx.override fctx.display_modifier;
+					let f_check = match fctx.field_kind with
+						| FKNormal when not fctx.is_static ->
+							begin match TypeloadCheck.check_overriding ctx c cf with
+							| NothingToDo ->
+								(fun () -> ())
+							| NormalOverride rctx ->
+								(fun () -> 
+									TypeloadCheck.check_override_field ctx cf.cf_name_pos rctx
+								)
+							| OverloadOverride f ->
+								f
+							end
+						| _ ->
+							(fun () -> ())
+					in					
 					let e = TypeloadFunction.type_function ctx args ret fmode e fctx.is_display_field p in
-					begin match fctx.field_kind with
-					| FKNormal when not fctx.is_static -> TypeloadCheck.check_overriding ctx c cf
-					| _ -> ()
-					end;
+					f_check();
 					(* Disabled for now, see https://github.com/HaxeFoundation/haxe/issues/3033 *)
 					(* List.iter (fun (v,_) ->
 						if v.v_name <> "_" && has_mono v.v_type then warning ctx WTemp "Uninferred function argument, please add a type-hint" v.v_pos;