From dc42a736c9c76adf6b9e98cf121d37c7f64e607b Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Mon, 20 Feb 2017 10:52:50 +0000 Subject: re PR fortran/79382 (DTIO ICE) 2017-02-16 Paul Thomas PR fortran/79382 * decl.c (access_attr_decl): Test for presence of generic DTIO interface and emit error if not present. 2017-02-16 Paul Thomas PR fortran/79382 * io/transfer.c (check_dtio_proc): New function. (formatted_transfer_scalar_read): Use it. (formatted_transfer_scalar_write): ditto. 2017-02-16 Paul Thomas PR fortran/79382 * gfortran.dg/dtio_10.f90 : Change test of error message. * gfortran.dg/dtio_23.f90 : New test. * gfortran.dg/dtio_24.f90 : New test. From-SVN: r245596 --- libgfortran/ChangeLog | 7 +++++++ libgfortran/io/transfer.c | 27 +++++++++++++++++++++++++++ 2 files changed, 34 insertions(+) (limited to 'libgfortran') diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index a3a8c22..4cdb3b4 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,10 @@ +2017-02-16 Paul Thomas + + PR fortran/79382 + * io/transfer.c (check_dtio_proc): New function. + (formatted_transfer_scalar_read): Use it. + (formatted_transfer_scalar_write): ditto. + 2017-01-31 Steven G. Kargl PR fortran/79305 diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index b47f4e0..36786c0 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -1244,6 +1244,26 @@ require_type (st_parameter_dt *dtp, bt expected, bt actual, const fnode *f) } +/* Check that the dtio procedure required for formatted IO is present. */ + +static int +check_dtio_proc (st_parameter_dt *dtp, const fnode *f) +{ + char buffer[BUFLEN]; + + if (dtp->u.p.fdtio_ptr != NULL) + return 0; + + snprintf (buffer, BUFLEN, + "Missing DTIO procedure or intrinsic type passed for item %d " + "in formatted transfer", + dtp->u.p.item_count - 1); + + format_error (dtp, f, buffer); + return 1; +} + + static int require_numeric_type (st_parameter_dt *dtp, bt actual, const fnode *f) { @@ -1436,6 +1456,9 @@ formatted_transfer_scalar_read (st_parameter_dt *dtp, bt type, void *p, int kind case FMT_DT: if (n == 0) goto need_read_data; + + if (check_dtio_proc (dtp, f)) + return; if (require_type (dtp, BT_CLASS, type, f)) return; int unit = dtp->u.p.current_unit->unit_number; @@ -1938,8 +1961,12 @@ formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int kin child_iomsg_len = IOMSG_LEN; } + if (check_dtio_proc (dtp, f)) + return; + /* Call the user defined formatted WRITE procedure. */ dtp->u.p.current_unit->child_dtio++; + dtp->u.p.fdtio_ptr (p, &unit, iotype, f->u.udf.vlist, child_iostat, child_iomsg, iotype_len, child_iomsg_len); -- cgit v1.1