re PR fortran/78854 ([F03] DTIO namelist output not working on internal unit)

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

	PR libgfortran/78854
	* io/list_read.c (nml_get_obj_data): Stash internal unit for
	later use by child procedures.
	* io/write.c (nml_write_obj): Likewise.
	* io/tranfer.c (data_transfer_init): Minor whitespace.
	* io/unit.c (set_internal_uit): Look for the stashed internal
	unit and use it if found.

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

From-SVN: r246070

5 files changed, 36 insertions, 0 deletions

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index bd2f7266..c16b678 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,13 @@
+2017-03-11  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR libgfortran/78854
+	* io/list_read.c (nml_get_obj_data): Stash internal unit for
+	later use by child procedures.
+	* io/write.c (nml_write_obj): Likewise.
+	* io/tranfer.c (data_transfer_init): Minor whitespace.
+	* io/unit.c (set_internal_uit): Look for the stashed internal
+	unit and use it if found.
+
 2017-03-10  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	PR libfortran/79956
diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index dd4ab72..7f57ff1 100644
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -3301,6 +3301,11 @@ get_name:
 	  child_iomsg_len = IOMSG_LEN;
 	}
 
+      /* If reading from an internal unit, stash it to allow
+	 the child procedure to access it.  */
+      if (is_internal_unit (dtp))
+	stash_internal_unit (dtp);
+
       /* Call the user defined formatted READ procedure.  */
       dtp->u.p.current_unit->child_dtio++;
       dtio_ptr ((void *)&list_obj, &unit, iotype, &vlist,
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 36786c0..fc22d80 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -2822,6 +2822,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
 	  return;
 	}
     }
+
   /* Process the ADVANCE option.  */
 
   dtp->u.p.advance_status
diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c
index ed3bc32..b733b93 100644
--- a/libgfortran/io/unit.c
+++ b/libgfortran/io/unit.c
@@ -461,6 +461,7 @@ set_internal_unit (st_parameter_dt *dtp, gfc_unit *iunit, int kind)
 {
   gfc_offset start_record = 0;
 
+  iunit->unit_number = dtp->common.unit;
   iunit->recl = dtp->internal_unit_len;
   iunit->internal_unit = dtp->internal_unit;
   iunit->internal_unit_len = dtp->internal_unit_len;
@@ -598,15 +599,28 @@ get_unit (st_parameter_dt *dtp, int do_create)
 	  return unit;
 	}
     }
+
+  /* If an internal unit number is passed from the parent to the child
+     it should have been stashed on the newunit_stack ready to be used.
+     Check for it now and return the internal unit if found.  */
+  if (newunit_tos && (dtp->common.unit <= NEWUNIT_START)
+      && (dtp->common.unit == newunit_stack[newunit_tos].unit_number))
+    {
+      unit = newunit_stack[newunit_tos--].unit;
+      return unit;
+    }
+
   /* Has to be an external unit.  */
   dtp->u.p.unit_is_internal = 0;
   dtp->internal_unit = NULL;
   dtp->internal_unit_desc = NULL;
+
   /* For an external unit with unit number < 0 creating it on the fly
      is not allowed, such units must be created with
      OPEN(NEWUNIT=...).  */
   if (dtp->common.unit < 0)
     return get_gfc_unit (dtp->common.unit, 0);
+
   return get_gfc_unit (dtp->common.unit, do_create);
 }
 
diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c
index 47970d4..f03929e 100644
--- a/libgfortran/io/write.c
+++ b/libgfortran/io/write.c
@@ -2253,6 +2253,12 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
 		      child_iomsg_len = IOMSG_LEN;
 		    }
 		  namelist_write_newline (dtp);
+
+		  /* If writing to an internal unit, stash it to allow
+		     the child procedure to access it.  */
+		  if (is_internal_unit (dtp))
+		    stash_internal_unit (dtp);
+		      
 		  /* Call the user defined formatted WRITE procedure.  */
 		  dtp->u.p.current_unit->child_dtio++;
 		  dtio_ptr ((void *)&list_obj, &unit, iotype, &vlist,