From 8f88112bfef434ff1ab17af96d8d2fd2c6c17e26 Mon Sep 17 00:00:00 2001 From: florian Date: Wed, 27 May 2020 21:10:55 +0000 Subject: [PATCH] * allow in iso mode constants selecting the branch to dispose of a variant record (no functional effect though), resolves #37085 git-svn-id: trunk@45519 - --- .gitattributes | 2 + compiler/pinline.pas | 101 +++++++++++++++++++++++----------------- tests/test/tisorec5.pp | 25 ++++++++++ tests/webtbs/tw37085.pp | 18 +++++++ 4 files changed, 102 insertions(+), 44 deletions(-) create mode 100644 tests/test/tisorec5.pp create mode 100644 tests/webtbs/tw37085.pp diff --git a/.gitattributes b/.gitattributes index c231d156fa..245acfe350 100644 --- a/.gitattributes +++ b/.gitattributes @@ -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 diff --git a/compiler/pinline.pas b/compiler/pinline.pas index 32d0adb788..cf0bcfc1f6 100644 --- a/compiler/pinline.pas +++ b/compiler/pinline.pas @@ -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)); diff --git a/tests/test/tisorec5.pp b/tests/test/tisorec5.pp new file mode 100644 index 0000000000..e0bc59f34d --- /dev/null +++ b/tests/test/tisorec5.pp @@ -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. diff --git a/tests/webtbs/tw37085.pp b/tests/webtbs/tw37085.pp new file mode 100644 index 0000000000..a033337e05 --- /dev/null +++ b/tests/webtbs/tw37085.pp @@ -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. \ No newline at end of file