# revisions: 45519,46865,46918

git-svn-id: branches/fixes_3_2@47095 -

.gitattributes

@@ -14617,6 +14617,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
@@ -16054,6 +16055,7 @@ tests/webtbf/uw4541.pp svneol=native#text/pascal
 tests/webtbf/uw6922.pp svneol=native#text/plain
 tests/webtbf/uw8738a.pas svneol=native#text/plain
 tests/webtbf/uw8738b.pas svneol=native#text/plain
+tests/webtbs/DAT_TW37415 svneol=native#text/plain
 tests/webtbs/Integer.ns.pp svneol=native#text/pascal
 tests/webtbs/Integer.pp svneol=native#text/pascal
 tests/webtbs/tu2002.pp svneol=native#text/plain
@@ -17688,6 +17690,7 @@ tests/webtbs/tw3700.pp svneol=native#text/plain
 tests/webtbs/tw37013.pp svneol=native#text/plain
 tests/webtbs/tw37060.pp svneol=native#text/plain
 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/tw37154.pp svneol=native#text/pascal
@@ -17698,6 +17701,7 @@ tests/webtbs/tw37322.pp svneol=native#text/pascal
 tests/webtbs/tw37323.pp svneol=native#text/pascal
 tests/webtbs/tw37355.pp svneol=native#text/pascal
 tests/webtbs/tw37397.pp svneol=native#text/plain
+tests/webtbs/tw37415.pp svneol=native#text/plain
 tests/webtbs/tw3742.pp svneol=native#text/plain
 tests/webtbs/tw3751.pp svneol=native#text/plain
 tests/webtbs/tw3758.pp svneol=native#text/plain

compiler/ngenutil.pas

@@ -105,9 +105,9 @@ interface
       class procedure insertbsssym(list: tasmlist; sym: tstaticvarsym; size: asizeint; varalign: shortint); virtual;
 
       { initialization of iso styled program parameters }
-      class procedure initialize_textrec(p : TObject; statn : pointer);
+      class procedure initialize_filerecs(p : TObject; statn : pointer);
       { finalization of iso styled program parameters }
-      class procedure finalize_textrec(p : TObject; statn : pointer);
+      class procedure finalize_filerecs(p : TObject; statn : pointer);
      public
       class procedure insertbssdata(sym : tstaticvarsym); virtual;
 
@@ -533,49 +533,83 @@ implementation
     end;
 
 
-  class procedure tnodeutils.initialize_textrec(p:TObject;statn:pointer);
+  class procedure tnodeutils.initialize_filerecs(p:TObject;statn:pointer);
     var
       stat: ^tstatementnode absolute statn;
     begin
       if (tsym(p).typ=staticvarsym) and
-       (tstaticvarsym(p).vardef.typ=filedef) and
-       (tfiledef(tstaticvarsym(p).vardef).filetyp=ft_text) and
-       (tstaticvarsym(p).isoindex<>0) then
-       begin
-         if cs_transparent_file_names in current_settings.globalswitches then
-           addstatement(stat^,ccallnode.createintern('fpc_textinit_filename_iso',
-             ccallparanode.create(
-               cstringconstnode.createstr(tstaticvarsym(p).Name),
-             ccallparanode.create(
-               cordconstnode.create(tstaticvarsym(p).isoindex,uinttype,false),
-             ccallparanode.create(
-               cloadnode.create(tstaticvarsym(p),tstaticvarsym(p).Owner),
-             nil)))))
-         else
-           addstatement(stat^,ccallnode.createintern('fpc_textinit_iso',
-             ccallparanode.create(
-               cordconstnode.create(tstaticvarsym(p).isoindex,uinttype,false),
-             ccallparanode.create(
-               cloadnode.create(tstaticvarsym(p),tstaticvarsym(p).Owner),
-             nil))));
-       end;
+        (tstaticvarsym(p).vardef.typ=filedef) and
+        (tstaticvarsym(p).isoindex<>0) then
+        case tfiledef(tstaticvarsym(p).vardef).filetyp of
+          ft_text:
+            begin
+              if cs_transparent_file_names in current_settings.globalswitches then
+                addstatement(stat^,ccallnode.createintern('fpc_textinit_filename_iso',
+                  ccallparanode.create(
+                    cstringconstnode.createstr(tstaticvarsym(p).Name),
+                  ccallparanode.create(
+                    cordconstnode.create(tstaticvarsym(p).isoindex,uinttype,false),
+                  ccallparanode.create(
+                    cloadnode.create(tstaticvarsym(p),tstaticvarsym(p).Owner),
+                  nil)))))
+              else
+                addstatement(stat^,ccallnode.createintern('fpc_textinit_iso',
+                  ccallparanode.create(
+                    cordconstnode.create(tstaticvarsym(p).isoindex,uinttype,false),
+                  ccallparanode.create(
+                    cloadnode.create(tstaticvarsym(p),tstaticvarsym(p).Owner),
+                  nil))));
+            end;
+          ft_typed:
+            begin
+              if cs_transparent_file_names in current_settings.globalswitches then
+                addstatement(stat^,ccallnode.createintern('fpc_typedfile_init_filename_iso',
+                  ccallparanode.create(
+                    cstringconstnode.createstr(tstaticvarsym(p).Name),
+                  ccallparanode.create(
+                    cordconstnode.create(tstaticvarsym(p).isoindex,uinttype,false),
+                  ccallparanode.create(
+                    cloadnode.create(tstaticvarsym(p),tstaticvarsym(p).Owner),
+                  nil)))))
+              else
+                addstatement(stat^,ccallnode.createintern('fpc_typedfile_init_iso',
+                  ccallparanode.create(
+                    cordconstnode.create(tstaticvarsym(p).isoindex,uinttype,false),
+                  ccallparanode.create(
+                    cloadnode.create(tstaticvarsym(p),tstaticvarsym(p).Owner),
+                  nil))));
+            end;
+          else
+            ;
+        end;
     end;
 
 
-  class procedure tnodeutils.finalize_textrec(p:TObject;statn:pointer);
+  class procedure tnodeutils.finalize_filerecs(p:TObject;statn:pointer);
     var
       stat: ^tstatementnode absolute statn;
     begin
       if (tsym(p).typ=staticvarsym) and
-       (tstaticvarsym(p).vardef.typ=filedef) and
-       (tfiledef(tstaticvarsym(p).vardef).filetyp=ft_text) and
-       (tstaticvarsym(p).isoindex<>0) then
-       begin
-         addstatement(stat^,ccallnode.createintern('fpc_textclose_iso',
-           ccallparanode.create(
-             cloadnode.create(tstaticvarsym(p),tstaticvarsym(p).Owner),
-           nil)));
-       end;
+        (tstaticvarsym(p).vardef.typ=filedef) and
+        (tstaticvarsym(p).isoindex<>0) then
+        case tfiledef(tstaticvarsym(p).vardef).filetyp of
+          ft_text:
+            begin
+              addstatement(stat^,ccallnode.createintern('fpc_textclose_iso',
+                ccallparanode.create(
+                  cloadnode.create(tstaticvarsym(p),tstaticvarsym(p).Owner),
+                nil)));
+            end;
+          ft_typed:
+            begin
+              addstatement(stat^,ccallnode.createintern('fpc_typedfile_close_iso',
+                ccallparanode.create(
+                  cloadnode.create(tstaticvarsym(p),tstaticvarsym(p).Owner),
+                nil)));
+            end;
+          else
+            ;
+        end;
     end;
 
 
@@ -607,9 +641,9 @@ implementation
         (pd.proctypeoption=potype_proginit) then
         begin
           block:=internalstatements(stat);
-          pd.localst.SymList.ForEachCall(@initialize_textrec,@stat);
+          pd.localst.SymList.ForEachCall(@initialize_filerecs,@stat);
           addstatement(stat,result);
-          pd.localst.SymList.ForEachCall(@finalize_textrec,@stat);
+          pd.localst.SymList.ForEachCall(@finalize_filerecs,@stat);
           result:=block;
         end;
 

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
@@ -406,6 +417,8 @@ implementation
                        else
                          addstatement(newstatement,cnodeutils.finalize_data_node(cderefnode.create(p.getcopy)));
 
+                     ReadVariantRecordConstants;
+
                      { create call to fpc_freemem }
                      if not assigned(temp) then
                        para := ccallparanode.create(p,nil)

rtl/inc/compproc.inc

@@ -810,6 +810,11 @@ Procedure fpc_rewrite_typed_name_iso(var f : TypedFile;const FileName : String;S
 Procedure fpc_typed_write(TypeSize : Longint;var f : TypedFile;const Buf); compilerproc;
 Procedure fpc_typed_read(TypeSize : Longint;var f : TypedFile;out Buf); compilerproc;
 Procedure fpc_typed_read_iso(TypeSize : Longint;var f : TypedFile;out Buf); compilerproc;
+
+Procedure fpc_typedfile_init_iso(var t : TypedFile;nr : DWord);compilerproc;
+Procedure fpc_typedfile_init_filename_iso(var t : TypedFile;nr : DWord;const filename : string); compilerproc;
+Procedure fpc_typedfile_close_iso(var t : TypedFile); compilerproc;
+
 {$endif FPC_HAS_FEATURE_FILEIO}
 
 {$ifdef FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE}

rtl/inc/iso7185.pp

@@ -206,8 +206,10 @@ unit iso7185;
 
     procedure Get(var f:TypedFile);[IOCheck];
       Begin
-        if not(eof(f)) then
-          BlockRead(f,(pbyte(@f)+sizeof(FileRec))^,1);
+        if not(system.eof(f)) then
+          BlockRead(f,(pbyte(@f)+sizeof(FileRec))^,1)
+        else
+          FileRec(f)._private[1]:=1;
       End;
 
 

rtl/inc/typefile.inc

@@ -199,3 +199,44 @@ Begin
   Result:=pbyte(@f)+sizeof(TypedFile);
 end;
 
+
+Procedure fpc_typedfile_init_iso(var t : TypedFile;nr : DWord);compilerproc;
+begin
+{$ifdef FPC_HAS_FEATURE_COMMANDARGS}
+  assign(t,paramstr(nr));
+{$else FPC_HAS_FEATURE_COMMANDARGS}
+  { primitive workaround for targets supporting no command line arguments,
+    invent some file name, try to avoid complex procedures like concating strings which might
+    pull-in bigger parts of the rtl }
+  assign(t,chr((nr mod 16)+65));
+{$endif FPC_HAS_FEATURE_COMMANDARGS}
+end;
+
+
+Procedure fpc_typedfile_init_filename_iso(var t : TypedFile;nr : DWord;const filename : string);compilerproc;
+begin
+{$ifdef FPC_HAS_FEATURE_COMMANDARGS}
+  if paramstr(nr)='' then
+    assign(t,filename)
+  else
+    assign(t,paramstr(nr));
+{$else FPC_HAS_FEATURE_COMMANDARGS}
+  { primitive workaround for targets supporting no command line arguments,
+    invent some file name, try to avoid complex procedures like concating strings which might
+    pull-in bigger parts of the rtl }
+  assign(t,chr((nr mod 16)+65));
+{$endif FPC_HAS_FEATURE_COMMANDARGS}
+end;
+
+
+
+Procedure fpc_typedfile_close_iso(var t : TypedFile);compilerproc;
+begin
+  { reset inout result as this procedure is only called by the compiler and no I/O checking is carried out,
+    so further I/O does not fail }
+  inoutres:=0;
+  close(t);
+  inoutres:=0;
+end;
+
+

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.

tests/webtbs/DAT_TW37415

@@ -0,0 +1 @@
+1234

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.

tests/webtbs/tw37415.pp

@@ -0,0 +1,9 @@
+{ %OPT=-Miso -Sr }
+{ %FILES=DAT_TW37415 }
+program fileTest(dat_tw37415);
+
+var
+  dat_tw37415: file of integer;
+begin
+  reset(dat_tw37415);
+end.