mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-04 08:39:03 +02:00
Fix for Mantis #22329.
symtable.pas, searchsym_in_class: * if we found a helper method that has overload defined we should not forget the symbol as there can be a case that no method with that name is defined in the extended class hierarchy symtable.pas, searchsym_in_record: * analogous to the above + added test given in the issue + added analogous test for record helpers git-svn-id: trunk@21764 -
This commit is contained in:
parent
a908db5a91
commit
71c13190e1
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -11092,6 +11092,7 @@ tests/test/trhlp40.pp svneol=native#text/pascal
|
||||
tests/test/trhlp41.pp svneol=native#text/pascal
|
||||
tests/test/trhlp42.pp svneol=native#text/pascal
|
||||
tests/test/trhlp43.pp svneol=native#text/pascal
|
||||
tests/test/trhlp44.pp svneol=native#text/pascal
|
||||
tests/test/trhlp5.pp svneol=native#text/pascal
|
||||
tests/test/trhlp6.pp svneol=native#text/pascal
|
||||
tests/test/trhlp7.pp svneol=native#text/pascal
|
||||
@ -12666,6 +12667,7 @@ tests/webtbs/tw2226.pp svneol=native#text/plain
|
||||
tests/webtbs/tw2229.pp svneol=native#text/plain
|
||||
tests/webtbs/tw22320.pp svneol=native#text/plain
|
||||
tests/webtbs/tw22326.pp svneol=native#text/plain
|
||||
tests/webtbs/tw22329.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw2233.pp svneol=native#text/plain
|
||||
tests/webtbs/tw22331.pp svneol=native#text/plain
|
||||
tests/webtbs/tw2242.pp svneol=native#text/plain
|
||||
|
@ -2402,6 +2402,8 @@ implementation
|
||||
hashedid : THashedIDString;
|
||||
orgclass : tobjectdef;
|
||||
i : longint;
|
||||
hlpsrsym : tsym;
|
||||
hlpsrsymtable : tsymtable;
|
||||
begin
|
||||
orgclass:=classh;
|
||||
{ in case this is a formal class, first find the real definition }
|
||||
@ -2454,11 +2456,13 @@ implementation
|
||||
end
|
||||
else
|
||||
begin
|
||||
hlpsrsym:=nil;
|
||||
hlpsrsymtable:=nil;
|
||||
while assigned(classh) do
|
||||
begin
|
||||
{ search for a class helper method first if this is an Object
|
||||
Pascal class }
|
||||
if is_class(classh) and searchhelper then
|
||||
Pascal class and we haven't yet found a helper symbol }
|
||||
if is_class(classh) and searchhelper and not assigned(hlpsrsym) then
|
||||
begin
|
||||
result:=search_objectpascal_helper(classh,contextclassh,s,srsym,srsymtable);
|
||||
if result then
|
||||
@ -2467,7 +2471,14 @@ implementation
|
||||
searching for overloads }
|
||||
if (srsym.typ<>procsym) or
|
||||
not (sp_has_overloaded in tprocsym(srsym).symoptions) then
|
||||
exit;
|
||||
exit
|
||||
else
|
||||
begin
|
||||
{ remember the found symbol if the class hierarchy
|
||||
should not contain the a method with that name }
|
||||
hlpsrsym:=srsym;
|
||||
hlpsrsymtable:=srsymtable;
|
||||
end;
|
||||
end;
|
||||
srsymtable:=classh.symtable;
|
||||
srsym:=tsym(srsymtable.FindWithHash(hashedid));
|
||||
@ -2480,6 +2491,15 @@ implementation
|
||||
end;
|
||||
classh:=classh.childof;
|
||||
end;
|
||||
{ did we find a helper symbol, but no symbol with the same name in
|
||||
the extended object's hierarchy? }
|
||||
if assigned(hlpsrsym) then
|
||||
begin
|
||||
srsym:=hlpsrsym;
|
||||
srsymtable:=hlpsrsymtable;
|
||||
result:=true;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
if is_objcclass(orgclass) then
|
||||
result:=search_objc_helper(orgclass,s,srsym,srsymtable)
|
||||
@ -2493,8 +2513,12 @@ implementation
|
||||
function searchsym_in_record(recordh:tabstractrecorddef;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
|
||||
var
|
||||
hashedid : THashedIDString;
|
||||
hlpsrsym : tsym;
|
||||
hlpsrsymtable : tsymtable;
|
||||
begin
|
||||
result:=false;
|
||||
hlpsrsym:=nil;
|
||||
hlpsrsymtable:=nil;
|
||||
hashedid.id:=s;
|
||||
{ search for a record helper method first }
|
||||
result:=search_objectpascal_helper(recordh,recordh,s,srsym,srsymtable);
|
||||
@ -2504,7 +2528,14 @@ implementation
|
||||
searching for overloads }
|
||||
if (srsym.typ<>procsym) or
|
||||
not (sp_has_overloaded in tprocsym(srsym).symoptions) then
|
||||
exit;
|
||||
exit
|
||||
else
|
||||
begin
|
||||
{ remember the found symbol if we should not find a symbol with
|
||||
the same name in the extended record }
|
||||
hlpsrsym:=srsym;
|
||||
hlpsrsymtable:=srsymtable;
|
||||
end;
|
||||
srsymtable:=recordh.symtable;
|
||||
srsym:=tsym(srsymtable.FindWithHash(hashedid));
|
||||
if assigned(srsym) and is_visible_for_object(srsym,recordh) then
|
||||
@ -2513,8 +2544,9 @@ implementation
|
||||
result:=true;
|
||||
exit;
|
||||
end;
|
||||
srsym:=nil;
|
||||
srsymtable:=nil;
|
||||
srsym:=hlpsrsym;
|
||||
srsymtable:=hlpsrsymtable;
|
||||
result:=assigned(srsym);
|
||||
end;
|
||||
|
||||
function searchsym_in_class_by_msgint(classh:tobjectdef;msgid:longint;out srdef : tdef;out srsym:tsym;out srsymtable:TSymtable):boolean;
|
||||
|
31
tests/test/trhlp44.pp
Normal file
31
tests/test/trhlp44.pp
Normal file
@ -0,0 +1,31 @@
|
||||
{ %NORUN }
|
||||
|
||||
program trhlp44;
|
||||
|
||||
{$mode delphi}
|
||||
|
||||
type
|
||||
TTest = record
|
||||
|
||||
end;
|
||||
|
||||
TTestHelper = record helper for TTest
|
||||
procedure SayHello(const I: Integer); overload;
|
||||
procedure SayHello(const S: string); overload;
|
||||
end;
|
||||
|
||||
procedure TTestHelper.SayHello(const I: Integer); overload;
|
||||
begin
|
||||
Writeln('Hello ', I);
|
||||
end;
|
||||
|
||||
procedure TTestHelper.SayHello(const S: string); overload;
|
||||
begin
|
||||
Writeln('Hello ', S);
|
||||
end;
|
||||
|
||||
var
|
||||
Obj: TTest;
|
||||
begin
|
||||
Obj.SayHello('FPC');
|
||||
end.
|
32
tests/webtbs/tw22329.pp
Normal file
32
tests/webtbs/tw22329.pp
Normal file
@ -0,0 +1,32 @@
|
||||
{ %NORUN }
|
||||
|
||||
program tw22329;
|
||||
|
||||
{$mode delphi}
|
||||
|
||||
type
|
||||
TObjectHelper = class helper for TObject
|
||||
procedure SayHello(const I: Integer); overload;
|
||||
procedure SayHello(const S: string); overload;
|
||||
end;
|
||||
|
||||
procedure TObjectHelper.SayHello(const I: Integer); overload;
|
||||
begin
|
||||
Writeln('Hello ', I);
|
||||
end;
|
||||
|
||||
procedure TObjectHelper.SayHello(const S: string); overload;
|
||||
begin
|
||||
Writeln('Hello ', S);
|
||||
end;
|
||||
|
||||
var
|
||||
Obj: TObject;
|
||||
begin
|
||||
Obj := TObject.Create;
|
||||
try
|
||||
Obj.SayHello('FPC');
|
||||
finally
|
||||
Obj.Free;
|
||||
end;
|
||||
end.
|
Loading…
Reference in New Issue
Block a user