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

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

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

10
libgfortran/io/transfer.c
View File

@ -2766,6 +2766,8 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
else
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. */
@ -4084,7 +4086,7 @@ st_read_done (st_parameter_dt *dtp)
if (dtp->u.p.current_unit != NULL
&& 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)
{
@ -4098,7 +4100,7 @@ st_read_done (st_parameter_dt *dtp)
}
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 (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
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)
{
@ -4169,7 +4171,7 @@ st_write_done (st_parameter_dt *dtp)
}
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 (dtp);

1
libgfortran/io/unit.c
View File

@ -228,6 +228,7 @@ insert_unit (int n)
{
gfc_unit *u = xcalloc (1, sizeof (gfc_unit));
u->unit_number = n;
u->internal_unit_kind = 0;
#ifdef __GTHREAD_MUTEX_INIT
{
__gthread_mutex_t tmp = __GTHREAD_MUTEX_INIT;