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.
This commit is contained in:
parent
c8d1383563
commit
72d91d6cd4
@ -5305,7 +5305,9 @@ gfc_find_specific_dtio_proc (gfc_symbol *derived, bool write, bool formatted)
|
|||||||
}
|
}
|
||||||
|
|
||||||
finish:
|
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);
|
gfc_find_derived_vtab (derived);
|
||||||
|
|
||||||
return dtio_sub;
|
return dtio_sub;
|
||||||
|
33
gcc/testsuite/gfortran.dg/dtio_36.f90
Normal file
33
gcc/testsuite/gfortran.dg/dtio_36.f90
Normal file
@ -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
|
Loading…
Reference in New Issue
Block a user