From d8e390ad7972e2e71253e29bd4023d43edafc499 Mon Sep 17 00:00:00 2001 From: Jerry DeLisle Date: Sun, 3 Dec 2017 05:05:51 +0000 Subject: [PATCH] backport: re PR fortran/83225 (runtime error in transfer.c) 2017-12-02 Jerry DeLisle 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 --- libgfortran/ChangeLog | 11 +++++++++++ libgfortran/io/io.h | 2 +- libgfortran/io/transfer.c | 10 ++++++---- libgfortran/io/unit.c | 1 + 4 files changed, 19 insertions(+), 5 deletions(-) diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index a697776bb36..355cb2f8927 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,14 @@ +2017-12-02 Jerry DeLisle + + 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 Backport from trunk diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h index 525c97558f2..dfcf4913394 100644 --- a/libgfortran/io/io.h +++ b/libgfortran/io/io.h @@ -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) diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index d9378e3a935..f977885d77c 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -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); diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c index e62f9b839d4..4b49b26311c 100644 --- a/libgfortran/io/unit.c +++ b/libgfortran/io/unit.c @@ -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;