From 2a144f64c934939d1b484dc2b285231cb2f3d0cf Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Tue, 18 Feb 2014 08:45:39 +0100 Subject: [PATCH] re PR fortran/60231 (ICE on undefined generic) 2014-02-18 Janus Weil PR fortran/60231 * resolve.c (check_generic_tbp_ambiguity): Check for presence of dummy arguments to prevent ICE. 2014-02-18 Janus Weil PR fortran/60231 * gfortran.dg/typebound_generic_15.f90: New. From-SVN: r207836 --- gcc/fortran/ChangeLog | 6 ++++++ gcc/fortran/resolve.c | 21 ++++++++++++++++--- gcc/testsuite/ChangeLog | 5 +++++ .../gfortran.dg/typebound_generic_15.f90 | 18 ++++++++++++++++ 4 files changed, 47 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/typebound_generic_15.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 847b80e22b74..c1e5b6d55a7c 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2014-02-18 Janus Weil + + PR fortran/60231 + * resolve.c (check_generic_tbp_ambiguity): Check for presence of dummy + arguments to prevent ICE. + 2014-02-17 Janus Weil PR fortran/55907 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index b756fe28ec2b..8d5ca1be507d 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -11362,6 +11362,7 @@ check_generic_tbp_ambiguity (gfc_tbp_generic* t1, gfc_tbp_generic* t2, { 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, gfc_tbp_generic* t2, 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)) { diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index e94bd89874a6..92ae0d46caa6 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2014-02-18 Janus Weil + + PR fortran/60231 + * gfortran.dg/typebound_generic_15.f90: New. + 2014-02-17 Janus Weil PR fortran/55907 diff --git a/gcc/testsuite/gfortran.dg/typebound_generic_15.f90 b/gcc/testsuite/gfortran.dg/typebound_generic_15.f90 new file mode 100644 index 000000000000..f71ffd9e8a7f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/typebound_generic_15.f90 @@ -0,0 +1,18 @@ +! { dg-do compile } +! +! PR 60231: [4.8/4.9 Regression] ICE on undefined generic +! +! Contributed by Antony Lewis + +module Objects + + Type TObjectList + contains + procedure :: Add1 ! { dg-error "must be a module procedure" } + procedure :: Add2 ! { dg-error "must be a module procedure" } + generic :: Add => Add1, Add2 ! { dg-error "are ambiguous" } + end Type + +end module + +! { dg-final { cleanup-modules "Objects" } }