paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-07 05:08:06 +02:00
Code Issues Packages Projects Releases Wiki Activity

compiler: allow objects and records to have members which point to themself. only don't permit this to regular fields.

Browse Source 
- remove testcurobject hack and perform a check only for regular fields
  - move is_holded_by to interface and rename it to is_owned_by
  - don't check static symbols in _needs_init_final because they always point to symbols registered on unit level
  - don't check object type in id_type, read_named_type when we are looking for type of structure member - the only check will be performed for record/object fields now
  + tests

git-svn-id: trunk@16646 -
This commit is contained in:
paul 2010-12-27 05:47:25 +00:00
parent e098046608
commit 210e78e4fa
10 changed files with 86 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -9330,6 +9330,8 @@ tests/test/terecs4.pp svneol=native#text/pascal
tests/test/terecs5.pp svneol=native#text/pascal
tests/test/terecs6.pp svneol=native#text/pascal
tests/test/terecs7.pp svneol=native#text/pascal
tests/test/terecs8.pp svneol=native#text/pascal
tests/test/terecs9.pp svneol=native#text/pascal
tests/test/terecs_u1.pp svneol=native#text/pascal
tests/test/testcmem.pp svneol=native#text/plain
tests/test/testda1.pp svneol=native#text/plain

4
compiler/parser.pas
View File

@ -55,10 +55,6 @@ implementation
procedure initparser;
begin
{ we didn't parse a object or class declaration }
{ and no function header }
testcurobject:=0;
{ Current compiled module/proc }
set_current_module(nil);
current_module:=nil;

2
compiler/pdecobj.pas
View File

@ -607,7 +607,6 @@ implementation
current_objectdef.symtable.currentvisibility:=vis_published
else
current_objectdef.symtable.currentvisibility:=vis_public;
testcurobject:=1;
has_destructor:=false;
fields_allowed:=true;
is_classdef:=false;
@ -948,7 +947,6 @@ implementation
until false;
{ restore }
testcurobject:=0;
parse_generic:=old_parse_generic;
end;

4
compiler/pdecsub.pas
View File

@ -528,7 +528,6 @@ implementation
sc:=TFPObjectList.create(false);
defaultrequired:=false;
paranr:=0;
inc(testcurobject);
block_type:=bt_var;
is_univ:=false;
repeat
@ -782,7 +781,6 @@ implementation
{ remove parasymtable from stack }
sc.free;
{ reset object options }
dec(testcurobject);
block_type:=old_block_type;
consume(_RKLAMMER);
end;
@ -1196,7 +1194,6 @@ implementation
old_current_specializedef: tobjectdef;
begin
old_parse_generic:=parse_generic;
inc(testcurobject);
{ Add ObjectSymtable to be able to find generic type definitions }
popclass:=0;
if assigned(pd.struct) and
@ -1228,7 +1225,6 @@ implementation
if popclass<>0 then
internalerror(201012020);
end;
dec(testcurobject);
parse_generic:=old_parse_generic;
end;

13
compiler/pdecvar.pas
View File

@ -357,7 +357,6 @@ implementation
{ create a list of the parameters }
symtablestack.push(readprocdef.parast);
sc:=TFPObjectList.create(false);
inc(testcurobject);
repeat
if try_to_consume(_VAR) then
varspez:=vs_var
@ -403,7 +402,6 @@ implementation
end;
until not try_to_consume(_SEMICOLON);
sc.free;
dec(testcurobject);
symtablestack.pop(readprocdef.parast);
consume(_RECKKLAMMER);
@ -1406,7 +1404,7 @@ implementation
{$endif powerpc or powerpc64}
{ Force an expected ID error message }
if not (token in [_ID,_CASE,_END]) then
consume(_ID);
consume(_ID);
{ read vars }
sc:=TFPObjectList.create(false);
recstlist:=TFPObjectList.create(false);;
@ -1447,6 +1445,15 @@ implementation
end;
end;
read_anon_type(hdef,false);
{ allow only static fields reference to struct where they are declared }
if not (vd_class in options) and
(is_object(hdef) or is_record(hdef)) and
is_owned_by(tabstractrecorddef(recst.defowner),tabstractrecorddef(hdef)) then
begin
Message1(type_e_type_is_not_completly_defined, tabstractrecorddef(hdef).RttiName);
{ for error recovery or compiler will crash later }
hdef:=generrordef;
end;
{ restore stack }
for i:=recstlist.count-1 downto 0 do
begin

48
compiler/ptype.pas
View File

@ -29,11 +29,6 @@ interface
globtype,cclasses,
symtype,symdef,symbase;
var
{ hack, which allows to use the current parsed }
{ object type as function argument type }
testcurobject : byte;
procedure resolve_forward_types;
{ reads a type identifier }
@ -382,18 +377,14 @@ implementation
- classes can be used also in classes
- objects can be parameters }
structdef:=current_structdef;
while Assigned(structdef) and (structdef.typ in [objectdef,recorddef]) do
while assigned(structdef) and (structdef.typ in [objectdef,recorddef]) do
begin
if (structdef.objname^=pattern) and
(
(testcurobject=2) or
is_class_or_interface_or_objc(structdef)
) then
begin
consume(_ID);
def:=structdef;
exit;
end;
if (structdef.objname^=pattern) then
begin
consume(_ID);
def:=structdef;
exit;
end;
structdef:=tabstractrecorddef(structdef.owner.defowner);
end;
{ Use the special searchsym_type that ignores records and parameters }
@ -583,7 +574,6 @@ implementation
Exit;
current_structdef.symtable.currentvisibility:=vis_public;
testcurobject:=1;
fields_allowed:=true;
is_classdef:=false;
classfields:=false;
@ -842,8 +832,6 @@ implementation
consume(_ID); { Give a ident expected message, like tp7 }
end;
until false;
testcurobject:=0;
end;
{ reads a record declaration }
@ -895,7 +883,7 @@ implementation
lv,hv : TConstExprInt;
old_block_type : tblock_type;
dospecialize : boolean;
structdef: TDef;
structdef: tabstractrecorddef;
begin
old_block_type:=block_type;
dospecialize:=false;
@ -905,19 +893,15 @@ implementation
if (token=_ID) then
begin
structdef:=current_structdef;
while Assigned(structdef) and (structdef.typ in [objectdef,recorddef]) do
while assigned(structdef) and (structdef.typ in [objectdef,recorddef]) do
begin
if (tabstractrecorddef(structdef).objname^=pattern) and
(
(testcurobject=2) or
is_class_or_interface_or_objc(structdef)
) then
begin
consume(_ID);
def:=structdef;
exit;
end;
structdef:=tdef(tabstractrecorddef(structdef).owner.defowner);
if (structdef.objname^=pattern) then
begin
consume(_ID);
def:=structdef;
exit;
end;
structdef:=tabstractrecorddef(structdef.owner.defowner);
end;
end;
{ Generate a specialization? }

4
compiler/symconst.pas
View File

@ -156,13 +156,13 @@ type
{ symbol options }
tsymoption=(sp_none,
sp_static,
sp_static, { static symbol in class/object/record }
sp_hint_deprecated,
sp_hint_platform,
sp_hint_library,
sp_hint_unimplemented,
sp_has_overloaded,
sp_internal, { internal symbol, not reported as unused }
sp_internal, { internal symbol, not reported as unused }
sp_implicitrename,
sp_hint_experimental,
sp_generic_para,

26
compiler/symtable.pas
View File

@ -200,6 +200,7 @@ interface
{*** Search ***}
procedure addsymref(sym:tsym);
function is_owned_by(childdef,ownerdef:tabstractrecorddef):boolean;
function is_visible_for_object(symst:tsymtable;symvisibility:tvisibility;contextobjdef:tabstractrecorddef):boolean;
function is_visible_for_object(pd:tprocdef;contextobjdef:tabstractrecorddef):boolean;
function is_visible_for_object(sym:tsym;contextobjdef:tabstractrecorddef):boolean;
@ -747,7 +748,11 @@ implementation
procedure TStoredSymtable._needs_init_final(sym:TObject;arg:pointer);
begin
if b_needs_init_final then
exit;
exit;
{ don't check static symbols - they can be present in structures only and
always have a reference to a symbol defined on unit level }
if sp_static in tsym(sym).symoptions then
exit;
case tsym(sym).typ of
fieldvarsym,
staticvarsym,
@ -1714,15 +1719,14 @@ implementation
end;
function is_owned_by(childdef,ownerdef:tabstractrecorddef):boolean;
begin
result:=childdef=ownerdef;
if not result and (childdef.owner.symtabletype in [ObjectSymtable,recordsymtable]) then
result:=is_owned_by(tabstractrecorddef(childdef.owner.defowner),ownerdef);
end;
function is_visible_for_object(symst:tsymtable;symvisibility:tvisibility;contextobjdef:tabstractrecorddef):boolean;
function is_holded_by(childdef,ownerdef: tabstractrecorddef): boolean;
begin
result:=childdef=ownerdef;
if not result and (childdef.owner.symtabletype in [ObjectSymtable,recordsymtable]) then
result:=is_holded_by(tabstractrecorddef(childdef.owner.defowner),ownerdef);
end;
var
symownerdef : tabstractrecorddef;
begin
@ -1760,13 +1764,13 @@ implementation
vis_strictprivate :
begin
result:=assigned(current_structdef) and
is_holded_by(current_structdef,symownerdef);
is_owned_by(current_structdef,symownerdef);
end;
vis_strictprotected :
begin
result:=assigned(current_structdef) and
(current_structdef.is_related(symownerdef) or
is_holded_by(current_structdef,symownerdef));
is_owned_by(current_structdef,symownerdef));
end;
vis_protected :
begin

21
tests/test/terecs8.pp Normal file
View File

@ -0,0 +1,21 @@
program terecs8;
{$mode delphi}
// allow refence owner type for record and object static fields and class properties
type
TFoo = record
class var
FFoo: TFoo;
class property Foo: TFoo read FFoo write FFoo;
end;
TBar = record
class var
FBar: TBar;
class property Bar: TBar read FBar write FBar;
end;
begin
end.

20
tests/test/terecs9.pp Normal file
View File

@ -0,0 +1,20 @@
{ %fail}
program terecs9;
{$mode delphi}
// don't allow refence owner type for record and object fields and properties
type
TFoo = record
var
FFoo: TFoo;
end;
TBar = record
var
FBar: TBar;
end;
begin
end.