+ introduce tvariantrecbranch to be able to store

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

git-svn-id: trunk@24241 -

.gitattributes

@@ -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

compiler/node.pas

@@ -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.

compiler/pdecobj.pas

@@ -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)

compiler/pdecvar.pas

@@ -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);

compiler/pinline.pas

@@ -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

compiler/ptype.pas

@@ -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));

compiler/symdef.pas

@@ -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
 ***************************************************************************}

tests/test/tisorec1.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 : (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.

tests/test/tisorec2.pp

@@ -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.

tests/test/tisorec3.pp

@@ -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.