From: janus Date: Mon, 2 Jun 2008 21:50:23 +0000 (+0000) Subject: 2008-06-02 Janus Weil X-Git-Tag: upstream/4.9.2~41701 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=63986dfbd4d862a262d9d8afdc2bd16e62d89b7b;p=platform%2Fupstream%2Flinaro-gcc.git 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@136296 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 1a3d2da..fd0817b 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 f6884f2..ea87c21 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 dc1a62b..33f13c9 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 78561aa..e4e4324 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 0bfe14a..efb1b2a 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 0000000..1afc5ef --- /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" } }