diff options
author | janus <janus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2008-06-02 21:50:23 +0000 |
---|---|---|
committer | janus <janus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2008-06-02 21:50:23 +0000 |
commit | 63986dfbd4d862a262d9d8afdc2bd16e62d89b7b (patch) | |
tree | 9408c03560055917d4f9cd80a0cb49ed50dc1761 /gcc/fortran/symbol.c | |
parent | a4aaa624ebc974c543cfc2ee9cfb1b97dc48f2a4 (diff) | |
download | gcc-63986dfbd4d862a262d9d8afdc2bd16e62d89b7b.tar.gz |
2008-06-02 Janus Weil <janus@gcc.gnu.org>
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 <janus@gcc.gnu.org>
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
Diffstat (limited to 'gcc/fortran/symbol.c')
-rw-r--r-- | gcc/fortran/symbol.c | 23 |
1 files changed, 23 insertions, 0 deletions
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; |