From 1d146030e28eb829762a0c888abf8733ec500b89 Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Mon, 6 Apr 2009 10:33:31 +0200 Subject: re PR fortran/39414 (PROCEDURE statement double declaration bug) 2009-04-06 Janus Weil PR fortran/39414 * decl.c (match_procedure_decl): Fix double declaration problems with PROCEDURE statements. * symbol.c (gfc_add_type): Ditto. 2009-04-06 Janus Weil PR fortran/39414 * gfortran.dg/proc_decl_21.f90: New. From-SVN: r145583 --- gcc/fortran/symbol.c | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) (limited to 'gcc/fortran/symbol.c') diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 7888235..7414616 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -1555,8 +1555,7 @@ gfc_add_type (gfc_symbol *sym, gfc_typespec *ts, locus *where) if (sym->ts.type != BT_UNKNOWN) { const char *msg = "Symbol '%s' at %L already has basic type of %s"; - if (!(sym->ts.type == ts->type - && (sym->attr.flavor == FL_PROCEDURE || sym->attr.result)) + if (!(sym->ts.type == ts->type && sym->attr.result) || gfc_notification_std (GFC_STD_GNU) == ERROR || pedantic) { @@ -1570,6 +1569,13 @@ gfc_add_type (gfc_symbol *sym, gfc_typespec *ts, locus *where) gfc_warning (msg, sym->name, where, gfc_basic_typename (sym->ts.type)); } + if (sym->attr.procedure && sym->ts.interface) + { + gfc_error ("Procedure '%s' at %L may not have basic type of %s", sym->name, where, + gfc_basic_typename (ts->type)); + return FAILURE; + } + flavor = sym->attr.flavor; if (flavor == FL_PROGRAM || flavor == FL_BLOCK_DATA || flavor == FL_MODULE -- cgit v1.1