mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-27 13:48:17 +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/trhlp41.pp svneol=native#text/pascal
|
||||||
tests/test/trhlp42.pp svneol=native#text/pascal
|
tests/test/trhlp42.pp svneol=native#text/pascal
|
||||||
tests/test/trhlp43.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/trhlp5.pp svneol=native#text/pascal
|
||||||
tests/test/trhlp6.pp svneol=native#text/pascal
|
tests/test/trhlp6.pp svneol=native#text/pascal
|
||||||
tests/test/trhlp7.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/tw2229.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw22320.pp svneol=native#text/plain
|
tests/webtbs/tw22320.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw22326.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/tw2233.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw22331.pp svneol=native#text/plain
|
tests/webtbs/tw22331.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw2242.pp svneol=native#text/plain
|
tests/webtbs/tw2242.pp svneol=native#text/plain
|
||||||
|
@ -2402,6 +2402,8 @@ implementation
|
|||||||
hashedid : THashedIDString;
|
hashedid : THashedIDString;
|
||||||
orgclass : tobjectdef;
|
orgclass : tobjectdef;
|
||||||
i : longint;
|
i : longint;
|
||||||
|
hlpsrsym : tsym;
|
||||||
|
hlpsrsymtable : tsymtable;
|
||||||
begin
|
begin
|
||||||
orgclass:=classh;
|
orgclass:=classh;
|
||||||
{ in case this is a formal class, first find the real definition }
|
{ in case this is a formal class, first find the real definition }
|
||||||
@ -2454,11 +2456,13 @@ implementation
|
|||||||
end
|
end
|
||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
|
hlpsrsym:=nil;
|
||||||
|
hlpsrsymtable:=nil;
|
||||||
while assigned(classh) do
|
while assigned(classh) do
|
||||||
begin
|
begin
|
||||||
{ search for a class helper method first if this is an Object
|
{ search for a class helper method first if this is an Object
|
||||||
Pascal class }
|
Pascal class and we haven't yet found a helper symbol }
|
||||||
if is_class(classh) and searchhelper then
|
if is_class(classh) and searchhelper and not assigned(hlpsrsym) then
|
||||||
begin
|
begin
|
||||||
result:=search_objectpascal_helper(classh,contextclassh,s,srsym,srsymtable);
|
result:=search_objectpascal_helper(classh,contextclassh,s,srsym,srsymtable);
|
||||||
if result then
|
if result then
|
||||||
@ -2467,7 +2471,14 @@ implementation
|
|||||||
searching for overloads }
|
searching for overloads }
|
||||||
if (srsym.typ<>procsym) or
|
if (srsym.typ<>procsym) or
|
||||||
not (sp_has_overloaded in tprocsym(srsym).symoptions) then
|
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;
|
end;
|
||||||
srsymtable:=classh.symtable;
|
srsymtable:=classh.symtable;
|
||||||
srsym:=tsym(srsymtable.FindWithHash(hashedid));
|
srsym:=tsym(srsymtable.FindWithHash(hashedid));
|
||||||
@ -2480,6 +2491,15 @@ implementation
|
|||||||
end;
|
end;
|
||||||
classh:=classh.childof;
|
classh:=classh.childof;
|
||||||
end;
|
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;
|
end;
|
||||||
if is_objcclass(orgclass) then
|
if is_objcclass(orgclass) then
|
||||||
result:=search_objc_helper(orgclass,s,srsym,srsymtable)
|
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;
|
function searchsym_in_record(recordh:tabstractrecorddef;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
|
||||||
var
|
var
|
||||||
hashedid : THashedIDString;
|
hashedid : THashedIDString;
|
||||||
|
hlpsrsym : tsym;
|
||||||
|
hlpsrsymtable : tsymtable;
|
||||||
begin
|
begin
|
||||||
result:=false;
|
result:=false;
|
||||||
|
hlpsrsym:=nil;
|
||||||
|
hlpsrsymtable:=nil;
|
||||||
hashedid.id:=s;
|
hashedid.id:=s;
|
||||||
{ search for a record helper method first }
|
{ search for a record helper method first }
|
||||||
result:=search_objectpascal_helper(recordh,recordh,s,srsym,srsymtable);
|
result:=search_objectpascal_helper(recordh,recordh,s,srsym,srsymtable);
|
||||||
@ -2504,7 +2528,14 @@ implementation
|
|||||||
searching for overloads }
|
searching for overloads }
|
||||||
if (srsym.typ<>procsym) or
|
if (srsym.typ<>procsym) or
|
||||||
not (sp_has_overloaded in tprocsym(srsym).symoptions) then
|
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;
|
srsymtable:=recordh.symtable;
|
||||||
srsym:=tsym(srsymtable.FindWithHash(hashedid));
|
srsym:=tsym(srsymtable.FindWithHash(hashedid));
|
||||||
if assigned(srsym) and is_visible_for_object(srsym,recordh) then
|
if assigned(srsym) and is_visible_for_object(srsym,recordh) then
|
||||||
@ -2513,8 +2544,9 @@ implementation
|
|||||||
result:=true;
|
result:=true;
|
||||||
exit;
|
exit;
|
||||||
end;
|
end;
|
||||||
srsym:=nil;
|
srsym:=hlpsrsym;
|
||||||
srsymtable:=nil;
|
srsymtable:=hlpsrsymtable;
|
||||||
|
result:=assigned(srsym);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function searchsym_in_class_by_msgint(classh:tobjectdef;msgid:longint;out srdef : tdef;out srsym:tsym;out srsymtable:TSymtable):boolean;
|
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