Fix for Mantis #26176. Don't handle "type helper" as unique.

ptype.pas:
  * read_named_type: change hadtypetoken from a value to a var parameter and set it to false if a type helper is parsed so that calling code does not handle it as unique
  * read_anon_type: handle that hadtypetoken is now a var parameter

pgenutil.pas, generate_specialization:
  * handle that hadtypetoken of read_named_type is now a var parameter

+ added test

git-svn-id: trunk@27870 -
This commit is contained in:
svenbarth 2014-06-06 13:26:21 +00:00
parent 9ab5affd55
commit 1bbcc08a8b
4 changed files with 29 additions and 4 deletions

1
.gitattributes vendored
View File

@ -12747,6 +12747,7 @@ tests/webtbf/tw25861.pp svneol=native#text/plain
tests/webtbf/tw25862.pp svneol=native#text/plain
tests/webtbf/tw25915.pp svneol=native#text/pascal
tests/webtbf/tw25951.pp svneol=native#text/pascal
tests/webtbf/tw26176.pp svneol=native#text/pascal
tests/webtbf/tw26193.pp svneol=native#text/pascal
tests/webtbf/tw2657.pp svneol=native#text/plain
tests/webtbf/tw2670.pp svneol=native#text/plain

View File

@ -384,6 +384,7 @@ uses
st : TSymtable;
srsym : tsym;
pt2 : tnode;
hadtypetoken,
errorrecovery,
found,
first,
@ -824,7 +825,8 @@ uses
else
recordbuf:=nil;
current_scanner.startreplaytokens(genericdef.generictokenbuf);
read_named_type(tt,srsym,genericdef,generictypelist,false,false);
hadtypetoken:=false;
read_named_type(tt,srsym,genericdef,generictypelist,false,hadtypetoken);
current_filepos:=oldcurrent_filepos;
ttypesym(srsym).typedef:=tt;
tt.typesym:=srsym;

View File

@ -44,7 +44,7 @@ interface
procedure single_type(var def:tdef;options:TSingleTypeOptions);
{ reads any type declaration, where the resulting type will get name as type identifier }
procedure read_named_type(var def:tdef;const newsym:tsym;genericdef:tstoreddef;genericlist:tfphashobjectlist;parseprocvardir:boolean;hadtypetoken:boolean);
procedure read_named_type(var def:tdef;const newsym:tsym;genericdef:tstoreddef;genericlist:tfphashobjectlist;parseprocvardir:boolean;var hadtypetoken:boolean);
{ reads any type declaration }
procedure read_anon_type(var def : tdef;parseprocvardir:boolean);
@ -946,7 +946,7 @@ implementation
{ reads a type definition and returns a pointer to it }
procedure read_named_type(var def:tdef;const newsym:tsym;genericdef:tstoreddef;genericlist:tfphashobjectlist;parseprocvardir:boolean;hadtypetoken:boolean);
procedure read_named_type(var def:tdef;const newsym:tsym;genericdef:tstoreddef;genericlist:tfphashobjectlist;parseprocvardir:boolean;var hadtypetoken:boolean);
var
pt : tnode;
tt2 : tdef;
@ -1802,6 +1802,9 @@ implementation
([m_delphi,m_type_helpers]*current_settings.modeswitches=[m_type_helpers]) and
(token=_ID) and (idtoken=_HELPER) then
begin
{ reset hadtypetoken, so that calling code knows that it should not be handled
as a "unique" type }
hadtypetoken:=false;
consume(_HELPER);
def:=object_dec(odt_helper,name,newsym,genericdef,genericlist,nil,ht_type);
end
@ -1815,8 +1818,11 @@ implementation
procedure read_anon_type(var def : tdef;parseprocvardir:boolean);
var
hadtypetoken : boolean;
begin
read_named_type(def,nil,nil,nil,parseprocvardir,false);
hadtypetoken:=false;
read_named_type(def,nil,nil,nil,parseprocvardir,hadtypetoken);
end;

16
tests/webtbf/tw26176.pp Normal file
View File

@ -0,0 +1,16 @@
{ %fail }
program tw26176;
{$MODE OBJFPC}
{$MODESWITCH TYPEHELPERS}
type
TIH = type helper for Int32
// NO (!) error - Forward declaration not solved "Foo(TObject);"
procedure Foo(Sender: TObject);
end;
begin
end.