OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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

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

	Backport from trunk
	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 units. 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: r255364
This commit is contained in:
Jerry DeLisle 2017-12-03 05:05:51 +00:00
parent 600c0c1f9a
commit d8e390ad79
4 changed files with 19 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
libgfortran/ChangeLog
View File

@ -1,3 +1,14 @@
2017-12-02 Jerry DeLisle <jvdelisle@gcc.gnu.org>
Backport from trunk
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 units. 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-23 Jerry DeLisle <jvdelisle@gcc.gnu.org> 2017-11-23 Jerry DeLisle <jvdelisle@gcc.gnu.org>
Backport from trunk Backport from trunk

2
libgfortran/io/io.h
View File

@ -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)

10
libgfortran/io/transfer.c
View File

@ -2766,6 +2766,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. */
@ -4084,7 +4086,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)
{ {
@ -4098,7 +4100,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);
@ -4155,7 +4157,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)
{ {
@ -4169,7 +4171,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);

1
libgfortran/io/unit.c
View File

@ -228,6 +228,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;