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/ChangeLog | 7 +++++++ gcc/fortran/decl.c | 10 +++++++++- gcc/fortran/symbol.c | 10 ++++++++-- gcc/testsuite/ChangeLog | 7 ++++++- gcc/testsuite/gfortran.dg/proc_decl_21.f90 | 32 ++++++++++++++++++++++++++++++ 5 files changed, 62 insertions(+), 4 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/proc_decl_21.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 1e5ebc6..6db6c63 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +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 Paul Thomas PR fortran/36091 diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 1e83d21..2e54147 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -4207,12 +4207,20 @@ got_ts: /* Set interface. */ if (proc_if != NULL) { + if (sym->ts.type != BT_UNKNOWN) + { + gfc_error ("Procedure '%s' at %L already has basic type of %s", + sym->name, &gfc_current_locus, + gfc_basic_typename (sym->ts.type)); + return MATCH_ERROR; + } sym->ts.interface = proc_if; sym->attr.untyped = 1; } else if (current_ts.type != BT_UNKNOWN) { - sym->ts = current_ts; + if (gfc_add_type (sym, ¤t_ts, &gfc_current_locus) == FAILURE) + return MATCH_ERROR; sym->ts.interface = gfc_new_symbol ("", gfc_current_ns); sym->ts.interface->ts = current_ts; sym->ts.interface->attr.function = 1; 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 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index d93f198..3bedcb7 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,4 +1,9 @@ -2009-04-06 Paul Thomas + + PR fortran/39414 + * gfortran.dg/proc_decl_21.f90: New. + +2009-04-06 Paul Thomas PR fortran/36091 * gfortran.dg/forall_13.f90: Add -fbounds-check option. diff --git a/gcc/testsuite/gfortran.dg/proc_decl_21.f90 b/gcc/testsuite/gfortran.dg/proc_decl_21.f90 new file mode 100644 index 0000000..4fd4020 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/proc_decl_21.f90 @@ -0,0 +1,32 @@ +! { dg-do compile } +! +! PR fortran/39414: PROCEDURE statement double declaration bug +! +! Discovered by Paul Thomas +! Modified by Janus Weil + + +! forbidden + +procedure(integer) :: a +integer :: a ! { dg-error "already has basic type of" } + +integer :: b +procedure(integer) :: b ! { dg-error "already has basic type of" } + +procedure(iabs) :: c +integer :: c ! { dg-error "may not have basic type of" } + +integer :: d +procedure(iabs) :: d ! { dg-error "already has basic type of" } + +! allowed + +integer :: e +procedure() :: e + +procedure() :: f +integer :: f + +end + -- cgit v1.1