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, 20 insertions, 7 deletions

diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index ff75741..87c3558 100644
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -69,11 +69,11 @@ internal_proto(old_locale_lock);
 
 #define is_array_io(dtp) ((dtp)->internal_unit_desc)
 
-#define is_internal_unit(dtp) ((dtp)->u.p.unit_is_internal)
+#define is_internal_unit(dtp) ((dtp)->u.p.current_unit->internal_unit_kind)
 
 #define is_stream_io(dtp) ((dtp)->u.p.current_unit->flags.access == ACCESS_STREAM)
 
-#define is_char4_unit(dtp) ((dtp)->u.p.unit_is_internal && (dtp)->common.unit)
+#define is_char4_unit(dtp) ((dtp)->u.p.current_unit->internal_unit_kind == 4)
 
 /* The array_loop_spec contains the variables for the loops over index ranges
    that are encountered.  */
@@ -409,6 +409,7 @@ st_parameter_inquire;
 #define IOPARM_DT_HAS_ROUND			(1 << 23)
 #define IOPARM_DT_HAS_SIGN			(1 << 24)
 #define IOPARM_DT_HAS_F2003                     (1 << 25)
+#define IOPARM_DT_HAS_UDTIO                     (1 << 26)
 /* Internal use bit.  */
 #define IOPARM_DT_IONML_SET			(1u << 31)
 
@@ -640,12 +641,24 @@ typedef struct gfc_unit
   int (*next_char_fn_ptr) (st_parameter_dt *);
   void (*push_char_fn_ptr) (st_parameter_dt *, int);
 
+  /* Internal unit char string data.  */
+  char * internal_unit;
+  gfc_charlen_type internal_unit_len;
+  gfc_array_char *string_unit_desc;
+  int internal_unit_kind;
+
   /* DTIO Parent/Child procedure, 0 = parent, >0 = child level.  */
   int child_dtio;
   int last_char;
 }
 gfc_unit;
 
+typedef struct gfc_saved_unit
+{
+  GFC_INTEGER_4 unit_number;
+  gfc_unit *unit;
+}
+gfc_saved_unit;
 
 /* unit.c */
 
@@ -663,11 +676,11 @@ internal_proto(unit_lock);
 extern int close_unit (gfc_unit *);
 internal_proto(close_unit);
 
-extern gfc_unit *get_internal_unit (st_parameter_dt *);
-internal_proto(get_internal_unit);
+extern gfc_unit *set_internal_unit (st_parameter_dt *, gfc_unit *, int);
+internal_proto(set_internal_unit);
 
-extern void free_internal_unit (st_parameter_dt *);
-internal_proto(free_internal_unit);
+extern void stash_internal_unit (st_parameter_dt *);
+internal_proto(stash_internal_unit);
 
 extern gfc_unit *find_unit (int);
 internal_proto(find_unit);
@@ -687,7 +700,7 @@ internal_proto (finish_last_advance_record);
 extern int unit_truncate (gfc_unit *, gfc_offset, st_parameter_common *);
 internal_proto (unit_truncate);
 
-extern GFC_INTEGER_4 get_unique_unit_number (st_parameter_open *);
+extern GFC_INTEGER_4 get_unique_unit_number (st_parameter_common *);
 internal_proto(get_unique_unit_number);
 
 /* open.c */