2017-03-25 Jerry DeLisle <jvdelisle@gcc.gnu.org>

	PR libgfortran/78881
	* io/io.h (st_parameter_dt): Rename unused component last_char to
	child_saved_iostat. Move comment to gfc_unit.
	* io/list_read.c (list_formatted_read_scalar): After call to
	child READ procedure, save the returned iostat value for later
	check. (finish_list_read): Only finish READ if child_saved_iostat
	was OK.
	* io/transfer.c (read_sf_internal): If there is a saved character
	in last character, seek back one. Add a new check for EOR
	condition. (read_sf): If there is a saved character
	in last character, seek back one. (formatted_transfer_scalar_read):
	Initialize last character before invoking child procedure.
	(data_transfer_init): If child dtio, set advance
	status to nonadvancing. Move update of size and check for EOR
	condition to before child dtio return.

	* gfortran.dg/dtio_26.f90: New test.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@246478 138bc75d-0d04-0410-961f-82ee72b054a4

4 files changed, 74 insertions, 21 deletions

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 96b75e9292a..12e3f1fa696 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,21 @@
+2017-03-25  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR libgfortran/78881
+	* io/io.h (st_parameter_dt): Rename unused component last_char to
+	child_saved_iostat. Move comment to gfc_unit.
+	* io/list_read.c (list_formatted_read_scalar): After call to
+	child READ procedure, save the returned iostat value for later
+	check. (finish_list_read): Only finish READ if child_saved_iostat
+	was OK.
+	* io/transfer.c (read_sf_internal): If there is a saved character
+	in last character, seek back one. Add a new check for EOR
+	condition. (read_sf): If there is a saved character
+	in last character, seek back one. (formatted_transfer_scalar_read):
+	Initialize last character before invoking child procedure.
+	(data_transfer_init): If child dtio, set advance
+	status to nonadvancing. Move update of size and check for EOR
+	condition to before child dtio return.
+
 2017-03-17  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	PR libfortran/79956
diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index 277c5ed7806..df491577349 100644
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -534,10 +534,7 @@ typedef struct st_parameter_dt
 	  unsigned expanded_read : 1;
 	  /* 13 unused bits.  */
 
-	  /* Used for ungetc() style functionality. Possible values
-	     are an unsigned char, EOF, or EOF - 1 used to mark the
-	     field as not valid.  */
-	  int last_char; /* No longer used, moved to gfc_unit.  */
+	  int child_saved_iostat;
 	  int nml_delim;
 	  int repeat_count;
 	  int saved_length;
@@ -701,6 +698,10 @@ typedef struct gfc_unit
 
   /* DTIO Parent/Child procedure, 0 = parent, >0 = child level.  */
   int child_dtio;
+
+  /* Used for ungetc() style functionality. Possible values
+     are an unsigned char, EOF, or EOF - 1 used to mark the
+     field as not valid.  */
   int last_char;
   bool has_size;
   GFC_IO_INT size_used;
diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index 7f57ff1a916..39805baaeab 100644
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -2221,6 +2221,7 @@ list_formatted_read_scalar (st_parameter_dt *dtp, bt type, void *p,
 	  dtp->u.p.fdtio_ptr (p, &unit, iotype, &vlist,
 			      child_iostat, child_iomsg,
 			      iotype_len, child_iomsg_len);
+	  dtp->u.p.child_saved_iostat = *child_iostat;
 	  dtp->u.p.current_unit->child_dtio--;
       }
       break;
@@ -2352,15 +2353,18 @@ finish_list_read (st_parameter_dt *dtp)
       /* Set the next_char and push_char worker functions.  */
       set_workers (dtp);
 
-      c = next_char (dtp);
-      if (c == EOF)
+      if (likely (dtp->u.p.child_saved_iostat == LIBERROR_OK))
 	{
-	  free_line (dtp);
-	  hit_eof (dtp);
-	  return;
+	  c = next_char (dtp);
+	  if (c == EOF)
+	    {
+	      free_line (dtp);
+	      hit_eof (dtp);
+	      return;
+	    }
+	  if (c != '\n')
+	    eat_line (dtp);
 	}
-      if (c != '\n')
-	eat_line (dtp);
     }
 
   free_line (dtp);
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index fc22d802196..1e56b5de136 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -226,7 +226,7 @@ static char *
 read_sf_internal (st_parameter_dt *dtp, int * length)
 {
   static char *empty_string[0];
-  char *base;
+  char *base = NULL;
   int lorig;
 
   /* Zero size array gives internal unit len of 0.  Nothing to read. */
@@ -244,6 +244,15 @@ read_sf_internal (st_parameter_dt *dtp, int * length)
       return (char*) empty_string;
     }
 
+  /* There are some cases with mixed DTIO where we have read a character
+     and saved it in the last character buffer, so we need to backup.  */
+  if (unlikely (dtp->u.p.current_unit->child_dtio > 0 &&
+		dtp->u.p.current_unit->last_char != EOF - 1))
+    {
+      dtp->u.p.current_unit->last_char = EOF - 1;
+      sseek (dtp->u.p.current_unit->s, -1, SEEK_CUR);
+    }
+
   lorig = *length;
   if (is_char4_unit(dtp))
     {
@@ -263,6 +272,12 @@ read_sf_internal (st_parameter_dt *dtp, int * length)
       return NULL;
     }
 
+  if (base && *base == 0)
+    {
+      generate_error (&dtp->common, LIBERROR_EOR, NULL);
+      return NULL;
+    }
+
   dtp->u.p.current_unit->bytes_left -= *length;
 
   if (((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) ||
@@ -304,6 +319,15 @@ read_sf (st_parameter_dt *dtp, int * length)
       return (char*) empty_string;
     }
 
+  /* There are some cases with mixed DTIO where we have read a character
+     and saved it in the last character buffer, so we need to backup.  */
+  if (unlikely (dtp->u.p.current_unit->child_dtio > 0 &&
+		dtp->u.p.current_unit->last_char != EOF - 1))
+    {
+      dtp->u.p.current_unit->last_char = EOF - 1;
+      fbuf_seek (dtp->u.p.current_unit, -1, SEEK_CUR);
+    }
+
   n = seen_comma = 0;
 
   /* Read data into format buffer and scan through it.  */
@@ -1499,6 +1523,7 @@ formatted_transfer_scalar_read (st_parameter_dt *dtp, bt type, void *p, int kind
 
 	  /* Call the user defined formatted READ procedure.  */
 	  dtp->u.p.current_unit->child_dtio++;
+	  dtp->u.p.current_unit->last_char = EOF - 1;
 	  dtp->u.p.fdtio_ptr (p, &unit, iotype, f->u.udf.vlist,
 			      child_iostat, child_iomsg,
 			      iotype_len, child_iomsg_len);
@@ -2856,6 +2881,11 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
 	}
     }
 
+  /* Child IO is non-advancing and any ADVANCE= specifier is ignored.
+     F2008 9.6.2.4  */
+  if (dtp->u.p.current_unit->child_dtio  > 0)
+    dtp->u.p.advance_status = ADVANCE_NO;
+
   if (read_flag)
     {
       dtp->u.p.current_unit->previous_nonadvancing_write = 0;
@@ -3856,6 +3886,15 @@ finalize_transfer (st_parameter_dt *dtp)
 	 namelist_write (dtp);
     }
 
+  if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
+    *dtp->size = dtp->u.p.current_unit->size_used;
+
+  if (dtp->u.p.eor_condition)
+    {
+      generate_error (&dtp->common, LIBERROR_EOR, NULL);
+      goto done;
+    }
+
   if (dtp->u.p.current_unit && (dtp->u.p.current_unit->child_dtio  > 0))
     {
       if (cf & IOPARM_DT_HAS_FORMAT)
@@ -3866,15 +3905,6 @@ finalize_transfer (st_parameter_dt *dtp)
       return;
     }
 
-  if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
-    *dtp->size = dtp->u.p.current_unit->size_used;
-
-  if (dtp->u.p.eor_condition)
-    {
-      generate_error (&dtp->common, LIBERROR_EOR, NULL);
-      goto done;
-    }
-
   if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK)
     {
       if (dtp->u.p.current_unit && current_mode (dtp) == UNFORMATTED_SEQUENTIAL)