+ extension to iso mode: reset/rewrite can take a file name as a second parameter

git-svn-id: trunk@34726 -

.gitattributes

@@ -12583,6 +12583,12 @@ tests/test/tintfcdecl2.pp svneol=native#text/plain
 tests/test/tintfdef.pp svneol=native#text/plain
 tests/test/tintuint.pp svneol=native#text/plain
 tests/test/tisobuf1.pp svneol=native#text/pascal
+tests/test/tisoext1.pp svneol=native#text/pascal
+tests/test/tisoext2.pp svneol=native#text/pascal
+tests/test/tisoext3.pp svneol=native#text/pascal
+tests/test/tisoext4.pp svneol=native#text/pascal
+tests/test/tisoext5.pp svneol=native#text/pascal
+tests/test/tisoext6.pp svneol=native#text/pascal
 tests/test/tisogoto1.pp svneol=native#text/pascal
 tests/test/tisogoto2.pp svneol=native#text/pascal
 tests/test/tisogoto3.pp svneol=native#text/pascal

compiler/compinnr.inc

@@ -91,6 +91,8 @@ const
    in_setstring_x_y_z   = 81;
    in_insert_x_y_z      = 82;
    in_delete_x_y_z      = 83;
+   in_reset_typedfile_name   = 84;
+   in_rewrite_typedfile_name = 85;
 
 { Internal constant functions }
    in_const_sqr        = 100;

compiler/ncal.pas

@@ -3733,7 +3733,8 @@ implementation
                 begin
                   { convert types to those of the prototype, this is required by functions like ror, rol, sar
                     some use however a dummy type (Typedfile) so this would break them }
-                  if not(tprocdef(procdefinition).extnumber in [fpc_in_Reset_TypedFile,fpc_in_Rewrite_TypedFile]) then
+                  if not(tprocdef(procdefinition).extnumber in [in_Reset_TypedFile,in_Rewrite_TypedFile,
+                                                                in_reset_typedfile_name,in_rewrite_typedfile_name]) then
                     begin
                       { bind parasyms to the callparanodes and insert hidden parameters }
                       bind_parasym;

compiler/ninl.pas

@@ -534,19 +534,37 @@ implementation
         { a typed file as argument and we don't have to check it again (JM) }
 
         { add the recsize parameter }
-        { note: for some reason, the parameter of intern procedures with only one }
+
-        {   parameter is gets lifted out of its original tcallparanode (see round }
+        { iso mode extension with name? }
-        {   line 1306 of ncal.pas), so recreate a tcallparanode here (JM)         }
+        if inlinenumber in [in_reset_typedfile_name,in_rewrite_typedfile_name] then
-        left := ccallparanode.create(cordconstnode.create(
+          begin
-          tfiledef(left.resultdef).typedfiledef.size,s32inttype,true),
+            left := ccallparanode.create(cordconstnode.create(
-          ccallparanode.create(left,nil));
+              tfiledef(tcallparanode(tcallparanode(left).nextpara).paravalue.resultdef).typedfiledef.size,s32inttype,true),left);
+          end
+        else
+          begin
+            { note: for some reason, the parameter of intern procedures with only one }
+            {   parameter is gets lifted out of its original tcallparanode (see round }
+            {   line 1306 of ncal.pas), so recreate a tcallparanode here (JM)         }
+            left := ccallparanode.create(cordconstnode.create(
+              tfiledef(left.resultdef).typedfiledef.size,s32inttype,true),
+              ccallparanode.create(left,nil));
+          end;
         { create the correct call }
         if m_isolike_io in current_settings.modeswitches then
           begin
-            if inlinenumber=in_reset_typedfile then
+            case inlinenumber of
-              result := ccallnode.createintern('fpc_reset_typed_iso',left)
+              in_reset_typedfile:
-            else
+                result := ccallnode.createintern('fpc_reset_typed_iso',left);
-              result := ccallnode.createintern('fpc_rewrite_typed_iso',left);
+              in_reset_typedfile_name:
+                result := ccallnode.createintern('fpc_reset_typed_name_iso',left);
+              in_rewrite_typedfile:
+                result := ccallnode.createintern('fpc_rewrite_typed_iso',left);
+              in_rewrite_typedfile_name:
+                result := ccallnode.createintern('fpc_rewrite_typed_name_iso',left);
+              else
+                internalerror(2016101501);
+            end;
           end
         else
           begin
@@ -2990,7 +3008,9 @@ implementation
 
               { the firstpass of the arg has been done in firstcalln ? }
               in_reset_typedfile,
-              in_rewrite_typedfile :
+              in_rewrite_typedfile,
+              in_reset_typedfile_name,
+              in_rewrite_typedfile_name :
                 begin
                   result := handle_reset_rewrite_typed;
                 end;
@@ -3596,6 +3616,8 @@ implementation
           in_settextbuf_file_x,
           in_reset_typedfile,
           in_rewrite_typedfile,
+          in_reset_typedfile_name,
+          in_rewrite_typedfile_name,
           in_str_x_string,
           in_val_x,
           in_read_x,

compiler/nutils.pas

@@ -1325,7 +1325,8 @@ implementation
         if (n.nodetype in [assignn,calln,asmn]) or
           ((n.nodetype=inlinen) and
            (tinlinenode(n).inlinenumber in [in_write_x,in_writeln_x,in_read_x,in_readln_x,in_str_x_string,
-             in_val_x,in_reset_x,in_rewrite_x,in_reset_typedfile,in_rewrite_typedfile,in_settextbuf_file_x,
+             in_val_x,in_reset_x,in_rewrite_x,in_reset_typedfile,in_rewrite_typedfile,
+             in_reset_typedfile_name,in_rewrite_typedfile_name,in_settextbuf_file_x,
              in_inc_x,in_dec_x,in_include_x_y,in_exclude_x_y,in_break,in_continue,in_setlength_x,
              in_finalize_x,in_new_x,in_dispose_x,in_exit,in_copy_x,in_initialize_x,in_leave,in_cycle])
           ) then

rtl/inc/compproc.inc

@@ -760,6 +760,9 @@ Procedure fpc_reset_typed(var f : TypedFile;Size : Longint); compilerproc;
 Procedure fpc_rewrite_typed(var f : TypedFile;Size : Longint); compilerproc;
 Procedure fpc_reset_typed_iso(var f : TypedFile;Size : Longint); compilerproc;
 Procedure fpc_rewrite_typed_iso(var f : TypedFile;Size : Longint); compilerproc;
+Procedure fpc_reset_typed_name_iso(var f : TypedFile;const FileName : String;Size : Longint); compilerproc;
+Procedure fpc_rewrite_typed_name_iso(var f : TypedFile;const FileName : String;Size : Longint); compilerproc;
+
 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;

rtl/inc/innr.inc

@@ -92,6 +92,8 @@ const
    fpc_in_setstring_x_y_z   = 81;
    fpc_in_insert_x_y_z      = 82;
    fpc_in_delete_x_y_z      = 83;
+   fpc_in_reset_typedfile_name   = 84;
+   fpc_in_rewrite_typedfile_name = 85;
 
 { Internal constant functions }
    fpc_in_const_sqr        = 100;

rtl/inc/iso7185.pp

@@ -29,6 +29,11 @@ unit iso7185;
     Procedure Reset(var f : TypedFile);   [INTERNPROC: fpc_in_Reset_TypedFile];
     Procedure Rewrite(var f : TypedFile); [INTERNPROC: fpc_in_Rewrite_TypedFile];
 
+    Procedure Rewrite(var t : Text;const filename : string);
+    Procedure Reset(var t : Text;const filename : string);
+    Procedure Reset(var f : TypedFile;const filename : string);   [INTERNPROC: fpc_in_Reset_TypedFile_Name];
+    Procedure Rewrite(var f : TypedFile;const filename : string); [INTERNPROC: fpc_in_Rewrite_TypedFile_Name];
+
     Function Eof(Var t: Text): Boolean;
     Function Eof:Boolean;
     Function Eoln(Var t: Text): Boolean;
@@ -134,6 +139,30 @@ unit iso7185;
       End;
 
 
+    Procedure Rewrite(var t : Text;const filename : string);[IOCheck];
+      Begin
+        { create file name? }
+        if Textrec(t).mode=0 then
+          Assign(t,filename);
+
+        System.Rewrite(t);
+      End;
+
+
+    Procedure Reset(var t : Text;const filename : string);[IOCheck];
+      Begin
+        case Textrec(t).mode of
+          { create file name? }
+          0:
+            Assign(t,filename);
+          fmOutput:
+            Write(t,#26);
+        end;
+
+        System.Reset(t);
+      End;
+
+
     Function Eof(Var t: Text): Boolean;[IOCheck];
       var
         OldCtrlZMarksEof : Boolean;

rtl/inc/typefile.inc

@@ -118,6 +118,33 @@ Begin
 End;
 
 
+Procedure fpc_reset_typed_name_iso(var f : TypedFile;const FileName : String;Size : Longint);[Public,IOCheck, Alias:'FPC_RESET_TYPED_NAME_ISO']; compilerproc;
+Begin
+  If InOutRes <> 0 then
+   exit;
+
+  { create file name? }
+  if FileRec(f).mode=0 then
+    Assign(f,FileName);
+
+  Reset(UnTypedFile(f),Size);
+  BlockRead(UntypedFile(f),(pbyte(@f)+sizeof(FileRec))^,1);
+End;
+
+
+Procedure fpc_rewrite_typed_name_iso(var f : TypedFile;const FileName : String;Size : Longint);[Public,IOCheck, Alias:'FPC_REWRITE_TYPED_NAME_ISO']; compilerproc;
+Begin
+  If InOutRes <> 0 then
+   exit;
+
+  { create file name? }
+  if FileRec(f).mode=0 then
+    Assign(f,FileName);
+
+  Rewrite(UnTypedFile(f),Size);
+End;
+
+
 Procedure fpc_typed_write(TypeSize : Longint;var f : TypedFile;const Buf);[IOCheck, Public, Alias :'FPC_TYPED_WRITE']; compilerproc;
 Begin
   If InOutRes <> 0 then

tests/test/tisoext1.pp

@@ -0,0 +1,17 @@
+{$mode iso}
+var
+  f : file of byte;
+  b : byte;
+begin
+  rewrite(f,'tisoext1.tmp');
+  write(f,123);
+  close(f);
+  b:=0;
+  reset(f,'tisoext1.tmp');
+  read(f,b);
+  if b<>123 then
+    halt(1);
+  close(f);
+  writeln('ok');
+end.
+

tests/test/tisoext2.pp

@@ -0,0 +1,14 @@
+{ %fail }
+{ this is not supposed to compile in non iso mode }
+var
+  f : file of byte;
+  b : byte;
+begin
+  reset(f,'tisoext1.tmp');
+  read(f,b);
+  if b<>123 then
+    halt(1);
+  close(f);
+  writeln('ok');
+end.
+

tests/test/tisoext3.pp

@@ -0,0 +1,10 @@
+{ %fail }
+{ this is not supposed to compile in non iso mode }
+var
+  f : file of byte;
+  b : byte;
+begin
+  rewrite(f,'tisoext1.tmp');
+  write(f,123);
+  close(f);
+end.

tests/test/tisoext4.pp

@@ -0,0 +1,16 @@
+{$mode iso}
+var
+  f : text;
+  s : array[0..10] of char;
+begin
+  rewrite(f,'tisoext4.tmp');
+  write(f,'FPC');
+  close(f);
+  reset(f,'tisoext4.tmp');
+  read(f,s);
+  if s<>'FPC' then
+    halt(1);
+  close(f);
+  writeln('ok');
+end.
+

tests/test/tisoext5.pp

@@ -0,0 +1,14 @@
+{ %fail }
+{ this is not supposed to compile in non iso mode }
+var
+  f : text;
+  s : array[0..10] of char;
+begin
+  reset(f,'tisoext4.tmp');
+  read(f,s);
+  if s<>'FPC' then
+    halt(1);
+  close(f);
+  writeln('ok');
+end.
+

tests/test/tisoext6.pp

@@ -0,0 +1,12 @@
+{ %fail }
+{ this is not supposed to compile in non iso mode }
+var
+  f : text;
+  s : array[0..10] of char;
+begin
+  rewrite(f,'tisoext4.tmp');
+  write(f,'FPC');
+  close(f);
+  writeln('ok');
+end.
+