Hi all,

attached is a patch for an ICE-on-invalid problem with generics: We
simply don't check if any dummy args are present.

Regtested on x86_64-unknown-linux-gnu. Ok for trunk and 4.8?

Cheers,
Janus


2014-02-17  Janus Weil  <ja...@gcc.gnu.org>

    PR fortran/60231
    * resolve.c (check_generic_tbp_ambiguity): Check for presence of dummy
    arguments to prevent ICE.


2014-02-17  Janus Weil  <ja...@gcc.gnu.org>

    PR fortran/60231
    * gfortran.dg/typebound_generic_15.f90: New.
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c       (revision 207804)
+++ gcc/fortran/resolve.c       (working copy)
@@ -11362,6 +11362,7 @@ check_generic_tbp_ambiguity (gfc_tbp_generic* t1,
 {
   gfc_symbol *sym1, *sym2;
   const char *pass1, *pass2;
+  gfc_formal_arglist *dummy_args;
 
   gcc_assert (t1->specific && t2->specific);
   gcc_assert (!t1->specific->is_generic);
@@ -11384,19 +11385,33 @@ check_generic_tbp_ambiguity (gfc_tbp_generic* t1,
       return false;
     }
 
-  /* Compare the interfaces.  */
+  /* Determine PASS arguments.  */
   if (t1->specific->nopass)
     pass1 = NULL;
   else if (t1->specific->pass_arg)
     pass1 = t1->specific->pass_arg;
   else
-    pass1 = gfc_sym_get_dummy_args 
(t1->specific->u.specific->n.sym)->sym->name;
+    {
+      dummy_args = gfc_sym_get_dummy_args (t1->specific->u.specific->n.sym);
+      if (dummy_args)
+       pass1 = dummy_args->sym->name;
+      else
+       pass1 = NULL;
+    }
   if (t2->specific->nopass)
     pass2 = NULL;
   else if (t2->specific->pass_arg)
     pass2 = t2->specific->pass_arg;
   else
-    pass2 = gfc_sym_get_dummy_args 
(t2->specific->u.specific->n.sym)->sym->name;
+    {
+      dummy_args = gfc_sym_get_dummy_args (t2->specific->u.specific->n.sym);
+      if (dummy_args)
+       pass2 = dummy_args->sym->name;
+      else
+       pass2 = NULL;
+    }
+
+  /* Compare the interfaces.  */
   if (gfc_compare_interfaces (sym1, sym2, sym2->name, !t1->is_operator, 0,
                              NULL, 0, pass1, pass2))
     {
! { dg-do compile }
!
! PR 60231: [4.8/4.9 Regression] ICE on undefined generic
!
! Contributed by Antony Lewis <ant...@cosmologist.info>

module Objects

  Type TObjectList
  contains
    procedure :: Add1
    procedure :: Add2   
    generic :: Add => Add1, Add2
  end Type

end module

! { dg-final { cleanup-modules "Objects" } }

Reply via email to