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

+ introduce tvariantrecbranch to be able to store

Browse Source 
all needed information for iso compatible variant records
* new for variant records as required by iso pascal
+ tests

git-svn-id: trunk@24241 -
This commit is contained in:
florian 2013-04-14 15:50:42 +00:00
parent 1824a932a3
commit 2fdd3e2d0a
10 changed files with 233 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.gitattributes vendored
View File

@ -11215,6 +11215,9 @@ tests/test/tisogoto3.pp svneol=native#text/pascal
tests/test/tisogoto4.pp svneol=native#text/pascal
tests/test/tisogoto5.pp svneol=native#text/pascal
tests/test/tisoread.pp svneol=native#text/pascal
tests/test/tisorec1.pp svneol=native#text/pascal
tests/test/tisorec2.pp svneol=native#text/pascal
tests/test/tisorec3.pp svneol=native#text/pascal
tests/test/tlib1a.pp svneol=native#text/plain
tests/test/tlib1b.pp svneol=native#text/plain
tests/test/tlib2a.pp svneol=native#text/plain

4
compiler/node.pas
View File

@ -1315,8 +1315,8 @@ implementation
begin
{$push}{$warnings off}
{ taitype should fit into a 4 byte set for speed reasons }
if ord(high(tnodeflags))>31 then
{ tvaroption should fit into a 4 byte set for speed reasons }
if ord(high(tvaroption))>31 then
internalerror(201110301);
{$pop}
end.

2
compiler/pdecobj.pas
View File

@ -1234,7 +1234,7 @@ implementation
include(vdoptions,vd_canreorder);
if final_fields then
include(vdoptions,vd_final);
read_record_fields(vdoptions,fieldlist);
read_record_fields(vdoptions,fieldlist,nil);
end
else if object_member_blocktype=bt_type then
types_dec(true)

37
compiler/pdecvar.pas
View File

@ -38,7 +38,7 @@ interface
procedure read_var_decls(options:Tvar_dec_options);
procedure read_record_fields(options:Tvar_dec_options; reorderlist: TFPObjectList);
procedure read_record_fields(options:Tvar_dec_options; reorderlist: TFPObjectList; variantdesc: ppvariantrecdesc);
procedure read_public_and_external(vs: tabstractvarsym);
@ -61,7 +61,7 @@ implementation
fmodule,htypechk,
{ pass 1 }
node,pass_1,aasmdata,
nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,nmem,nutils,
ncon,nmat,nadd,ncal,nset,ncnv,ninl,nld,nflw,nmem,nutils,
{ codegen }
ncgutil,ngenutil,
{ parser }
@ -1558,7 +1558,7 @@ implementation
end;
procedure read_record_fields(options:Tvar_dec_options; reorderlist: TFPObjectList);
procedure read_record_fields(options:Tvar_dec_options; reorderlist: TFPObjectList; variantdesc : ppvariantrecdesc);
var
sc : TFPObjectList;
i : longint;
@ -1618,6 +1618,7 @@ implementation
if token=_ID then
begin
vs:=tfieldvarsym.create(sorg,vs_value,generrordef,[]);
{ normally the visibility is set via addfield, but sometimes
we collect symbols so we can add them in a batch of
potentially mixed visibility, and then the individual
@ -1821,6 +1822,15 @@ implementation
maxsize:=0;
maxalignment:=0;
maxpadalign:=0;
{ already inside a variant record? if not, setup a new variantdesc chain }
if not(assigned(variantdesc)) then
variantdesc:=@trecorddef(trecordsymtable(recst).defowner).variantrecdesc;
{ else just concat the info to the given one }
new(variantdesc^);
fillchar(variantdesc^^,sizeof(tvariantrecdesc),0);
{ including a field declaration? }
fieldvs:=nil;
sorg:=orgpattern;
@ -1831,6 +1841,7 @@ implementation
consume(_ID);
consume(_COLON);
fieldvs:=tfieldvarsym.create(sorg,vs_value,generrordef,[]);
variantdesc^^.variantselector:=fieldvs;
symtablestack.top.insert(fieldvs);
end;
read_anon_type(casetype,true);
@ -1851,6 +1862,7 @@ implementation
UnionSymtable:=trecordsymtable.create('',current_settings.packrecords);
UnionDef:=trecorddef.create('',unionsymtable);
uniondef.isunion:=true;
startvarrecsize:=UnionSymtable.datasize;
{ align the bitpacking to the next byte }
UnionSymtable.datasize:=startvarrecsize;
@ -1858,12 +1870,24 @@ implementation
startpadalign:=Unionsymtable.padalignment;
symtablestack.push(UnionSymtable);
repeat
SetLength(variantdesc^^.branches,length(variantdesc^^.branches)+1);
fillchar(variantdesc^^.branches[high(variantdesc^^.branches)],
sizeof(variantdesc^^.branches[high(variantdesc^^.branches)]),0);
repeat
pt:=comp_expr(true,false);
if not(pt.nodetype=ordconstn) then
Message(parser_e_illegal_expression);
if try_to_consume(_POINTPOINT) then
pt:=crangenode.create(pt,comp_expr(true,false));
{ iso pascal does not support ranges in variant record definitions }
if not(m_iso in current_settings.modeswitches) and try_to_consume(_POINTPOINT) then
pt:=crangenode.create(pt,comp_expr(true,false))
else
begin
with variantdesc^^.branches[high(variantdesc^^.branches)] do
begin
SetLength(values,length(values)+1);
values[high(values)]:=tordconstnode(pt).value;
end;
end;
pt.free;
if token=_COMMA then
consume(_COMMA)
@ -1879,9 +1903,10 @@ implementation
consume(_LKLAMMER);
inc(variantrecordlevel);
if token<>_RKLAMMER then
read_record_fields([vd_record],nil);
read_record_fields([vd_record],nil,@variantdesc^^.branches[high(variantdesc^^.branches)].nestedvariant);
dec(variantrecordlevel);
consume(_RKLAMMER);
{ calculates maximal variant size }
maxsize:=max(maxsize,unionsymtable.datasize);
maxalignment:=max(maxalignment,unionsymtable.fieldalignment);

45
compiler/pinline.pas
View File

@ -74,6 +74,10 @@ implementation
callflag : tcallnodeflag;
destructorpos,
storepos : tfileposinfo;
variantdesc : pvariantrecdesc;
found : boolean;
j,i : ASizeInt;
variantselectsymbol : tfieldvarsym;
begin
if target_info.system in systems_managed_vm then
message(parser_e_feature_unsupported_for_vm);
@ -149,7 +153,7 @@ implementation
new_dispose_statement := p2;
end
{ constructor,destructor specified }
else if not(m_mac in current_settings.modeswitches) and
else if (([m_mac,m_iso]*current_settings.modeswitches)=[]) and
try_to_consume(_COMMA) then
begin
{ extended syntax of new and dispose }
@ -343,6 +347,45 @@ implementation
p,
ctemprefnode.create(temp)));
if (m_iso in current_settings.modeswitches) and (is_record(tpointerdef(p.resultdef).pointeddef)) then
begin
variantdesc:=trecorddef(tpointerdef(p.resultdef).pointeddef).variantrecdesc;
while (token=_COMMA) and assigned(variantdesc) do
begin
consume(_COMMA);
p2:=factor(false,false);
do_typecheckpass(p2);
if p2.nodetype=ordconstn then
begin
found:=false;
for i:=0 to high(variantdesc^.branches) do
begin
for j:=0 to high(variantdesc^.branches[i].values) do
if variantdesc^.branches[i].values[j]=tordconstnode(p2).value then
begin
found:=true;
variantselectsymbol:=tfieldvarsym(variantdesc^.variantselector);
variantdesc:=variantdesc^.branches[i].nestedvariant;
break;
end;
if found then
break;
end;
if found then
begin
{ setup variant selector }
addstatement(newstatement,cassignmentnode.create(
csubscriptnode.create(variantselectsymbol,
cderefnode.create(ctemprefnode.create(temp))),
p2));
end
else
Message(parser_e_illegal_expression);
end
else
Message(parser_e_illegal_expression);
end;
end;
{ release temp }
addstatement(newstatement,ctempdeletenode.create(temp));
end

6
compiler/ptype.pas
View File

@ -652,7 +652,7 @@ implementation
fields_allowed:=false;
is_classdef:=false;
end
else
else
begin
if member_blocktype=bt_general then
begin
@ -661,7 +661,7 @@ implementation
vdoptions:=[vd_record];
if classfields then
include(vdoptions,vd_class);
read_record_fields(vdoptions,nil);
read_record_fields(vdoptions,nil,nil);
end
else if member_blocktype=bt_type then
types_dec(true)
@ -839,7 +839,7 @@ implementation
end
else
begin
read_record_fields([vd_record],nil);
read_record_fields([vd_record],nil,nil);
{$ifdef jvm}
{ we need a constructor to create temps, a deep copy helper, ... }
add_java_default_record_methods_intf(trecorddef(current_structdef));

75
compiler/symdef.pas
View File

@ -186,7 +186,6 @@ interface
end;
tprocdef = class;
{ tabstractrecorddef }
tabstractrecorddef= class(tstoreddef)
objname,
@ -220,8 +219,26 @@ interface
function contains_float_field : boolean;
end;
pvariantrecdesc = ^tvariantrecdesc;
tvariantrecbranch = record
{ we store only single values here and no ranges because tvariantrecdesc is only needed in iso mode
which does not support range expressions in variant record definitions }
values : array of Tconstexprint;
nestedvariant : pvariantrecdesc;
end;
ppvariantrecdesc = ^pvariantrecdesc;
tvariantrecdesc = record
variantselector : tsym;
variantselectorderef : tderef;
branches : array of tvariantrecbranch;
end;
trecorddef = class(tabstractrecorddef)
public
variantrecdesc : pvariantrecdesc;
isunion : boolean;
constructor create(const n:string; p:TSymtable);
constructor ppuload(ppufile:tcompilerppufile);
@ -3445,6 +3462,28 @@ implementation
constructor trecorddef.ppuload(ppufile:tcompilerppufile);
procedure readvariantrecdesc(var variantrecdesc : pvariantrecdesc);
var
i,j : asizeint;
begin
if ppufile.getbyte=1 then
begin
new(variantrecdesc);
ppufile.getderef(variantrecdesc^.variantselectorderef);
SetLength(variantrecdesc^.branches,ppufile.getasizeint);
for i:=0 to high(variantrecdesc^.branches) do
begin
SetLength(variantrecdesc^.branches[i].values,ppufile.getasizeint);
for j:=0 to high(variantrecdesc^.branches[i].values) do
variantrecdesc^.branches[i].values[j]:=ppufile.getexprint;
readvariantrecdesc(variantrecdesc^.branches[i].nestedvariant);
end;
end
else
variantrecdesc:=nil;
end;
begin
inherited ppuload(recorddef,ppufile);
if df_copied_def in defoptions then
@ -3459,6 +3498,11 @@ implementation
trecordsymtable(symtable).datasize:=ppufile.getasizeint;
trecordsymtable(symtable).paddingsize:=ppufile.getword;
trecordsymtable(symtable).ppuload(ppufile);
{ the variantrecdesc is needed only for iso-like new statements new(prec,1,2,3 ...);
but because iso mode supports no units, there is no need to store the variantrecdesc
in the ppu
}
// readvariantrecdesc(variantrecdesc);
{ requires usefieldalignment to be set }
symtable.defowner:=self;
end;
@ -3560,6 +3604,28 @@ implementation
procedure trecorddef.ppuwrite(ppufile:tcompilerppufile);
procedure writevariantrecdesc(variantrecdesc : pvariantrecdesc);
var
i,j : asizeint;
begin
if assigned(variantrecdesc) then
begin
ppufile.putbyte(1);
ppufile.putderef(variantrecdesc^.variantselectorderef);
ppufile.putasizeint(length(variantrecdesc^.branches));
for i:=0 to high(variantrecdesc^.branches) do
begin
ppufile.putasizeint(length(variantrecdesc^.branches[i].values));
for j:=0 to high(variantrecdesc^.branches[i].values) do
ppufile.putexprint(variantrecdesc^.branches[i].values[j]);
writevariantrecdesc(variantrecdesc^.branches[i].nestedvariant);
end;
end
else
ppufile.putbyte(0);
end;
begin
inherited ppuwrite(ppufile);
if df_copied_def in defoptions then
@ -3572,6 +3638,11 @@ implementation
ppufile.putbyte(byte(trecordsymtable(symtable).usefieldalignment));
ppufile.putasizeint(trecordsymtable(symtable).datasize);
ppufile.putword(trecordsymtable(symtable).paddingsize);
{ the variantrecdesc is needed only for iso-like new statements new(prec,1,2,3 ...);
but because iso mode supports no units, there is no need to store the variantrecdesc
in the ppu
}
// writevariantrecdesc(variantrecdesc);
end;
ppufile.writeentry(ibrecorddef);
@ -4060,8 +4131,6 @@ implementation
end;
{***************************************************************************
TPROCDEF
***************************************************************************}

25
tests/test/tisorec1.pp Normal file
View File

@ -0,0 +1,25 @@
{$mode iso}
type
tr = record
l : longint;
case i : integer of
1 : (s : array[0..255] of char);
2 : (n : integer);
3 : (w : word; case j : integer of
1 : (s : array[0..255] of char);
2 : (a : integer);
);
end;
pr = ^tr;
var
r : pr;
begin
new(r,3,2);
if r^.i<>3 then
halt(1);
if r^.j<>2 then
halt(1);
dispose(r);
writeln('ok');
end.

26
tests/test/tisorec2.pp Normal file
View File

@ -0,0 +1,26 @@
{ %fail }
{$mode iso}
type
tr = record
l : longint;
case i : integer of
1 : (s : array[0..255] of char);
2 : (n : integer);
3 : (w : word; case j : integer of
1 : (s : array[0..255] of char);
2 : (a : integer);
);
end;
pr = ^tr;
var
r : pr;
begin
new(r,3,2,4);
if r^.i<>3 then
halt(1);
if r^.j<>2 then
halt(1);
dispose(r);
writeln('ok');
end.

26
tests/test/tisorec3.pp Normal file
View File

@ -0,0 +1,26 @@
{ %fail }
{$mode iso}
type
tr = record
l : longint;
case i : integer of
1 : (s : array[0..255] of char);
2 : (n : integer);
3 : (w : word; case j : integer of
1 : (s : array[0..255] of char);
2 : (a : integer);
);
end;
pr = ^tr;
var
r : pr;
begin
new(r,1,2);
if r^.i<>3 then
halt(1);
if r^.j<>2 then
halt(1);
dispose(r);
writeln('ok');
end.