diff options
| author | Tobias Burnus <burnus@net-b.de> | 2007-08-01 19:55:24 +0200 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2007-08-01 19:55:24 +0200 |
| commit | b8a0d3cfd704fe84371ea9cb149ff58496383fc9 (patch) | |
| tree | 160db656889ff31c1d6edfee7050056b9d5b9251 /gcc/fortran/match.c | |
| parent | 8fe428c67045321f9f66b7051f60f549323b2694 (diff) | |
| download | gcc-b8a0d3cfd704fe84371ea9cb149ff58496383fc9.zip gcc-b8a0d3cfd704fe84371ea9cb149ff58496383fc9.tar.gz gcc-b8a0d3cfd704fe84371ea9cb149ff58496383fc9.tar.bz2 | |
re PR fortran/32936 (ALLOCATE: "STAT expression ... must be a variable" - but it is one)
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.
From-SVN: r127135
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 2b379c3..39e39af 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; |