From 1d10121630ae1181611e6fde41ab89c507326564 Mon Sep 17 00:00:00 2001 From: Jerry DeLisle Date: Sun, 24 Jan 2016 22:18:20 +0000 Subject: [PATCH] [multiple changes] 2016-01-23 Jerry DeLisle PR fortran/69397 PR fortran/68442 * interface.c (gfc_arglist_matches_symbol): Replace assert with a return false if not a procedure. * resolve.c (resolve_generic_f): Test if we are resolving an initialization expression and adjust error message accordingly. 2016-01-24 Jerry DeLisle PR fortran/69397 PR fortran/68442 * gfortran.dg/interface_38.f90: New test. * gfortran.dg/interface_39.f90: New test. From-SVN: r232780 --- gcc/fortran/ChangeLog | 9 +++++++++ gcc/fortran/interface.c | 3 ++- gcc/fortran/resolve.c | 9 +++++++-- gcc/testsuite/ChangeLog | 7 +++++++ gcc/testsuite/gfortran.dg/interface_38.f90 | 16 ++++++++++++++++ gcc/testsuite/gfortran.dg/interface_39.f90 | 14 ++++++++++++++ 6 files changed, 55 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/interface_38.f90 create mode 100644 gcc/testsuite/gfortran.dg/interface_39.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 414991bc67c..5853ddf374c 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2016-01-23 Jerry DeLisle + + PR fortran/69397 + PR fortran/68442 + * interface.c (gfc_arglist_matches_symbol): Replace assert with + a return false if not a procedure. + * resolve.c (resolve_generic_f): Test if we are resolving an + initialization expression and adjust error message accordingly. + 2016-01-24 Thomas Koenig PR fortran/66094 diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index f5e8d0d7bbe..5c66c6ef31c 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -3506,7 +3506,8 @@ gfc_arglist_matches_symbol (gfc_actual_arglist** args, gfc_symbol* sym) gfc_formal_arglist *dummy_args; bool r; - gcc_assert (sym->attr.flavor == FL_PROCEDURE); + if (sym->attr.flavor != FL_PROCEDURE) + return false; dummy_args = gfc_sym_get_dummy_args (sym); diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 64d59ceef17..8752fd4693b 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -2565,8 +2565,13 @@ generic: that possesses a matching interface. 14.1.2.4 */ if (sym && !intr && !gfc_is_intrinsic (sym, 0, expr->where)) { - gfc_error ("There is no specific function for the generic %qs " - "at %L", expr->symtree->n.sym->name, &expr->where); + if (gfc_init_expr_flag) + gfc_error ("Function %qs in initialization expression at %L " + "must be an intrinsic function", + expr->symtree->n.sym->name, &expr->where); + else + gfc_error ("There is no specific function for the generic %qs " + "at %L", expr->symtree->n.sym->name, &expr->where); return false; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 95f49032225..30540554b73 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2016-01-24 Jerry DeLisle + + PR fortran/69397 + PR fortran/68442 + * gfortran.dg/interface_38.f90: New test. + * gfortran.dg/interface_39.f90: New test. + 2016-01-24 Patrick Palka Revert: diff --git a/gcc/testsuite/gfortran.dg/interface_38.f90 b/gcc/testsuite/gfortran.dg/interface_38.f90 new file mode 100644 index 00000000000..d8f42ee814f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/interface_38.f90 @@ -0,0 +1,16 @@ +! { dg-do compile } +! PR69397 +program p + interface f + procedure f1 ! { dg-error "neither function nor subroutine" } + !... more + end interface + integer, allocatable :: z + print *, f(z) ! { dg-error "no specific function" } +contains + integer function f2 (x) + integer, allocatable :: x + f2 = 1 + end +end + diff --git a/gcc/testsuite/gfortran.dg/interface_39.f90 b/gcc/testsuite/gfortran.dg/interface_39.f90 new file mode 100644 index 00000000000..0d6a38e11e2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/interface_39.f90 @@ -0,0 +1,14 @@ +! { dg-do compile } +! PR68442 +module m + interface gkind + procedure g + end interface +contains + subroutine f(x) + character(kind=gkind()) :: x ! { dg-error "must be an intrinsic" } + end + integer function g() + g = 1 + end +end