* ISO mode: handle typed files as text files regarding naming/program parameters, resolves #37415

git-svn-id: trunk@46865 -

.gitattributes

@@ -16718,6 +16718,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
@@ -18437,6 +18438,7 @@ tests/webtbs/tw37393.pp svneol=native#text/pascal
 tests/webtbs/tw37397.pp svneol=native#text/plain
 tests/webtbs/tw37398.pp svneol=native#text/pascal
 tests/webtbs/tw37400.pp svneol=native#text/pascal
+tests/webtbs/tw37415.pp svneol=native#text/plain
 tests/webtbs/tw3742.pp svneol=native#text/plain
 tests/webtbs/tw37423.pp svneol=native#text/plain
 tests/webtbs/tw37427.pp svneol=native#text/pascal

compiler/ngenutil.pas

@@ -105,9 +105,9 @@ interface
       class procedure insertbsssym(list: tasmlist; sym: tstaticvarsym; size: asizeint; varalign: shortint; _typ: Tasmsymtype); 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;
 
@@ -546,49 +546,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;
 
 
@@ -637,9 +671,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;
 

rtl/inc/compproc.inc

@@ -806,6 +806,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/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/webtbs/DAT_TW37415

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

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.