re PR fortran/80741 ([Regression 7/8] DTIO wrong code causes incorrect behaviour...

2017-05-17  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libgfortran/80741
	* transfer.c (finalize_transfer): Reset last_char to 'empty'.
	* file_pos.c (formatted_backspace): Likewise.
	(st_endfile): Likewise.
	(st_rewind): Likewise.
	(st_flush): Likewise.

	PR fortran/80741
	* trans-io.c (transfer_namelist_element): Change check from
	NULL_TREE to null_pointer_node.

From-SVN: r248170

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e978f32b8be7430e26436ea3c548be455321eff9..703060d32ab7b8fc3c23f9c67ddc4b203c10469a 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2017-05-17  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+       PR fortran/80741
+       * trans-io.c (transfer_namelist_element): Change check from
+       NULL_TREE to null_pointer_node.
+
 2017-05-17  Fritz Reese <fritzoreese@gmail.com>
 
        PR fortran/80668

diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
index 1b70136f493568e55cea432ff585e735ce27cbdd..c557c1140d82bc76ef846ad340511834e576004b 100644 (file)
--- a/gcc/fortran/trans-io.c
+++ b/gcc/fortran/trans-io.c
@@ -1756,7 +1756,7 @@ transfer_namelist_element (stmtblock_t * block, const char * var_name,
   else
     tmp = build_int_cst (gfc_charlen_type_node, 0);
 
-  if (dtio_proc == NULL_TREE)
+  if (dtio_proc == null_pointer_node)
     tmp = build_call_expr_loc (input_location,
                           iocall[IOCALL_SET_NML_VAL], 6,
                           dt_parm_addr, addr_expr, string,

diff --git a/gcc/testsuite/gfortran.dg/read_4.f90 b/gcc/testsuite/gfortran.dg/read_4.f90
new file mode 100644 (file)
index 0000000..7a835b1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/read_4.f90
@@ -0,0 +1,35 @@
+! { dg-do run }
+! PR80741 wrong code causes incorrect behaviour of namelist READ
+program p
+  use, intrinsic :: iso_fortran_env, only: iostat_end
+  implicit none
+  integer :: x, y, ios, io
+  character(10) :: line
+  namelist /test/ x, y
+  
+  x = 10
+  y = 10
+  ios = 0
+  io = 10
+  open(unit=io, status='scratch')
+  write(io, test)
+  write(io, *) 'done'
+  rewind(io)
+  x = 0
+  y = 0
+  read(io, test)
+  if (x.ne.10 .or. y.ne.10) call abort
+  !
+  read(io, *) line
+  if (line.ne.'done') call abort
+  !
+  read(io, *, iostat=ios) line
+  if (ios/=iostat_end) call abort
+  rewind(io)
+  x = 0
+  y = 0
+  read(io, test)
+  if (x.ne.10 .or. y.ne.10) call abort
+  read(io, *, iostat=ios) line
+  if (line.ne.'done') call abort
+end

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index b604147ffee29d3f375e88d6df012bbcd91e5865..7fe527dda3e3bc7f8e462150c94725effed1c29e 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,12 @@
+2017-05-17  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+       PR libgfortran/80741
+       * transfer.c (finalize_transfer): Reset last_char to 'empty'.
+       * file_pos.c (formatted_backspace): Likewise.
+       (st_endfile): Likewise.
+       (st_rewind): Likewise.
+       (st_flush): Likewise.
+       
 2017-05-15  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        PR libgfortran/80727

diff --git a/libgfortran/io/file_pos.c b/libgfortran/io/file_pos.c
index 5af9619bf4650a6133f36fb3d88621932d5ef930..771d548ea1d968a7dd0ea22c45f231a872f593ed 100644 (file)
--- a/libgfortran/io/file_pos.c
+++ b/libgfortran/io/file_pos.c
@@ -82,7 +82,7 @@ formatted_backspace (st_parameter_filepos *fpp, gfc_unit *u)
     goto io_error;
   u->last_record--;
   u->endfile = NO_ENDFILE;
-
+  u->last_char = EOF - 1;
   return;
 
  io_error:
@@ -322,6 +322,7 @@ st_endfile (st_parameter_filepos *fpp)
 
       unit_truncate (u, stell (u->s), &fpp->common);
       u->endfile = AFTER_ENDFILE;
+      u->last_char = EOF - 1;
       if (0 == stell (u->s))
         u->flags.position = POSITION_REWIND;
     }
@@ -371,6 +372,7 @@ st_endfile (st_parameter_filepos *fpp)
          if (u == NULL)
            return;
          u->endfile = AFTER_ENDFILE;
+         u->last_char = EOF - 1;
        }
     }
 
@@ -430,6 +432,7 @@ st_rewind (st_parameter_filepos *fpp)
          u->current_record = 0;
          u->strm_pos = 1;
          u->read_bad = 0;
+         u->last_char = EOF - 1;
        }
       /* Update position for INQUIRE.  */
       u->flags.position = POSITION_REWIND;
@@ -458,6 +461,7 @@ st_flush (st_parameter_filepos *fpp)
         fbuf_flush (u, u->mode);
 
       sflush (u->s);
+      u->last_char = EOF - 1;
       unlock_unit (u);
     }
   else

diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 928a448f74cf93121dc4e09912f023b20b094e51..298b29e8d3ef2e11ebe49256a42304d59ad2dd8b 100644 (file)
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -3977,7 +3977,7 @@ finalize_transfer (st_parameter_dt *dtp)
       fbuf_seek (dtp->u.p.current_unit, 0, SEEK_END);
 
   dtp->u.p.current_unit->saved_pos = 0;
-
+  dtp->u.p.current_unit->last_char = EOF - 1;
   next_record (dtp, 1);
 
  done: