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 | |
| 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')
| -rw-r--r-- | gcc/fortran/ChangeLog | 9 | ||||
| -rw-r--r-- | gcc/fortran/check.c | 6 | ||||
| -rw-r--r-- | gcc/fortran/match.c | 35 |
3 files changed, 46 insertions, 4 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 5729982..81bff2b 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +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 Nick Clifton <nickc@redhat.com> * arith.c: Change copyright header to refer to version 3 of the diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index d111d0f..b615f73 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -488,9 +488,6 @@ gfc_check_allocated (gfc_expr *array) if (variable_check (array, 0) == FAILURE) return FAILURE; - if (array_check (array, 0) == FAILURE) - return FAILURE; - attr = gfc_variable_attr (array, NULL); if (!attr.allocatable) { @@ -500,6 +497,9 @@ gfc_check_allocated (gfc_expr *array) return FAILURE; } + if (array_check (array, 0) == FAILURE) + return FAILURE; + return SUCCESS; } 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; |