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

View File

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