paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-06-03 17:38:20 +02:00
Code Issues Packages Projects Releases Wiki Activity

* allow in iso mode constants selecting the branch to dispose of a variant record (no functional effect though), resolves #37085

Browse Source 
git-svn-id: trunk@45519 -
This commit is contained in:
florian 2020-05-27 21:10:55 +00:00
parent 683c5c8faf
commit 8f88112bfe
4 changed files with 102 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -15115,6 +15115,7 @@ 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/tisorec4.pp svneol=native#text/pascal
tests/test/tisorec5.pp svneol=native#text/pascal
tests/test/tlea1.pp svneol=native#text/plain
tests/test/tlea2.pp svneol=native#text/plain
tests/test/tlib1a.pp svneol=native#text/plain
@ -18293,6 +18294,7 @@ tests/webtbs/tw37013.pp svneol=native#text/plain
tests/webtbs/tw37060.pp svneol=native#text/plain
tests/webtbs/tw37062.pp svneol=native#text/pascal
tests/webtbs/tw3708.pp svneol=native#text/plain
tests/webtbs/tw37085.pp svneol=native#text/pascal
tests/webtbs/tw37095.pp svneol=native#text/plain
tests/webtbs/tw37095d/uw37095.pp svneol=native#text/plain
tests/webtbs/tw37107.pp svneol=native#text/pascal

101
compiler/pinline.pas
View File

@ -74,8 +74,60 @@ implementation
storepos : tfileposinfo;
variantdesc : pvariantrecdesc;
found : boolean;
j,i : longint;
variantselectsymbol : tfieldvarsym;
procedure ReadVariantRecordConstants;
var
i,j : longint;
begin
if (([m_iso,m_extpas]*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,[]);
do_typecheckpass(p2);
if p2.nodetype=ordconstn then
begin
found:=false;
{ we do not have dynamic dfa, so avoid warning on variantselectsymbol below }
variantselectsymbol:=nil;
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
if is_new then
begin
{ if no tag-field is given, do not create an assignment statement for it }
if assigned(variantselectsymbol) then
{ setup variant selector }
addstatement(newstatement,cassignmentnode.create(
csubscriptnode.create(variantselectsymbol,
cderefnode.create(ctemprefnode.create(temp))),
p2));
end;
end
else
Message(parser_e_illegal_expression);
end
else
Message(parser_e_illegal_expression);
end;
end;
end;
begin
if target_info.system in systems_managed_vm then
message(parser_e_feature_unsupported_for_vm);
@ -345,49 +397,8 @@ implementation
p,
ctemprefnode.create(temp)));
if (([m_iso,m_extpas]*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,[]);
do_typecheckpass(p2);
if p2.nodetype=ordconstn then
begin
found:=false;
{ we do not have dynamic dfa, so avoid warning on variantselectsymbol below }
variantselectsymbol:=nil;
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
{ if no tag-field is given, do not create an assignment statement for it }
if assigned(variantselectsymbol) then
{ 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;
ReadVariantRecordConstants;
{ release temp }
addstatement(newstatement,ctempdeletenode.create(temp));
end
@ -397,6 +408,8 @@ implementation
if is_managed_type(tpointerdef(p.resultdef).pointeddef) then
addstatement(newstatement,cnodeutils.finalize_data_node(cderefnode.create(p.getcopy)));
ReadVariantRecordConstants;
{ create call to fpc_freemem }
para := ccallparanode.create(p,nil);
addstatement(newstatement,ccallnode.createintern('fpc_freemem',para));

25
tests/test/tisorec5.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 : (t : 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,3,2);
writeln('ok');
end.

18
tests/webtbs/tw37085.pp Normal file
View File

@ -0,0 +1,18 @@
{$mode iso}
type
v = ^x;
x = record
n: Integer;
case b: Boolean OF
True: (x0: Real);
False: (x1, x2: Integer)
end;
var
a: v;
begin
New(a, True);
Dispose(a, True);
end.