[multiple changes]

2016-08-31  Paul Thomas  <pault@gcc.gnu.org>
	Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR fortran/48298

	* decl.c (access_attr_decl): Include case INTERFACE_DTIO as
	appropriate.
	* gfortran.h : Add INTRINSIC_FORMATTED and
	INTRINSIC_UNFORMATTED to gfc_intrinsic_op. Add INTERFACE_DTIO
	to interface type. Add new enum 'dtio_codes'. Add bitfield
	'has_dtio_procs' to symbol_attr. Add prototypes
	'gfc_check_dtio_interfaces' and 'gfc_find_specific_dtio_proc'.
	* interface.c (dtio_op): New function.
	(gfc_match_generic_spec): Match generic DTIO interfaces.
	(gfc_match_interface): Treat DTIO interfaces in the same way as
	(gfc_current_interface_head): Add INTERFACE_DTIO appropriately.
	(check_dtio_arg_TKR_intent): New function.
	(check_dtio_interface1): New function.
	(gfc_check_dtio_interfaces): New function.
	(gfc_find_specific_dtio_proc): New function.
	* io.c : Add FMT_DT to format_token.
	(format_lex): Handle DTIO formatting.
	* match.c (gfc_op2string): Add DTIO operators.
	* resolve.c (derived_inaccessible): Ignore pointer components
	to enclosing derived type.
	(resolve_transfer): Resolve transfers that involve DTIO.
	procedures. Find the specific subroutine for the transfer and
	use its existence to over-ride some of the constraints on
	derived types. If the transfer is recursive, require that the
	subroutine be so qualified.
	(dtio_procs_present): New function.
	(resolve_fl_namelist): Remove inhibition of polymorphic objects
	in namelists if DTIO read and write subroutines exist. Likewise
	for derived types.
	(resolve_types): Invoke 'gfc_verify_dtio_procedures'.
	* symbol.c : Set 'dtio_procs' using 'minit'.
	* trans-decl.c (gfc_finish_var_decl): If a derived-type/class
	object is associated with DTIO procedures, make it TREE_STATIC.
	* trans-expr.c (gfc_get_vptr_from_expr): If the expression
	drills down to a PARM_DECL, extract the vptr correctly.
	(gfc_conv_derived_to_class): Check 'info' in the test for
	'useflags'. If the se expression exists and is a pointer, use
	it as the class _data.
	* trans-io.c : Add IOCALL_X_DERIVED to iocall and the function
	prototype. Likewise for IOCALL_SET_NML_DTIO_VAL.
	(set_parameter_tree): Renamed from 'set_parameter_const', now
	returns void and has new tree argument. Calls modified to match
	new interface.
	(transfer_namelist_element): Transfer DTIO procedure pointer
	and vpointer using the new function IOCALL_SET_NML_DTIO_VAL.
	(get_dtio_proc): New function.
	(transfer_expr): Add new argument for the vptr field of class
	objects. Add the code to call the specific DTIO proc, convert
	derived types to class and call IOCALL_X_DERIVED.
	(trans_transfer): Add BT_CLASS to structures for treatment by
	the scalarizer. Obtain the vptr for the dynamic type, both for
	scalar and array transfer.

2016-08-31  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
	Paul Thomas  <pault@gcc.gnu.org>

	PR libgfortran/48298
	* gfortran.map : Flag _st_set_nml_dtio_var and
	_gfortran_transfer_derived.
	* io/format.c (format_lex): Detect DTIO formatting.
	(parse_format_list): Parse the DTIO format.
	(next_format): Include FMT_DT.
	* io/format.h : Likewise. Add structure 'udf' to structure
	'fnode' to carry the IOTYPE string and the 'vlist'.
	* io/io.h : Add prototypes for the two types of DTIO subroutine
	and a typedef for gfc_class. Also, add to 'namelist_type'
	fields for the pointer to the DTIO procedure and the vtable.
	Add fields to struct st_parameter_dt for pointers to the two
	types of DTIO subroutine. Add to gfc_unit DTIO specific fields.
	(internal_proto): Add prototype for 'read_user_defined' and
	'write_user_defined'.
	* io/list_read.c (check_buffers): Use the 'current_unit' field.
	(unget_char): Likewise.
	(eat_spaces): Likewise.
	(list_formatted_read_scalar): For case BT_CLASS, call the DTIO
	procedure.
	(nml_get_obj_data): Likewise when DTIO procedure is present,.
	* io/transfer.c : Export prototypes for 'transfer_derived' and
	'transfer_derived_write'.
	(unformatted_read): For case BT_CLASS, call the DTIO procedure.
	(unformatted_write): Likewise.
	(formatted_transfer_scalar_read): Likewise.
	(formatted_transfer_scalar_write: Likewise.
	(transfer_derived): New function.
	(data_transfer_init): Set last_char if no child_dtio.
	(finalize_transfer): Return if child_dtio set.
	(st_write_done): Add condition for child_dtio not set.
	Add extra arguments for st_set_nml_var prototype.
	(set_nml_var): New function that contains the contents of the
	old version of st_set_nml_var. Also sets the 'dtio_sub' and
	'vtable' fields of the 'nml' structure.
	(st_set_nml_var): Now just calls set_nml_var with 'dtio_sub'
	and 'vtable' NULL.
	(st_set_nml_dtio_var): New function that calls set_nml_var.
	* io/unit.c (get_external_unit): If the found unit child_dtio
	is non zero, don't do any mutex locking/unlocking.  Just
	return the unit.
	* io/unix.c (tempfile_open): Revert to C style comment.
	* io/write.c (list_formatted_write_scalar): Do the DTIO call.
	(nml_write_obj): Add BT_CLASS and do the DTIO call.

2016-08-31  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
	Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/48298
	* gfortran.dg/dtio_1.f90: New test.
	* gfortran.dg/dtio_2.f90: New test.
	* gfortran.dg/dtio_3.f90: New test.
	* gfortran.dg/dtio_4.f90: New test.
	* gfortran.dg/dtio_5.f90: New test.
	* gfortran.dg/dtio_6.f90: New test.
	* gfortran.dg/dtio_7.f90: New test.
	* gfortran.dg/dtio_8.f90: New test.
	* gfortran.dg/dtio_9.f90: New test.
	* gfortran.dg/dtio_10.f90: New test.

From-SVN: r239880

1 files changed, 16 insertions, 16 deletions

diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c
index e0e7b09f..fde9ac7 100644
--- a/libgfortran/io/unit.c
+++ b/libgfortran/io/unit.c
@@ -348,7 +348,7 @@ retry:
     }
 
 found:
-  if (p != NULL)
+  if (p != NULL && (p->child_dtio == 0))
     {
       /* Fast path.  */
       if (! __gthread_mutex_trylock (&p->lock))
@@ -363,7 +363,7 @@ found:
 
   __gthread_mutex_unlock (&unit_lock);
 
-  if (p != NULL)
+  if (p != NULL && (p->child_dtio == 0))
     {
       __gthread_mutex_lock (&p->lock);
       if (p->closed)
@@ -464,7 +464,7 @@ get_internal_unit (st_parameter_dt *dtp)
       else
 	  len = string_len_trim_char4 (dtp->internal_unit_len,
 			      (const gfc_char4_t*) dtp->internal_unit);
-      dtp->internal_unit_len = len; 
+      dtp->internal_unit_len = len;
       iunit->recl = dtp->internal_unit_len;
     }
 
@@ -524,7 +524,7 @@ get_internal_unit (st_parameter_dt *dtp)
   dtp->u.p.at_eof = 0;
 
   /* This flag tells us the unit is assigned to internal I/O.  */
-  
+
   dtp->u.p.unit_is_internal = 1;
 
   return iunit;
@@ -544,13 +544,13 @@ free_internal_unit (st_parameter_dt *dtp)
   if (dtp->u.p.current_unit != NULL)
     {
       free (dtp->u.p.current_unit->ls);
-  
+
       free (dtp->u.p.current_unit->s);
-  
+
       destroy_unit_mutex (dtp->u.p.current_unit);
     }
 }
-      
+
 
 
 /* get_unit()-- Returns the unit structure associated with the integer
@@ -612,14 +612,14 @@ init_units (void)
       u->flags.encoding = ENCODING_DEFAULT;
       u->flags.async = ASYNC_NO;
       u->flags.round = ROUND_UNSPECIFIED;
-     
+
       u->recl = options.default_recl;
       u->endfile = NO_ENDFILE;
 
       u->filename = strdup (stdin_name);
 
       fbuf_init (u, 0);
-    
+
       __gthread_mutex_unlock (&u->lock);
     }
 
@@ -644,9 +644,9 @@ init_units (void)
 
       u->recl = options.default_recl;
       u->endfile = AT_ENDFILE;
-    
+
       u->filename = strdup (stdout_name);
-      
+
       fbuf_init (u, 0);
 
       __gthread_mutex_unlock (&u->lock);
@@ -674,7 +674,7 @@ init_units (void)
       u->endfile = AT_ENDFILE;
 
       u->filename = strdup (stderr_name);
-      
+
       fbuf_init (u, 256);  /* 256 bytes should be enough, probably not doing
                               any kind of exotic formatting to stderr.  */
 
@@ -694,7 +694,7 @@ static int
 close_unit_1 (gfc_unit *u, int locked)
 {
   int i, rc;
-  
+
   /* If there are previously written bytes from a write with ADVANCE="no"
      Reposition the buffer before closing.  */
   if (u->previous_nonadvancing_write)
@@ -715,7 +715,7 @@ close_unit_1 (gfc_unit *u, int locked)
   free (u->filename);
   u->filename = NULL;
 
-  free_format_hash_table (u);  
+  free_format_hash_table (u);
   fbuf_destroy (u);
 
   if (!locked)
@@ -788,7 +788,7 @@ unit_truncate (gfc_unit * u, gfc_offset pos, st_parameter_common * common)
       else
 	fbuf_flush (u, u->mode);
     }
-  
+
   /* struncate() should flush the stream buffer if necessary, so don't
      bother calling sflush() here.  */
   ret = struncate (u->s, pos);
@@ -838,7 +838,7 @@ filename_from_unit (int n)
 void
 finish_last_advance_record (gfc_unit *u)
 {
-  
+
   if (u->saved_pos > 0)
     fbuf_seek (u, u->saved_pos, SEEK_CUR);