paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-02 06:29:25 +01:00
Code Issues Packages Projects Releases Wiki Activity

compiler: allow compiler to find real class definition during class members parse to handle references to self constants + test

Browse Source 
git-svn-id: trunk@21290 -
This commit is contained in:
paul 2012-05-14 04:50:49 +00:00
parent 53c39d5420
commit 4312aa4e08
7 changed files with 57 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -10454,6 +10454,7 @@ tests/test/tclass13.pp svneol=native#text/pascal
tests/test/tclass13a.pp svneol=native#text/plain
tests/test/tclass13b.pp svneol=native#text/plain
tests/test/tclass13c.pp svneol=native#text/pascal
tests/test/tclass13d.pp svneol=native#text/pascal
tests/test/tclass14a.pp svneol=native#text/pascal
tests/test/tclass14b.pp svneol=native#text/pascal
tests/test/tclass15.pp svneol=native#text/pascal

4
compiler/pdecl.pas
View File

@ -492,7 +492,7 @@ implementation
end;
consume(token);
{ we can ignore the result, the definition is modified }
object_dec(objecttype,genorgtypename,nil,nil,tobjectdef(ttypesym(sym).typedef),ht_none);
object_dec(objecttype,genorgtypename,newtype,nil,nil,tobjectdef(ttypesym(sym).typedef),ht_none);
newtype:=ttypesym(sym);
hdef:=newtype.typedef;
end
@ -595,7 +595,7 @@ implementation
current_tokenpos:=defpos;
current_tokenpos:=storetokenpos;
{ read the type definition }
read_named_type(hdef,genorgtypename,gendef,generictypelist,false);
read_named_type(hdef,newtype,gendef,generictypelist,false);
{ update the definition of the type }
if assigned(hdef) then
begin

20
compiler/pdecobj.pas
View File

@ -30,7 +30,7 @@ interface
globtype,symconst,symtype,symdef;
{ parses a object declaration }
function object_dec(objecttype:tobjecttyp;const n:tidstring;genericdef:tstoreddef;genericlist:TFPObjectList;fd : tobjectdef;helpertype:thelpertype) : tobjectdef;
function object_dec(objecttype:tobjecttyp;const n:tidstring;objsym:tsym;genericdef:tstoreddef;genericlist:TFPObjectList;fd : tobjectdef;helpertype:thelpertype) : tobjectdef;
{ parses a (class) method declaration }
function method_dec(astruct: tabstractrecorddef; is_classdef: boolean): tprocdef;
@ -1225,7 +1225,7 @@ implementation
end;
function object_dec(objecttype:tobjecttyp;const n:tidstring;genericdef:tstoreddef;genericlist:TFPObjectList;fd : tobjectdef;helpertype:thelpertype) : tobjectdef;
function object_dec(objecttype:tobjecttyp;const n:tidstring;objsym:tsym;genericdef:tstoreddef;genericlist:TFPObjectList;fd : tobjectdef;helpertype:thelpertype) : tobjectdef;
var
old_current_structdef: tabstractrecorddef;
old_current_genericdef,
@ -1236,6 +1236,7 @@ implementation
list: TFPObjectList;
s: String;
st: TSymtable;
olddef: tdef;
begin
old_current_structdef:=current_structdef;
old_current_genericdef:=current_genericdef;
@ -1422,9 +1423,24 @@ implementation
{ parse optional GUID for interfaces }
parse_guid;
{ classes can handle links to themself not only inside type blocks
but in const blocks too. to make this possible we need to set
their symbols to real defs instead of errordef }
if assigned(objsym) and (objecttype in [odt_class,odt_javaclass]) then
begin
olddef:=ttypesym(objsym).typedef;
ttypesym(objsym).typedef:=current_structdef;
end
else
olddef:=nil;
{ parse and insert object members }
parse_object_members;
if assigned(olddef) then
ttypesym(objsym).typedef:=olddef;
if not(oo_is_external in current_structdef.objectoptions) then
begin
{ In Java, constructors are not automatically inherited (so you can

2
compiler/pexpr.pas
View File

@ -2132,13 +2132,11 @@ implementation
searchsym_type(pattern,srsym,srsymtable)
else
searchsym(pattern,srsym,srsymtable);
{ handle unit specification like System.Writeln }
unit_found:=try_consume_unitsym(srsym,srsymtable,t,true);
storedpattern:=pattern;
orgstoredpattern:=orgpattern;
consume(t);
{ named parameter support }
found_arg_name:=false;

2
compiler/pgenutil.pas
View File

@ -437,7 +437,7 @@ uses
current_tokenpos:=current_filepos;
current_scanner.startreplaytokens(genericdef.generictokenbuf,
genericdef.change_endian);
read_named_type(tt,finalspecializename,genericdef,generictypelist,false);
read_named_type(tt,srsym,genericdef,generictypelist,false);
current_filepos:=oldcurrent_filepos;
ttypesym(srsym).typedef:=tt;
tt.typesym:=srsym;

39
compiler/ptype.pas
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 name : TIDString;genericdef:tstoreddef;genericlist:TFPObjectList;parseprocvardir:boolean);
procedure read_named_type(var def:tdef;const newsym:tsym;genericdef:tstoreddef;genericlist:TFPObjectList;parseprocvardir:boolean);
{ reads any type declaration }
procedure read_anon_type(var def : tdef;parseprocvardir:boolean);
@ -777,7 +777,7 @@ implementation
{ reads a type definition and returns a pointer to it }
procedure read_named_type(var def : tdef;const name : TIDString;genericdef:tstoreddef;genericlist:TFPObjectList;parseprocvardir:boolean);
procedure read_named_type(var def:tdef;const newsym:tsym;genericdef:tstoreddef;genericlist:TFPObjectList;parseprocvardir:boolean);
var
pt : tnode;
tt2 : tdef;
@ -786,6 +786,7 @@ implementation
l,v : TConstExprInt;
oldpackrecords : longint;
defpos,storepos : tfileposinfo;
name: TIDString;
procedure expr_type;
var
@ -1278,6 +1279,10 @@ implementation
st: tsymtable;
begin
def:=nil;
if assigned(newsym) then
name:=newsym.RealName
else
name:='';
case token of
_STRING,_FILE:
begin
@ -1405,7 +1410,7 @@ implementation
if (idtoken=_HELPER) and (m_advanced_records in current_settings.modeswitches) then
begin
consume(_HELPER);
def:=object_dec(odt_helper,name,genericdef,genericlist,nil,ht_record);
def:=object_dec(odt_helper,name,newsym,genericdef,genericlist,nil,ht_record);
end
else
def:=record_dec(name,genericdef,genericlist);
@ -1435,12 +1440,12 @@ implementation
_CLASS :
begin
consume(_CLASS);
def:=object_dec(odt_class,name,genericdef,genericlist,nil,ht_none);
def:=object_dec(odt_class,name,newsym,genericdef,genericlist,nil,ht_none);
end;
_OBJECT :
begin
consume(_OBJECT);
def:=object_dec(odt_object,name,genericdef,genericlist,nil,ht_none);
def:=object_dec(odt_object,name,newsym,genericdef,genericlist,nil,ht_none);
end;
else begin
consume(_RECORD);
@ -1457,7 +1462,7 @@ implementation
if not(m_class in current_settings.modeswitches) then
Message(parser_f_need_objfpc_or_delphi_mode);
consume(token);
def:=object_dec(odt_dispinterface,name,genericdef,genericlist,nil,ht_none);
def:=object_dec(odt_dispinterface,name,newsym,genericdef,genericlist,nil,ht_none);
end;
_CLASS :
begin
@ -1488,15 +1493,15 @@ implementation
if (idtoken=_HELPER) then
begin
consume(_HELPER);
def:=object_dec(odt_helper,name,genericdef,genericlist,nil,ht_class);
def:=object_dec(odt_helper,name,newsym,genericdef,genericlist,nil,ht_class);
end
else
def:=object_dec(default_class_type,name,genericdef,genericlist,nil,ht_none);
def:=object_dec(default_class_type,name,newsym,genericdef,genericlist,nil,ht_none);
end;
_CPPCLASS :
begin
consume(token);
def:=object_dec(odt_cppclass,name,genericdef,genericlist,nil,ht_none);
def:=object_dec(odt_cppclass,name,newsym,genericdef,genericlist,nil,ht_none);
end;
_OBJCCLASS :
begin
@ -1504,7 +1509,7 @@ implementation
Message(parser_f_need_objc);
consume(token);
def:=object_dec(odt_objcclass,name,genericdef,genericlist,nil,ht_none);
def:=object_dec(odt_objcclass,name,newsym,genericdef,genericlist,nil,ht_none);
end;
_INTERFACE :
begin
@ -1515,11 +1520,11 @@ implementation
consume(token);
case current_settings.interfacetype of
it_interfacecom:
def:=object_dec(odt_interfacecom,name,genericdef,genericlist,nil,ht_none);
def:=object_dec(odt_interfacecom,name,newsym,genericdef,genericlist,nil,ht_none);
it_interfacecorba:
def:=object_dec(odt_interfacecorba,name,genericdef,genericlist,nil,ht_none);
def:=object_dec(odt_interfacecorba,name,newsym,genericdef,genericlist,nil,ht_none);
it_interfacejava:
def:=object_dec(odt_interfacejava,name,genericdef,genericlist,nil,ht_none);
def:=object_dec(odt_interfacejava,name,newsym,genericdef,genericlist,nil,ht_none);
else
internalerror(2010122612);
end;
@ -1530,7 +1535,7 @@ implementation
Message(parser_f_need_objc);
consume(token);
def:=object_dec(odt_objcprotocol,name,genericdef,genericlist,nil,ht_none);
def:=object_dec(odt_objcprotocol,name,newsym,genericdef,genericlist,nil,ht_none);
end;
_OBJCCATEGORY :
begin
@ -1538,12 +1543,12 @@ implementation
Message(parser_f_need_objc);
consume(token);
def:=object_dec(odt_objccategory,name,genericdef,genericlist,nil,ht_none);
def:=object_dec(odt_objccategory,name,newsym,genericdef,genericlist,nil,ht_none);
end;
_OBJECT :
begin
consume(token);
def:=object_dec(odt_object,name,genericdef,genericlist,nil,ht_none);
def:=object_dec(odt_object,name,newsym,genericdef,genericlist,nil,ht_none);
end;
_PROCEDURE,
_FUNCTION:
@ -1573,7 +1578,7 @@ implementation
procedure read_anon_type(var def : tdef;parseprocvardir:boolean);
begin
read_named_type(def,'',nil,nil,parseprocvardir);
read_named_type(def,nil,nil,nil,parseprocvardir);
end;

13
tests/test/tclass13d.pp Normal file
View File

@ -0,0 +1,13 @@
{ %norun }
{$mode delphi}
type
TObj = class
const
Val = 1;
V1: Integer = Val;
V2: Integer = TObj.Val;
end;
begin
end.