From e62532afd777edea4d3eeb1963060f75952319ca Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Mon, 2 Jun 2008 23:50:23 +0200 Subject: [PATCH] re PR fortran/36361 (attribute declaration outside of INTERFACE body) 2008-06-02 Janus Weil PR fortran/36361 * symbol.c (gfc_add_allocatable,gfc_add_dimension, gfc_add_explicit_interface): Added checks. * decl.c (attr_decl1): Added missing "var_locus". * parse.c (parse_interface): Checking for errors. 2008-06-02 Janus Weil PR fortran/36361 * gfortran.dg/interface_24.f90: New. From-SVN: r136296 --- gcc/fortran/ChangeLog | 8 +++ gcc/fortran/decl.c | 2 +- gcc/fortran/parse.c | 19 +++---- gcc/fortran/symbol.c | 23 ++++++++ gcc/testsuite/ChangeLog | 5 ++ gcc/testsuite/gfortran.dg/interface_24.f90 | 66 ++++++++++++++++++++++ 6 files changed, 110 insertions(+), 13 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/interface_24.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 1a3d2dac94a..fd0817becbd 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2008-06-02 Janus Weil + + PR fortran/36361 + * symbol.c (gfc_add_allocatable,gfc_add_dimension, + gfc_add_explicit_interface): Added checks. + * decl.c (attr_decl1): Added missing "var_locus". + * parse.c (parse_interface): Checking for errors. + 2008-06-02 Daniel Kraft * gfortran.h: New statement-type ST_FINAL for FINAL declarations. diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index f6884f2505a..ea87c211d49 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -5216,7 +5216,7 @@ attr_decl1 (void) /* Update symbol table. DIMENSION attribute is set in gfc_set_array_spec(). */ if (current_attr.dimension == 0 - && gfc_copy_attr (&sym->attr, ¤t_attr, NULL) == FAILURE) + && gfc_copy_attr (&sym->attr, ¤t_attr, &var_locus) == FAILURE) { m = MATCH_ERROR; goto cleanup; diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index dc1a62b1a08..33f13c92200 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -1974,23 +1974,18 @@ loop: unexpected_eof (); case ST_SUBROUTINE: - new_state = COMP_SUBROUTINE; - gfc_add_explicit_interface (gfc_new_block, IFSRC_IFBODY, - gfc_new_block->formal, NULL); - if (current_interface.type != INTERFACE_ABSTRACT && - !gfc_new_block->attr.dummy && - gfc_add_external (&gfc_new_block->attr, &gfc_current_locus) == FAILURE) + case ST_FUNCTION: + if (st == ST_SUBROUTINE) + new_state = COMP_SUBROUTINE; + else if (st == ST_FUNCTION) + new_state = COMP_FUNCTION; + if (gfc_add_explicit_interface (gfc_new_block, IFSRC_IFBODY, + gfc_new_block->formal, NULL) == FAILURE) { reject_statement (); gfc_free_namespace (gfc_current_ns); goto loop; } - break; - - case ST_FUNCTION: - new_state = COMP_FUNCTION; - gfc_add_explicit_interface (gfc_new_block, IFSRC_IFBODY, - gfc_new_block->formal, NULL); if (current_interface.type != INTERFACE_ABSTRACT && !gfc_new_block->attr.dummy && gfc_add_external (&gfc_new_block->attr, &gfc_current_locus) == FAILURE) diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 78561aac47d..e4e43244d59 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -814,6 +814,14 @@ gfc_add_allocatable (symbol_attribute *attr, locus *where) return FAILURE; } + if (attr->flavor == FL_PROCEDURE && attr->if_source == IFSRC_IFBODY + && gfc_find_state (COMP_INTERFACE) == FAILURE) + { + gfc_error ("ALLOCATABLE specified outside of INTERFACE body at %L", + where); + return FAILURE; + } + attr->allocatable = 1; return check_conflict (attr, NULL, where); } @@ -832,6 +840,14 @@ gfc_add_dimension (symbol_attribute *attr, const char *name, locus *where) return FAILURE; } + if (attr->flavor == FL_PROCEDURE && attr->if_source == IFSRC_IFBODY + && gfc_find_state (COMP_INTERFACE) == FAILURE) + { + gfc_error ("DIMENSION specified for '%s' outside its INTERFACE body " + "at %L", name, where); + return FAILURE; + } + attr->dimension = 1; return check_conflict (attr, name, where); } @@ -1453,6 +1469,13 @@ gfc_add_explicit_interface (gfc_symbol *sym, ifsrc source, return FAILURE; } + if (source == IFSRC_IFBODY && (sym->attr.dimension || sym->attr.allocatable)) + { + gfc_error ("'%s' at %L has attributes specified outside its INTERFACE " + "body", sym->name, where); + return FAILURE; + } + sym->formal = formal; sym->attr.if_source = source; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 0bfe14a3538..efb1b2ac643 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2008-06-02 Janus Weil + + PR fortran/36361 + * gfortran.dg/interface_24.f90: New. + 2008-06-02 Paolo Carlini PR c++/36404 diff --git a/gcc/testsuite/gfortran.dg/interface_24.f90 b/gcc/testsuite/gfortran.dg/interface_24.f90 new file mode 100644 index 00000000000..1afc5ef2fba --- /dev/null +++ b/gcc/testsuite/gfortran.dg/interface_24.f90 @@ -0,0 +1,66 @@ +! { dg-do compile } +! +! This tests the fix for PR36361: If a function was declared in an INTERFACE +! statement, no attributes may be declared outside of the INTERFACE body. +! +! Contributed by Janus Weil + +module m1 + interface + real function f1() + end function + end interface + dimension :: f1(4) ! { dg-error "outside its INTERFACE body" } +end module + + +module m2 + dimension :: f2(4) + interface + real function f2() ! { dg-error "outside its INTERFACE body" } + !end function + end interface +end module + + +! valid +module m3 + interface + real function f3() + dimension :: f3(4) + end function + end interface +end module + + +module m4 + interface + function f4() ! { dg-error "cannot have a deferred shape" } + real :: f4(:) + end function + end interface + allocatable :: f4 ! { dg-error "outside of INTERFACE body" } +end module + + +module m5 + allocatable :: f5(:) + interface + function f5() ! { dg-error "outside its INTERFACE body" } + !real f5(:) + !end function + end interface +end module + + +!valid +module m6 + interface + function f6() + real f6(:) + allocatable :: f6 + end function + end interface +end module + +! { dg-final { cleanup-modules "m1 m2 m3 m4 m5 m6" } } -- 2.30.2