re PR fortran/48298 ([F03] User-Defined Derived-Type IO (DTIO))

2016-09-23  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libgfortran/48298
	* io/inquire.c (inquire_via_unit): Adjust error check for the
	two possible internal unit KINDs.
	* io/io.h: Adjust defines for is_internal_unit and
	is_char4_unit. (gfc_unit): Add internal unit data to structure.
	(get_internal_unit): Change declaration to set_internal_unit.
	(free_internal_unit): Change name to stash_internal_unit_number.
	(get_unique_unit_number): Adjust parameter argument.
	Define IOPARM_DT_HAS_UDTIO. (gfc_saved_unit): New structure.
	* io/list_read.c (next_char_internal): Use is_char4_unit.
	* io/open.c (st_open): Adjust call to get_unique_unit_number.
	* io/transfer.c (write_block): Use is_char4_unit.
	(data_transfer_init): Update check for unit numbers.
	(st_read_done): Free the various allocated memories used for the
	internal units and stash the negative unit number and pointer to unit
	structure to allow reuse. (st_write_done): Likewise stash the freed
	unit.
	* io/unit.c: Create a fixed size buffer of 16 gfc_saved_unit's to use
	as a stack to save newunit unit numbers and unit structure for reuse.
	(get_external_unit): Change name to get_gfc_unit to better
	reflect what it does. (find_unit): Change call to get_gfc_unit.
	(find_or_create_unit): Likewise. (get_internal_unit): Change
	name to set_internal_unit. Move internal unit from the dtp
	structure to the gfc_unit structure so that it can be passed to
	child I/O statements through the UNIT.
	(free_internal_unit): Change name to stash_internal_unit_number.
	Push the common.unit number onto the newunit stack, saving it
	for possible reuse later. (get_unit): Set the internal unit
	KIND. Use get_unique_unit_number to get a negative unit number
	for the internal unit. Use get_gfc_unit to get the unit structure
	and use set_internal_unit to initialize it.
	(init_units): Initialize the newunit stack.
	(get_unique_unit_number): Check the stack for an available unit
	number and use it. If none there get the next most negative
	number. (close_units): Free any unit structures pointed to from the save
	stack.

2016-09-23  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR fortran/48298
	* gfortran.h (gfc_dt): Add *udtio.
	* ioparm.def: Add bit IOPARM_dt_f2003 to align with library use of bit
	25. Add IOPARM_dt_dtio bit to common flags.
	* resolve.c (resolve_transfer): Set dt->udtio to expression.
	* io.c (gfc_match_inquire): Adjust error message for internal
	unit KIND.
	* libgfortran.h: Adjust defines for GFC_INTERNAL_UNIT4,
	GFC_INTERNAL_UNIT, and GFC_INVALID_UNIT.
	* trans-io.c (build_dt): Set common_unit to reflect the KIND of
	the internal unit. Set mask bit for presence of dt->udtio.

2016-09-23  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR fortran/48298
	* gfortran.dg/negative_unit_check.f90: Update test.
	* gfortran.dg/dtio_14.f90: New test.

From-SVN: r240456

1 files changed, 70 insertions, 42 deletions

diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 98072d0..6009c12 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -737,7 +737,7 @@ write_block (st_parameter_dt *dtp, int length)
 
   if (is_internal_unit (dtp))
     {
-      if (dtp->common.unit) /* char4 internel unit.  */
+      if (is_char4_unit(dtp)) /* char4 internel unit.  */
 	{
 	  gfc_char4_t *dest4;
 	  dest4 = mem_alloc_w4 (dtp->u.p.current_unit->s, &length);
@@ -2606,7 +2606,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
        st_parameter_open opp;
        unit_convert conv;
 
-      if (dtp->common.unit < 0)
+      if (dtp->common.unit < 0 && !is_internal_unit (dtp))
 	{
 	  close_unit (dtp->u.p.current_unit);
 	  dtp->u.p.current_unit = NULL;
@@ -3943,18 +3943,34 @@ st_read_done (st_parameter_dt *dtp)
 {
   finalize_transfer (dtp);
 
-  if (is_internal_unit (dtp) || dtp->u.p.format_not_saved)
-    {
-      free_format_data (dtp->u.p.fmt);
-      free_format (dtp);
-    }
-
   free_ionml (dtp);
 
-  if (dtp->u.p.current_unit != NULL)
-    unlock_unit (dtp->u.p.current_unit);
-
-  free_internal_unit (dtp);
+  /* If this is a parent READ statement we do not need to retain the
+     internal unit structure for child use.  Free it and stash the unit
+     number for reuse.  */
+  if (dtp->u.p.current_unit != NULL
+      && dtp->u.p.current_unit->child_dtio == 0)
+    {
+      if (is_internal_unit (dtp) &&
+	  (dtp->common.flags & IOPARM_DT_HAS_UDTIO) == 0)
+        {
+	  free (dtp->u.p.current_unit->filename);
+	  dtp->u.p.current_unit->filename = NULL;
+	  free_format_hash_table (dtp->u.p.current_unit);
+	  free (dtp->u.p.current_unit->s);
+	  dtp->u.p.current_unit->s = NULL;
+	  if (dtp->u.p.current_unit->ls)
+	    free (dtp->u.p.current_unit->ls);
+	  dtp->u.p.current_unit->ls = NULL;
+	  stash_internal_unit (dtp);
+	}
+      if (is_internal_unit (dtp) || dtp->u.p.format_not_saved)
+	{
+	  free_format_data (dtp->u.p.fmt);
+	  free_format (dtp);
+	}
+      unlock_unit (dtp->u.p.current_unit);
+    }
 
   library_end ();
 }
@@ -3977,43 +3993,55 @@ st_write_done (st_parameter_dt *dtp)
 {
   finalize_transfer (dtp);
 
-  /* Deal with endfile conditions associated with sequential files.  */
-
   if (dtp->u.p.current_unit != NULL
-      && dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL
       && dtp->u.p.current_unit->child_dtio == 0)
-    switch (dtp->u.p.current_unit->endfile)
-      {
-      case AT_ENDFILE:		/* Remain at the endfile record.  */
-	break;
-
-      case AFTER_ENDFILE:
-	dtp->u.p.current_unit->endfile = AT_ENDFILE;	/* Just at it now.  */
-	break;
-
-      case NO_ENDFILE:
-	/* Get rid of whatever is after this record.  */
-        if (!is_internal_unit (dtp))
-          unit_truncate (dtp->u.p.current_unit,
-                         stell (dtp->u.p.current_unit->s),
-                         &dtp->common);
-	dtp->u.p.current_unit->endfile = AT_ENDFILE;
-	break;
-      }
-
-  if (is_internal_unit (dtp) || dtp->u.p.format_not_saved)
     {
-      free_format_data (dtp->u.p.fmt);
-      free_format (dtp);
-    }
+      /* Deal with endfile conditions associated with sequential files.  */
+      if (dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL)
+	switch (dtp->u.p.current_unit->endfile)
+	  {
+	  case AT_ENDFILE:		/* Remain at the endfile record.  */
+	    break;
 
-  free_ionml (dtp);
+	  case AFTER_ENDFILE:
+	    dtp->u.p.current_unit->endfile = AT_ENDFILE; /* Just at it now.  */
+	    break;
 
-  if (dtp->u.p.current_unit != NULL)
-    unlock_unit (dtp->u.p.current_unit);
+	  case NO_ENDFILE:
+	    /* Get rid of whatever is after this record.  */
+	    if (!is_internal_unit (dtp))
+	      unit_truncate (dtp->u.p.current_unit,
+			     stell (dtp->u.p.current_unit->s),
+			     &dtp->common);
+	    dtp->u.p.current_unit->endfile = AT_ENDFILE;
+	    break;
+	  }
 
-  free_internal_unit (dtp);
+      free_ionml (dtp);
 
+      /* If this is a parent WRITE statement we do not need to retain the
+	 internal unit structure for child use.  Free it and stash the
+	 unit number for reuse.  */
+      if (is_internal_unit (dtp) &&
+	  (dtp->common.flags & IOPARM_DT_HAS_UDTIO) == 0)
+	{
+	  free (dtp->u.p.current_unit->filename);
+	  dtp->u.p.current_unit->filename = NULL;
+	  free_format_hash_table (dtp->u.p.current_unit);
+	  free (dtp->u.p.current_unit->s);
+	  dtp->u.p.current_unit->s = NULL;
+	  if (dtp->u.p.current_unit->ls)
+	    free (dtp->u.p.current_unit->ls);
+	  dtp->u.p.current_unit->ls = NULL;
+	  stash_internal_unit (dtp);
+	}
+      if (is_internal_unit (dtp) || dtp->u.p.format_not_saved)
+	{
+	  free_format_data (dtp->u.p.fmt);
+	  free_format (dtp);
+	}
+      unlock_unit (dtp->u.p.current_unit);
+    }
   library_end ();
 }