re PR fortran/77532 ([F03] ICE in check_dtio_interface1, at fortran/interface.c:4622)

2016-09-10  Paul Thomas  <pault@gcc.gnu.org>
	    Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/77532
	^ interface.c (check_dtio_arg_TKR_intent): Return after error.
	(check_dtio_interface1): Remove asserts, test for NULL and return
	if found.

	gfortran.dg/dtio_11.f90: new test.

Co-Authored-By: Steven G. Kargl <kargl@gcc.gnu.org>
From-SVN: r240074

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index bcaf4447521f4b88dd9c94ced5ccd9363fb5cae9..188871b17fb92590ded62defa7c3f8c61876c7ed 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2016-09-10  Paul Thomas  <pault@gcc.gnu.org>
+           Steven G. Kargl  <kargl@gcc.gnu.org>
+
+       PR fortran/77532
+       ^ interface.c (check_dtio_arg_TKR_intent): Return after error.
+       (check_dtio_interface1): Remove asserts, test for NULL and return
+       if found.
+
 2016-09-09  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        PR fortran/77420

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index fece3168dc75667ed2df4bd6138a98147b7324fd..45a9afe568568491e16430a47566dc8659bc211c 100644 (file)
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -4559,8 +4559,11 @@ check_dtio_arg_TKR_intent (gfc_symbol *fsym, bool typebound, bt type,
                           int kind, int rank, sym_intent intent)
 {
   if (fsym->ts.type != type)
-    gfc_error ("DTIO dummy argument at %L must be of type %s",
-              &fsym->declared_at, gfc_basic_typename (type));
+    {
+      gfc_error ("DTIO dummy argument at %L must be of type %s",
+                &fsym->declared_at, gfc_basic_typename (type));
+      return;
+    }
 
   if (fsym->ts.type != BT_CLASS && fsym->ts.type != BT_DERIVED
       && fsym->ts.kind != kind)
@@ -4606,20 +4609,23 @@ check_dtio_interface1 (gfc_symbol *derived, gfc_symtree *tb_io_st,
     {
       /* Typebound DTIO binding.  */
       tb_io_proc = tb_io_st->n.tb;
-      gcc_assert (tb_io_proc != NULL);
+      if (tb_io_proc == NULL)
+       return;
+
       gcc_assert (tb_io_proc->is_generic);
       gcc_assert (tb_io_proc->u.generic->next == NULL);
 
       specific_proc = tb_io_proc->u.generic->specific;
-      gcc_assert (!specific_proc->is_generic);
+      if (specific_proc == NULL || specific_proc->is_generic)
+       return;
 
       dtio_sub = specific_proc->u.specific->n.sym;
     }
   else
     {
       generic_proc = tb_io_st->n.sym;
-      gcc_assert (generic_proc);
-      gcc_assert (generic_proc->generic);
+      if (generic_proc == NULL || generic_proc->generic == NULL)
+       return;
 
       for (intr = tb_io_st->n.sym->generic; intr; intr = intr->next)
        {

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 9dbf11dfbf4180bef46a7d11ec8a30fd4e21218e..7acd162436680b1a9169c7867defe08eeef2bb1a 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2016-09-10  Paul Thomas  <pault@gcc.gnu.org>
+           Steven G. Kargl  <kargl@gcc.gnu.org>
+
+       PR fortran/77532
+       gfortran.dg/dtio_11.f90: new test.
+
 2016-09-10  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        PR fortran/77507

diff --git a/gcc/testsuite/gfortran.dg/dtio_11.f90 b/gcc/testsuite/gfortran.dg/dtio_11.f90
new file mode 100644 (file)
index 0000000..cf8dd36
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dtio_11.f90
@@ -0,0 +1,39 @@
+! { dg-do compile }
+!
+! Test fixes for PRs77532-4.
+!
+! Contributed by Gerhard Steinmetz  <gerhard.steinmetz.fortran@t-online.de>
+!
+! PR77532 - used to ICE
+module m1
+   type t
+   end type
+   interface read(unformatted)
+   end interface
+end
+
+! PR77533 - used to ICE after error
+module m2
+   type t
+      type(unknown), pointer :: next ! { dg-error "is a type that has not been declared" }
+   contains
+      procedure :: s
+      generic :: write(formatted) => s
+   end type
+contains
+   subroutine s(x)
+   end
+end
+
+! PR77533 comment #1 - gave warning that
+module m3
+   type t
+   contains
+      procedure :: s ! { dg-error "Non-polymorphic passed-object" }
+      generic :: write(formatted) => s
+   end type
+contains
+   subroutine s(x) ! { dg-error "must be of type CLASS" }
+      class(t), intent(in) : x ! { dg-error "Invalid character in name" }
+   end
+end