diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 11 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 143 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/alloc_alloc_expr_1.f90 | 29 |
4 files changed, 171 insertions, 18 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index f0455116236..ea011dca7e4 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,14 @@ +2006-10-03 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/20779 + PR fortran/20891 + * resolve.c (find_sym_in_expr): New function that returns true + if a symbol is found in an expression. + (resolve_allocate_expr): Check whether the STAT variable is + itself allocated in the same statement. Use the call above to + check whether any of the allocated arrays are used in array + specifications in the same statement. + 2006-10-03 Steven G. Kargl <kargl@gcc.gnu.org> * arith.c (gfc_check_real_range): Use correct exponent range for diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 854d3b43845..7639eb737e1 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -3319,6 +3319,81 @@ resolve_deallocate_expr (gfc_expr * e) return SUCCESS; } +/* Returns true if the expression e contains a reference the symbol sym. */ +static bool +find_sym_in_expr (gfc_symbol *sym, gfc_expr *e) +{ + gfc_actual_arglist *arg; + gfc_ref *ref; + int i; + bool rv = false; + + if (e == NULL) + return rv; + + switch (e->expr_type) + { + case EXPR_FUNCTION: + for (arg = e->value.function.actual; arg; arg = arg->next) + rv = rv || find_sym_in_expr (sym, arg->expr); + break; + + /* If the variable is not the same as the dependent, 'sym', and + it is not marked as being declared and it is in the same + namespace as 'sym', add it to the local declarations. */ + case EXPR_VARIABLE: + if (sym == e->symtree->n.sym) + return true; + break; + + case EXPR_OP: + rv = rv || find_sym_in_expr (sym, e->value.op.op1); + rv = rv || find_sym_in_expr (sym, e->value.op.op2); + break; + + default: + break; + } + + if (e->ref) + { + for (ref = e->ref; ref; ref = ref->next) + { + switch (ref->type) + { + case REF_ARRAY: + for (i = 0; i < ref->u.ar.dimen; i++) + { + rv = rv || find_sym_in_expr (sym, ref->u.ar.start[i]); + rv = rv || find_sym_in_expr (sym, ref->u.ar.end[i]); + rv = rv || find_sym_in_expr (sym, ref->u.ar.stride[i]); + } + break; + + case REF_SUBSTRING: + rv = rv || find_sym_in_expr (sym, ref->u.ss.start); + rv = rv || find_sym_in_expr (sym, ref->u.ss.end); + break; + + case REF_COMPONENT: + if (ref->u.c.component->ts.type == BT_CHARACTER + && ref->u.c.component->ts.cl->length->expr_type + != EXPR_CONSTANT) + rv = rv || find_sym_in_expr (sym, ref->u.c.component->ts.cl->length); + + if (ref->u.c.component->as) + for (i = 0; i < ref->u.c.component->as->rank; i++) + { + rv = rv || find_sym_in_expr (sym, ref->u.c.component->as->lower[i]); + rv = rv || find_sym_in_expr (sym, ref->u.c.component->as->upper[i]); + } + break; + } + } + } + return rv; +} + /* Given the expression node e for an allocatable/pointer of derived type to be allocated, get the expression node to be initialized afterwards (needed for @@ -3363,10 +3438,17 @@ resolve_allocate_expr (gfc_expr * e, gfc_code * code) gfc_array_ref *ar; gfc_code *init_st; gfc_expr *init_e; + gfc_symbol *sym; + gfc_alloc *a; if (gfc_resolve_expr (e) == FAILURE) return FAILURE; + if (code->expr && code->expr->expr_type == EXPR_VARIABLE) + sym = code->expr->symtree->n.sym; + else + sym = NULL; + /* Make sure the expression is allocatable or a pointer. If it is pointer, the next-to-last reference must be a pointer. */ @@ -3387,6 +3469,14 @@ resolve_allocate_expr (gfc_expr * e, gfc_code * code) pointer = e->symtree->n.sym->attr.pointer; dimension = e->symtree->n.sym->attr.dimension; + if (sym == e->symtree->n.sym) + { + gfc_error ("The STAT variable '%s' in an ALLOCATE statement must " + "not be allocated in the same statement at %L", + sym->name, &e->where); + return FAILURE; + } + for (ref = e->ref; ref; ref2 = ref, ref = ref->next) switch (ref->type) { @@ -3449,34 +3539,51 @@ resolve_allocate_expr (gfc_expr * e, gfc_code * code) return FAILURE; } - if (ref2->u.ar.type == AR_ELEMENT) - return SUCCESS; - /* Make sure that the array section reference makes sense in the context of an ALLOCATE specification. */ ar = &ref2->u.ar; for (i = 0; i < ar->dimen; i++) - switch (ar->dimen_type[i]) - { - case DIMEN_ELEMENT: - break; + { + if (ref2->u.ar.type == AR_ELEMENT) + goto check_symbols; - case DIMEN_RANGE: - if (ar->start[i] != NULL - && ar->end[i] != NULL - && ar->stride[i] == NULL) + switch (ar->dimen_type[i]) + { + case DIMEN_ELEMENT: break; - /* Fall Through... */ + case DIMEN_RANGE: + if (ar->start[i] != NULL + && ar->end[i] != NULL + && ar->stride[i] == NULL) + break; - case DIMEN_UNKNOWN: - case DIMEN_VECTOR: - gfc_error ("Bad array specification in ALLOCATE statement at %L", - &e->where); - return FAILURE; - } + /* Fall Through... */ + + case DIMEN_UNKNOWN: + case DIMEN_VECTOR: + gfc_error ("Bad array specification in ALLOCATE statement at %L", + &e->where); + return FAILURE; + } + +check_symbols: + + for (a = code->ext.alloc_list; a; a = a->next) + { + sym = a->expr->symtree->n.sym; + if ((ar->start[i] != NULL && find_sym_in_expr (sym, ar->start[i])) + || (ar->end[i] != NULL && find_sym_in_expr (sym, ar->end[i]))) + { + gfc_error ("'%s' must not appear an the array specification at " + "%L in the same ALLOCATE statement where it is " + "itself allocated", sym->name, &ar->where); + return FAILURE; + } + } + } return SUCCESS; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 5e3a75be519..ea575ee0d18 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,5 +1,11 @@ 2006-10-03 Paul Thomas <pault@gcc.gnu.org> + PR fortran/20779 + PR fortran/20891 + * gfortran.dg/alloc_alloc_expr_1.f90: New test. + +2006-10-03 Paul Thomas <pault@gcc.gnu.org> + PR fortran/29284 * gfortran.dg/optional_assumed_charlen_1.f90: New test. diff --git a/gcc/testsuite/gfortran.dg/alloc_alloc_expr_1.f90 b/gcc/testsuite/gfortran.dg/alloc_alloc_expr_1.f90 new file mode 100644 index 00000000000..477643855a2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/alloc_alloc_expr_1.f90 @@ -0,0 +1,29 @@ +! { dg-do compile } +program fc011 +! Tests fix for PR20779 and PR20891. +! Submitted by Walt Brainerd, The Fortran Company +! and by Joost VandeVondele <jv244@cam.ac.uk> + +! This program violates requirements of 6.3.1 of the F95 standard. + +! An allocate-object, or a subobject of an allocate-object, shall not appear +! in a bound in the same ALLOCATE statement. The stat-variable shall not appear +! in a bound in the same ALLOCATE statement. + +! The stat-variable shall not be allocated within the ALLOCATE statement in which +! it appears; nor shall it depend on the value, bounds, allocation status, or +! association status of any allocate-object or subobject of an allocate-object +! allocated in the same statement. + + integer, pointer :: PTR + integer, allocatable :: ALLOCS(:) + + allocate (PTR, stat=PTR) ! { dg-error "allocated in the same statement" } + + allocate (ALLOCS(10),stat=ALLOCS(1)) ! { dg-error "allocated in the same statement" } + + ALLOCATE(PTR,ALLOCS(PTR)) ! { dg-error "same ALLOCATE statement" } + + print *, 'This program has three errors', PTR, ALLOC(1) + +end program fc011 |
