[Patch] Fortran: Fix DTIO with type ICE [PR99146]

[Tobias Burnus <tobias@codesourcery.com>]

[-- Attachment #1: Type: text/plain, Size: 311 bytes --]

In this example, the formal argument is a derived type
and not a class – hence, there is an ICE.

OK for the trunk?

Tobias

-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 München Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Frank Thürauf

[-- Attachment #2: dtio.diff --]
[-- Type: text/x-patch, Size: 1838 bytes --]

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(-)

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