From b93d8a3f16bc7582254edf988b14009587fe00a6 Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Sat, 12 Nov 2016 10:25:47 +0100 Subject: [PATCH] re PR fortran/77501 ([F03] ICE in gfc_match_generic, at fortran/decl.c:9429) 2016-11-12 Janus Weil PR fortran/77501 * class.c (gfc_find_typebound_intrinsic_op): Remove an unnecessary assert and nullification. * decl.c (gfc_match_decl_type_spec): Use gfc_get_tbp_symtree, fix indentation. (gfc_match_generic): Remove an unnecessary assert. Use gfc_get_tbp_symtree to avoid ICE. 2016-11-12 Janus Weil PR fortran/77501 * gfortran.dg/typebound_generic_16.f90: New test. From-SVN: r242335 --- gcc/fortran/ChangeLog | 10 ++++++++ gcc/fortran/class.c | 13 ++--------- gcc/fortran/decl.c | 23 +++++-------------- gcc/testsuite/ChangeLog | 5 ++++ .../gfortran.dg/typebound_generic_16.f90 | 21 +++++++++++++++++ 5 files changed, 44 insertions(+), 28 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/typebound_generic_16.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index ae8f661ff53..6e0b654eb0e 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2016-11-12 Janus Weil + + PR fortran/77501 + * class.c (gfc_find_typebound_intrinsic_op): Remove an unnecessary + assert and nullification. + * decl.c (gfc_match_decl_type_spec): Use gfc_get_tbp_symtree, + fix indentation. + (gfc_match_generic): Remove an unnecessary assert. + Use gfc_get_tbp_symtree to avoid ICE. + 2016-11-10 Fritz O. Reese PR fortran/78277 diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c index b7f68d2f19a..b42ec40578f 100644 --- a/gcc/fortran/class.c +++ b/gcc/fortran/class.c @@ -2963,15 +2963,6 @@ gfc_find_typebound_intrinsic_op (gfc_symbol* derived, bool* t, gfc_symtree* gfc_get_tbp_symtree (gfc_symtree **root, const char *name) { - gfc_symtree *result; - - result = gfc_find_symtree (*root, name); - if (!result) - { - result = gfc_new_symtree (root, name); - gcc_assert (result); - result->n.tb = NULL; - } - - return result; + gfc_symtree *result = gfc_find_symtree (*root, name); + return result ? result : gfc_new_symtree (root, name); } diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index bf6bc246709..b17a8aa7da2 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -3198,13 +3198,11 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag) upe->attr.zero_comp = 1; if (!gfc_add_flavor (&upe->attr, FL_DERIVED, NULL, &gfc_current_locus)) - return MATCH_ERROR; - } + return MATCH_ERROR; + } else { - st = gfc_find_symtree (gfc_current_ns->sym_root, "STAR"); - if (st == NULL) - st = gfc_new_symtree (&gfc_current_ns->sym_root, "STAR"); + st = gfc_get_tbp_symtree (&gfc_current_ns->sym_root, "STAR"); st->n.sym = upe; upe->refs++; } @@ -9731,14 +9729,7 @@ gfc_match_generic (void) gfc_symtree* st; st = gfc_find_symtree (is_op ? ns->tb_uop_root : ns->tb_sym_root, name); - if (st) - { - tb = st->n.tb; - gcc_assert (tb); - } - else - tb = NULL; - + tb = st ? st->n.tb : NULL; break; } @@ -9783,10 +9774,8 @@ gfc_match_generic (void) case INTERFACE_USER_OP: { const bool is_op = (op_type == INTERFACE_USER_OP); - gfc_symtree* st; - - st = gfc_new_symtree (is_op ? &ns->tb_uop_root : &ns->tb_sym_root, - name); + gfc_symtree* st = gfc_get_tbp_symtree (is_op ? &ns->tb_uop_root : + &ns->tb_sym_root, name); gcc_assert (st); st->n.tb = tb; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 21d11935bc5..dc6198a4d24 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2016-11-12 Janus Weil + + PR fortran/77501 + * gfortran.dg/typebound_generic_16.f90: New test. + 2016-11-12 Jakub Jelinek PR c++/71225 diff --git a/gcc/testsuite/gfortran.dg/typebound_generic_16.f90 b/gcc/testsuite/gfortran.dg/typebound_generic_16.f90 new file mode 100644 index 00000000000..0043fbb2152 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/typebound_generic_16.f90 @@ -0,0 +1,21 @@ +! { dg-do compile } +! +! PR 77501: [F03] ICE in gfc_match_generic, at fortran/decl.c:9429 +! +! Contributed by Gerhard Steinmetz + +module m1 + type t + contains + generic :: f => g ! { dg-error "must target a specific binding" } + generic :: g => h ! { dg-error "Undefined specific binding" } + end type +end + +module m2 + type t + contains + generic :: f => g ! { dg-error "must target a specific binding" } + generic :: g => f ! { dg-error "Undefined specific binding" } + end type +end -- 2.30.2