diff --git a/compiler/src/main/pascal/uSemantic.pas b/compiler/src/main/pascal/uSemantic.pas index ad492bf..e25cea9 100644 --- a/compiler/src/main/pascal/uSemantic.pas +++ b/compiler/src/main/pascal/uSemantic.pas @@ -4576,6 +4576,7 @@ var ExactNew: Integer; ExactBest: Integer; S1, S2: Integer; + SawHiding: Boolean; begin Result := nil; if AArgs <> nil then Arity := AArgs.Count else Arity := -1; @@ -4587,19 +4588,26 @@ begin begin Key := CurrName + '.' + AMethodName; Grp := GroupOf(FMethodGroups, Key); + SawHiding := False; if Grp <> nil then for K := 0 to Grp.Count - 1 do begin Inc(TotalCnt); Cand := TMethodDecl(Grp.Items[K]); + { A method declared WITHOUT `overload` hides all inherited methods of + the same name — once seen at this (more-derived) level, the parent + chain is not consulted. Methods WITH `overload` merge with the + inherited overload set, so the walk continues to the parent. } + if not Cand.IsOverload then SawHiding := True; if (Arity < 0) or ((Arity >= MinArity(Cand)) and (Arity <= Cand.Params.Count)) then ArityMatch.Add(Cand); end; - if ArityMatch.Count > 0 then Break; - { Walk parent — only if no candidates yet (Delphi: derived overloads - do not mix with inherited ones unless the descendant explicitly - repeats the directive, which our model treats as a fresh slot). } + { Delphi overload semantics: derived `overload` methods MERGE with the + inherited overload set (walk continues), but a non-`overload` method at + this level hides the inherited ones (stop). Stop too once any class in + the chain actually declares the name without `overload`. } + if SawHiding then Break; Sym := FTable.Lookup(CurrName); if (Sym <> nil) and (Sym.TypeDesc is TRecordTypeDesc) then begin @@ -8792,7 +8800,16 @@ begin end; RT := TRecordTypeDesc(ObjSym.TypeDesc); - MDecl := FindMethodDecl(RT.Name, AExpr.Name); + { Overload-aware resolution: pick the variant matching the argument list + (merging overloads across the inheritance chain). Args must be analysed + first so ResolveMethodOverload can score against their resolved types. + Fall back to a plain chain lookup for the no-overload / single case. } + for I := 0 to AExpr.Args.Count - 1 do + AnalyseExpr(TASTExpr(AExpr.Args.Items[I])); + MDecl := ResolveMethodOverload(RT.Name, AExpr.Name, AExpr.Args, + AExpr.Line, AExpr.Col); + if MDecl = nil then + MDecl := FindMethodDecl(RT.Name, AExpr.Name); { Built-in TObject.ToString: virtual dispatch yielding string. Every class inherits this from TObject (vtable slot 1). } if (MDecl = nil) and SameText(AExpr.Name, 'ToString') and (AExpr.Args.Count = 0) and diff --git a/compiler/src/test/pascal/cp.test.e2e.inherit.pas b/compiler/src/test/pascal/cp.test.e2e.inherit.pas index d710bbe..c2c18e0 100644 --- a/compiler/src/test/pascal/cp.test.e2e.inherit.pas +++ b/compiler/src/test/pascal/cp.test.e2e.inherit.pas @@ -38,6 +38,9 @@ type vtable, exactly like a direct accessor call does. } procedure TestRun_VirtualPropertyGetter_Dispatches; procedure TestRun_VirtualPropertySetter_Dispatches; + { A derived `overload` method must MERGE with the inherited overload set, + not shadow it — both the base and derived variants stay callable. } + procedure TestRun_OverloadMergeAcrossInheritance; end; implementation @@ -273,6 +276,26 @@ const end. '''; + { TDerived adds F(string) as an overload; the inherited F(Integer) must + remain callable — the overload set merges across inheritance. } + SrcOverloadMerge = ''' + program P; + type + TBase = class + function F(x: Integer): string; overload; begin Result := 'int:' + IntToStr(x); end; + end; + TDerived = class(TBase) + function F(s: string): string; overload; begin Result := 'str:' + s; end; + end; + var d: TDerived; + begin + d := TDerived.Create; + WriteLn(d.F('a')); + WriteLn(d.F(5)); + d := nil; + end. + '''; + procedure TE2EInheritTests.TestRun_ThreeLevelVirtualOverride; begin if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end; @@ -339,6 +362,12 @@ begin AssertRunsOnAll(SrcVirtualSetter, '42' + LE, 0); end; +procedure TE2EInheritTests.TestRun_OverloadMergeAcrossInheritance; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end; + AssertRunsOnAll(SrcOverloadMerge, 'str:a' + LE + 'int:5' + LE, 0); +end; + initialization RegisterTest(TE2EInheritTests); diff --git a/docs/language-rationale.adoc b/docs/language-rationale.adoc index 5fec112..220f9c6 100644 --- a/docs/language-rationale.adoc +++ b/docs/language-rationale.adoc @@ -1837,6 +1837,36 @@ ambiguity" pitfalls that surface when an `Integer` argument matches both an `Integer` and a `Double` overload — exact match always wins, ambiguity is escalated to the user. +=== Overload sets merge across inheritance + +When a derived class declares an `overload` method whose name matches an +overload inherited from a base class, the two sets *merge*: both the +inherited and the newly declared variants remain callable on the derived +type. + +[source,pascal] +---- +TBase = class + function F(x: Integer): string; overload; +end; +TDerived = class(TBase) + function F(s: string): string; overload; // adds to, does not replace +end; +var d: TDerived; +begin + d.F(5); // resolves to TBase.F(Integer) + d.F('a'); // resolves to TDerived.F(string) +end; +---- + +This follows Delphi: a derived method marked `overload` extends the +inherited overload set rather than hiding it. A derived method declared +*without* `overload` still hides every inherited variant of that name (the +conventional "redeclaration hides" rule) — only the `overload` directive +opts into merging. Resolution collects candidates up the inheritance +chain until it reaches a level that declares the name without `overload`, +then scores the combined set with the normal exact-over-widening rules. + === Name mangling Each overload is emitted under a distinct QBE symbol name derived from