From 6c0347f607f3bdc49498df45a2fbace20bfa5a92 Mon Sep 17 00:00:00 2001 From: Jerry DeLisle Date: Sun, 16 Oct 2016 16:29:46 +0000 Subject: [PATCH] re PR fortran/48298 ([F03] User-Defined Derived-Type IO (DTIO)) 2016-10-16 Jerry DeLisle PR fortran/48298 * trans-io.c (transfer_expr): Ignore dtio procedures for inquire with iolength. * gfortran.dg/dtio_16.f90: New test. From-SVN: r241216 --- gcc/fortran/ChangeLog | 6 +++ gcc/fortran/trans-io.c | 2 +- gcc/testsuite/ChangeLog | 4 ++ gcc/testsuite/gfortran.dg/dtio_16.f90 | 73 +++++++++++++++++++++++++++ 4 files changed, 84 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/dtio_16.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 6dce4ebeb6a..848b4bde1d8 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2016-10-16 Jerry DeLisle + + PR fortran/48298 + * trans-io.c (transfer_expr): Ignore dtio procedures for inquire + with iolength. + 2016-10-15 Jerry DeLisle PR fortran/77972 diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c index 3cdbf1fd2ca..216317ad3d3 100644 --- a/gcc/fortran/trans-io.c +++ b/gcc/fortran/trans-io.c @@ -2325,7 +2325,7 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, if (derived->attr.has_dtio_procs) arg2 = get_dtio_proc (ts, code, &dtio_sub); - if (dtio_sub != NULL) + if ((dtio_sub != NULL) && (last_dt != IOLENGTH)) { tree decl; decl = build_fold_indirect_ref_loc (input_location, diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index e55d653284c..01fa6a78c9b 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2016-10-16 Jerry DeLisle + + * gfortran.dg/dtio_16.f90: New test. + 2016-10-15 Eric Botcazou * gcc.target/sparc/bmaskbshuf.c: Rename to... diff --git a/gcc/testsuite/gfortran.dg/dtio_16.f90 b/gcc/testsuite/gfortran.dg/dtio_16.f90 new file mode 100644 index 00000000000..0f462d5c463 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dtio_16.f90 @@ -0,0 +1,73 @@ +! { dg-do run } +! Tests that inquire(iolength=) treats derived types as if they do not +! have User Defined procedures. Fortran Draft F2016 Standard, 9.10.3 +MODULE p + TYPE :: person + CHARACTER (LEN=20) :: name + INTEGER(4) :: age + END TYPE person + INTERFACE WRITE(FORMATTED) + MODULE procedure pwf + END INTERFACE + INTERFACE WRITE(UNFORMATTED) + MODULE procedure pwuf + END INTERFACE + INTERFACE read(FORMATTED) + MODULE procedure prf + END INTERFACE + INTERFACE read(UNFORMATTED) + MODULE procedure pruf + END INTERFACE +CONTAINS + SUBROUTINE pwf (dtv,unit,iotype,vlist,iostat,iomsg) + CLASS(person), INTENT(IN) :: dtv + INTEGER, INTENT(IN) :: unit + CHARACTER (LEN=*), INTENT(IN) :: iotype + INTEGER, INTENT(IN) :: vlist(:) + INTEGER, INTENT(OUT) :: iostat + CHARACTER (LEN=*), INTENT(INOUT) :: iomsg + WRITE(unit, FMT = *, IOSTAT=iostat) dtv%name, dtv%age + END SUBROUTINE pwf + + SUBROUTINE prf (dtv,unit,iotype,vlist,iostat,iomsg) + CLASS(person), INTENT(INOUT) :: dtv + INTEGER, INTENT(IN) :: unit + CHARACTER (LEN=*), INTENT(IN) :: iotype + INTEGER, INTENT(IN) :: vlist(:) + INTEGER, INTENT(OUT) :: iostat + CHARACTER (LEN=*), INTENT(INOUT) :: iomsg + READ (UNIT = UNIT, FMT = *) dtv%name, dtv%age + END SUBROUTINE prf + + SUBROUTINE pwuf (dtv,unit,iostat,iomsg) + CLASS(person), INTENT(IN) :: dtv + INTEGER, INTENT(IN) :: unit + INTEGER, INTENT(OUT) :: iostat + CHARACTER (LEN=*), INTENT(INOUT) :: iomsg + print *, "in pwuf" + WRITE (UNIT=UNIT, FMT = *) DTV%name, DTV%age + END SUBROUTINE pwuf + + SUBROUTINE pruf (dtv,unit,iostat,iomsg) + CLASS(person), INTENT(INOUT) :: dtv + INTEGER, INTENT(IN) :: unit + INTEGER, INTENT(OUT) :: iostat + CHARACTER (LEN=*), INTENT(INOUT) :: iomsg + print *, "in pruf" + READ (UNIT = UNIT, FMT = *) dtv%name, dtv%age + END SUBROUTINE pruf + +END MODULE p + +PROGRAM test + USE p + IMPLICIT NONE + TYPE (person) :: chairman + integer(4) :: rl, tl, kl + + chairman%name="Charlie" + chairman%age=62 + + inquire(iolength=rl) rl, kl, chairman, rl, chairman, tl + if (rl.ne.64) call abort +END PROGRAM test -- 2.30.2