Commit 7b39e3c2 by Jerry DeLisle

re PR fortran/83225 (runtime error in transfer.c)

2017-12-02  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libgfortran/83225
	* io/io.h (is_internal_unit): Use the unit_is_internal bit.
	* io/transfer.c (data_transfer_init): Set the bit to true for
	internal umits. Use that bit for checks for internal unit
	initializations.
	* io/unit.c (insert_unit): As a precaution, set the
	internal_unit_kind to zero when a unit structure is first created.

From-SVN: r255362
parent acffd4fd
2017-12-02 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libgfortran/83225
* io/io.h (is_internal_unit): Use the unit_is_internal bit.
* io/transfer.c (data_transfer_init): Set the bit to true for
internal umits. Use that bit for checks for internal unit
initializations.
* io/unit.c (insert_unit): As a precaution, set the
internal_unit_kind to zero when a unit structure is first created.
2017-11-28 Janne Blomqvist <jb@gcc.gnu.org> 2017-11-28 Janne Blomqvist <jb@gcc.gnu.org>
PR fortran/53796 PR fortran/53796
......
...@@ -69,7 +69,7 @@ internal_proto(old_locale_lock); ...@@ -69,7 +69,7 @@ internal_proto(old_locale_lock);
#define is_array_io(dtp) ((dtp)->internal_unit_desc) #define is_array_io(dtp) ((dtp)->internal_unit_desc)
#define is_internal_unit(dtp) ((dtp)->u.p.current_unit->internal_unit_kind) #define is_internal_unit(dtp) ((dtp)->u.p.unit_is_internal)
#define is_stream_io(dtp) ((dtp)->u.p.current_unit->flags.access == ACCESS_STREAM) #define is_stream_io(dtp) ((dtp)->u.p.current_unit->flags.access == ACCESS_STREAM)
......
...@@ -2764,6 +2764,8 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) ...@@ -2764,6 +2764,8 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
else else
dtp->u.p.current_unit->has_size = false; dtp->u.p.current_unit->has_size = false;
} }
else if (dtp->u.p.current_unit->internal_unit_kind > 0)
dtp->u.p.unit_is_internal = 1;
/* Check the action. */ /* Check the action. */
...@@ -4085,7 +4087,7 @@ st_read_done (st_parameter_dt *dtp) ...@@ -4085,7 +4087,7 @@ st_read_done (st_parameter_dt *dtp)
if (dtp->u.p.current_unit != NULL if (dtp->u.p.current_unit != NULL
&& dtp->u.p.current_unit->child_dtio == 0) && dtp->u.p.current_unit->child_dtio == 0)
{ {
if (is_internal_unit (dtp)) if (dtp->u.p.unit_is_internal)
{ {
if ((dtp->common.flags & IOPARM_DT_HAS_UDTIO) == 0) if ((dtp->common.flags & IOPARM_DT_HAS_UDTIO) == 0)
{ {
...@@ -4099,7 +4101,7 @@ st_read_done (st_parameter_dt *dtp) ...@@ -4099,7 +4101,7 @@ st_read_done (st_parameter_dt *dtp)
} }
newunit_free (dtp->common.unit); newunit_free (dtp->common.unit);
} }
if (is_internal_unit (dtp) || dtp->u.p.format_not_saved) if (dtp->u.p.unit_is_internal || dtp->u.p.format_not_saved)
{ {
free_format_data (dtp->u.p.fmt); free_format_data (dtp->u.p.fmt);
free_format (dtp); free_format (dtp);
...@@ -4156,7 +4158,7 @@ st_write_done (st_parameter_dt *dtp) ...@@ -4156,7 +4158,7 @@ st_write_done (st_parameter_dt *dtp)
/* If this is a parent WRITE statement we do not need to retain the /* If this is a parent WRITE statement we do not need to retain the
internal unit structure for child use. */ internal unit structure for child use. */
if (is_internal_unit (dtp)) if (dtp->u.p.unit_is_internal)
{ {
if ((dtp->common.flags & IOPARM_DT_HAS_UDTIO) == 0) if ((dtp->common.flags & IOPARM_DT_HAS_UDTIO) == 0)
{ {
...@@ -4170,7 +4172,7 @@ st_write_done (st_parameter_dt *dtp) ...@@ -4170,7 +4172,7 @@ st_write_done (st_parameter_dt *dtp)
} }
newunit_free (dtp->common.unit); newunit_free (dtp->common.unit);
} }
if (is_internal_unit (dtp) || dtp->u.p.format_not_saved) if (dtp->u.p.unit_is_internal || dtp->u.p.format_not_saved)
{ {
free_format_data (dtp->u.p.fmt); free_format_data (dtp->u.p.fmt);
free_format (dtp); free_format (dtp);
......
...@@ -231,6 +231,7 @@ insert_unit (int n) ...@@ -231,6 +231,7 @@ insert_unit (int n)
{ {
gfc_unit *u = xcalloc (1, sizeof (gfc_unit)); gfc_unit *u = xcalloc (1, sizeof (gfc_unit));
u->unit_number = n; u->unit_number = n;
u->internal_unit_kind = 0;
#ifdef __GTHREAD_MUTEX_INIT #ifdef __GTHREAD_MUTEX_INIT
{ {
__gthread_mutex_t tmp = __GTHREAD_MUTEX_INIT; __gthread_mutex_t tmp = __GTHREAD_MUTEX_INIT;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment