diff options
| author | burnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2007-08-01 17:55:24 +0000 |
|---|---|---|
| committer | burnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2007-08-01 17:55:24 +0000 |
| commit | 03a36ba087ba2252140023a085ccaa9dad97d03e (patch) | |
| tree | 160db656889ff31c1d6edfee7050056b9d5b9251 /gcc/fortran/match.c | |
| parent | 53715072943525b53fa426f347ab0c6f7e397343 (diff) | |
| download | gcc-03a36ba087ba2252140023a085ccaa9dad97d03e.tar.gz | |
2007-08-01 Tobias Burnus <burnus@net-b.de>
PR fortran/32936
* match.c (gfc_match_allocate): Better check that STAT is
a variable.
* check.c (gfc_check_allocated): Reorder checks to improve
error message.
2007-08-01 Tobias Burnus <burnus@net-b.de>
PR fortran/32936
* gfortran.dg/allocate_stat.f90: New.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@127135 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/fortran/match.c')
| -rw-r--r-- | gcc/fortran/match.c | 35 |
1 files changed, 34 insertions, 1 deletions
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 2b379c3786d..39e39af29a6 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -2000,6 +2000,8 @@ gfc_match_allocate (void) if (stat != NULL) { + bool is_variable; + if (stat->symtree->n.sym->attr.intent == INTENT_IN) { gfc_error ("STAT variable '%s' of ALLOCATE statement at %C cannot " @@ -2014,7 +2016,38 @@ gfc_match_allocate (void) goto cleanup; } - if (stat->symtree->n.sym->attr.flavor != FL_VARIABLE) + is_variable = false; + if (stat->symtree->n.sym->attr.flavor == FL_VARIABLE) + is_variable = true; + else if (stat->symtree->n.sym->attr.function + && stat->symtree->n.sym->result == stat->symtree->n.sym + && (gfc_current_ns->proc_name == stat->symtree->n.sym + || (gfc_current_ns->parent + && gfc_current_ns->parent->proc_name + == stat->symtree->n.sym))) + is_variable = true; + else if (gfc_current_ns->entries + && stat->symtree->n.sym->result == stat->symtree->n.sym) + { + gfc_entry_list *el; + for (el = gfc_current_ns->entries; el; el = el->next) + if (el->sym == stat->symtree->n.sym) + { + is_variable = true; + } + } + else if (gfc_current_ns->parent && gfc_current_ns->parent->entries + && stat->symtree->n.sym->result == stat->symtree->n.sym) + { + gfc_entry_list *el; + for (el = gfc_current_ns->parent->entries; el; el = el->next) + if (el->sym == stat->symtree->n.sym) + { + is_variable = true; + } + } + + if (!is_variable) { gfc_error ("STAT expression at %C must be a variable"); goto cleanup; |