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:
svenbarth 2012-07-03 16:27:03 +00:00
parent a908db5a91
commit 71c13190e1
4 changed files with 103 additions and 6 deletions

2
.gitattributes vendored
View File

@ -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

View File

@ -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
View 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
View 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.