From 72d91d6cd41f2987339a98c2c64f70b3850f4e0b Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Fri, 19 Feb 2021 18:05:31 +0100 Subject: [PATCH] Fortran: Fix DTIO with type ICE [PR99146] gcc/fortran/ChangeLog: PR fortran/99146 * interface.c: gcc/testsuite/ChangeLog: PR fortran/99146 * gfortran.dg/dtio_36.f90: New test. --- gcc/fortran/interface.c | 4 +++- gcc/testsuite/gfortran.dg/dtio_36.f90 | 33 +++++++++++++++++++++++++++ 2 files changed, 36 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/dtio_36.f90 diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 87fe14280e6..f7ca52e6550 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -5305,7 +5305,9 @@ gfc_find_specific_dtio_proc (gfc_symbol *derived, bool write, bool formatted) } finish: - if (dtio_sub && derived != CLASS_DATA (dtio_sub->formal->sym)->ts.u.derived) + if (dtio_sub + && dtio_sub->formal->sym->ts.type == BT_CLASS + && derived != CLASS_DATA (dtio_sub->formal->sym)->ts.u.derived) gfc_find_derived_vtab (derived); return dtio_sub; diff --git a/gcc/testsuite/gfortran.dg/dtio_36.f90 b/gcc/testsuite/gfortran.dg/dtio_36.f90 new file mode 100644 index 00000000000..4e53581b86a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dtio_36.f90 @@ -0,0 +1,33 @@ +! { dg-do compile } +! +! PR fortran/99146 +! + MODULE p + TYPE :: person + sequence + END TYPE person + INTERFACE READ(UNFORMATTED) + MODULE PROCEDURE pruf + END INTERFACE + + CONTAINS + + SUBROUTINE pruf (dtv,unit,iostat,iomsg) + type(person), INTENT(INOUT) :: dtv + INTEGER, INTENT(IN) :: unit + INTEGER, INTENT(OUT) :: iostat + CHARACTER (LEN=*), INTENT(INOUT) :: iomsg + iostat = 1 + END SUBROUTINE pruf + + END MODULE p + + PROGRAM test + USE p + TYPE (person) :: chairman + + OPEN (UNIT=71, status = 'scratch', FORM='UNFORMATTED') + + read(71) chairman + + END PROGRAM test -- 2.30.2