From 4a8d4422b01ffec7a3481083b80cfde910016777 Mon Sep 17 00:00:00 2001 From: Jerry DeLisle Date: Fri, 23 Sep 2016 20:36:21 +0000 Subject: re PR fortran/48298 ([F03] User-Defined Derived-Type IO (DTIO)) 2016-09-23 Jerry DeLisle PR libgfortran/48298 * io/inquire.c (inquire_via_unit): Adjust error check for the two possible internal unit KINDs. * io/io.h: Adjust defines for is_internal_unit and is_char4_unit. (gfc_unit): Add internal unit data to structure. (get_internal_unit): Change declaration to set_internal_unit. (free_internal_unit): Change name to stash_internal_unit_number. (get_unique_unit_number): Adjust parameter argument. Define IOPARM_DT_HAS_UDTIO. (gfc_saved_unit): New structure. * io/list_read.c (next_char_internal): Use is_char4_unit. * io/open.c (st_open): Adjust call to get_unique_unit_number. * io/transfer.c (write_block): Use is_char4_unit. (data_transfer_init): Update check for unit numbers. (st_read_done): Free the various allocated memories used for the internal units and stash the negative unit number and pointer to unit structure to allow reuse. (st_write_done): Likewise stash the freed unit. * io/unit.c: Create a fixed size buffer of 16 gfc_saved_unit's to use as a stack to save newunit unit numbers and unit structure for reuse. (get_external_unit): Change name to get_gfc_unit to better reflect what it does. (find_unit): Change call to get_gfc_unit. (find_or_create_unit): Likewise. (get_internal_unit): Change name to set_internal_unit. Move internal unit from the dtp structure to the gfc_unit structure so that it can be passed to child I/O statements through the UNIT. (free_internal_unit): Change name to stash_internal_unit_number. Push the common.unit number onto the newunit stack, saving it for possible reuse later. (get_unit): Set the internal unit KIND. Use get_unique_unit_number to get a negative unit number for the internal unit. Use get_gfc_unit to get the unit structure and use set_internal_unit to initialize it. (init_units): Initialize the newunit stack. (get_unique_unit_number): Check the stack for an available unit number and use it. If none there get the next most negative number. (close_units): Free any unit structures pointed to from the save stack. 2016-09-23 Jerry DeLisle PR fortran/48298 * gfortran.h (gfc_dt): Add *udtio. * ioparm.def: Add bit IOPARM_dt_f2003 to align with library use of bit 25. Add IOPARM_dt_dtio bit to common flags. * resolve.c (resolve_transfer): Set dt->udtio to expression. * io.c (gfc_match_inquire): Adjust error message for internal unit KIND. * libgfortran.h: Adjust defines for GFC_INTERNAL_UNIT4, GFC_INTERNAL_UNIT, and GFC_INVALID_UNIT. * trans-io.c (build_dt): Set common_unit to reflect the KIND of the internal unit. Set mask bit for presence of dt->udtio. 2016-09-23 Jerry DeLisle PR fortran/48298 * gfortran.dg/negative_unit_check.f90: Update test. * gfortran.dg/dtio_14.f90: New test. From-SVN: r240456 --- gcc/fortran/ChangeLog | 14 ++++++++++++++ gcc/fortran/gfortran.h | 2 +- gcc/fortran/io.c | 6 ++++-- gcc/fortran/ioparm.def | 2 ++ gcc/fortran/libgfortran.h | 7 ++++--- gcc/fortran/resolve.c | 1 + gcc/fortran/trans-io.c | 6 +++++- 7 files changed, 31 insertions(+), 7 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 7a99c39..daed721 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,17 @@ +2016-09-23 Jerry DeLisle + + PR fortran/48298 + * gfortran.h (gfc_dt): Add *udtio. + * ioparm.def: Add bit IOPARM_dt_f2003 to align with library use of bit + 25. Add IOPARM_dt_dtio bit to common flags. + * resolve.c (resolve_transfer): Set dt->udtio to expression. + * io.c (gfc_match_inquire): Adjust error message for internal + unit KIND. + * libgfortran.h: Adjust defines for GFC_INTERNAL_UNIT4, + GFC_INTERNAL_UNIT, and GFC_INVALID_UNIT. + * trans-io.c (build_dt): Set common_unit to reflect the KIND of + the internal unit. Set mask bit for presence of dt->udtio. + 2016-09-22 Andre Vehreschild * trans-intrinsic.c (gfc_conv_intrinsic_caf_get): Use the old caf- diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 912f5fb..1837a53 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -2332,7 +2332,7 @@ typedef struct { gfc_expr *io_unit, *format_expr, *rec, *advance, *iostat, *size, *iomsg, *id, *pos, *asynchronous, *blank, *decimal, *delim, *pad, *round, - *sign, *extra_comma, *dt_io_kind; + *sign, *extra_comma, *dt_io_kind, *udtio; gfc_symbol *namelist; /* A format_label of `format_asterisk' indicates the "*" format */ diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index 53037e2..48c15ef 100644 --- a/gcc/fortran/io.c +++ b/gcc/fortran/io.c @@ -4256,9 +4256,11 @@ gfc_match_inquire (void) if (inquire->unit != NULL && inquire->unit->expr_type == EXPR_CONSTANT && inquire->unit->ts.type == BT_INTEGER - && mpz_get_si (inquire->unit->value.integer) == GFC_INTERNAL_UNIT) + && ((mpz_get_si (inquire->unit->value.integer) == GFC_INTERNAL_UNIT4) + || (mpz_get_si (inquire->unit->value.integer) == GFC_INTERNAL_UNIT))) { - gfc_error ("UNIT number in INQUIRE statement at %L can not be -1", &loc); + gfc_error ("UNIT number in INQUIRE statement at %L can not " + "be %d", &loc, (int) mpz_get_si (inquire->unit->value.integer)); goto cleanup; } diff --git a/gcc/fortran/ioparm.def b/gcc/fortran/ioparm.def index e448a92..17b7ac7 100644 --- a/gcc/fortran/ioparm.def +++ b/gcc/fortran/ioparm.def @@ -113,3 +113,5 @@ IOPARM (dt, delim, 1 << 21, char2) IOPARM (dt, pad, 1 << 22, char1) IOPARM (dt, round, 1 << 23, char2) IOPARM (dt, sign, 1 << 24, char1) +#define IOPARM_dt_f2003 (1 << 25) +#define IOPARM_dt_dtio (1 << 26) diff --git a/gcc/fortran/libgfortran.h b/gcc/fortran/libgfortran.h index e913250..cc35508 100644 --- a/gcc/fortran/libgfortran.h +++ b/gcc/fortran/libgfortran.h @@ -68,10 +68,11 @@ along with GCC; see the file COPYING3. If not see | GFC_RTCHECK_RECURSION | GFC_RTCHECK_DO \ | GFC_RTCHECK_POINTER | GFC_RTCHECK_MEM) -/* Special unit numbers used to convey certain conditions. Numbers -3 +/* Special unit numbers used to convey certain conditions. Numbers -4 thru -9 available. NEWUNIT values start at -10. */ -#define GFC_INTERNAL_UNIT -1 -#define GFC_INVALID_UNIT -2 +#define GFC_INTERNAL_UNIT4 -1 /* KIND=4 Internal Unit. */ +#define GFC_INTERNAL_UNIT -2 /* KIND=1 Internal Unit. */ +#define GFC_INVALID_UNIT -3 /* Possible values for the CONVERT I/O specifier. */ /* Keep in sync with GFC_FLAG_CONVERT_* in gcc/flags.h. */ diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 11b6a14..9998302 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -8739,6 +8739,7 @@ resolve_transfer (gfc_code *code) if (dtio_sub != NULL && exp->expr_type == EXPR_VARIABLE) { + dt->udtio = exp; sym = exp->symtree->n.sym->ns->proc_name; /* Check to see if this is a nested DTIO call, with the dummy as the io-list object. */ diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c index 2c84349..c0559f3 100644 --- a/gcc/fortran/trans-io.c +++ b/gcc/fortran/trans-io.c @@ -1808,7 +1808,8 @@ build_dt (tree function, gfc_code * code) mask |= set_internal_unit (&block, &post_iu_block, var, dt->io_unit); set_parameter_const (&block, var, IOPARM_common_unit, - dt->io_unit->ts.kind == 1 ? 0 : -1); + dt->io_unit->ts.kind == 1 ? + GFC_INTERNAL_UNIT : GFC_INTERNAL_UNIT4); } } else @@ -1892,6 +1893,9 @@ build_dt (tree function, gfc_code * code) mask |= set_parameter_ref (&block, &post_end_block, var, IOPARM_dt_size, dt->size); + if (dt->udtio) + mask |= IOPARM_dt_dtio; + if (dt->namelist) { if (dt->format_expr || dt->format_label) -- cgit v1.1