diff options
| author | Tobias Burnus <tobias@codesourcery.com> | 2021-02-19 18:05:31 +0100 |
|---|---|---|
| committer | Tobias Burnus <tobias@codesourcery.com> | 2021-02-19 18:05:31 +0100 |
| commit | 72d91d6cd41f2987339a98c2c64f70b3850f4e0b (patch) | |
| tree | fd23da04ce55950d8ea9001cacf38555be37c2d3 /gcc | |
| parent | c8d13835638ff82f3ba7bfb0a5c2f597851dfb5a (diff) | |
| download | gcc-72d91d6cd41f2987339a98c2c64f70b3850f4e0b.zip gcc-72d91d6cd41f2987339a98c2c64f70b3850f4e0b.tar.gz gcc-72d91d6cd41f2987339a98c2c64f70b3850f4e0b.tar.bz2 | |
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.
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/interface.c | 4 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/dtio_36.f90 | 33 |
2 files changed, 36 insertions, 1 deletions
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 87fe142..f7ca52e 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 0000000..4e53581 --- /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 |