This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
Re: [Patch, fortran] PR20779 and PR20891 - allocation of STAT or specification variables in same call
- From: Grigory Zagorodnev <grigory_zagorodnev at linux dot intel dot com>
- To: Paul Thomas <paulthomas2 at wanadoo dot fr>
- Cc: patch <gcc-patches at gcc dot gnu dot org>, "'fortran at gcc dot gnu dot org'" <fortran at gcc dot gnu dot org>
- Date: Wed, 04 Oct 2006 14:14:30 +0400
- Subject: Re: [Patch, fortran] PR20779 and PR20891 - allocation of STAT or specification variables in same call
- References: <450D87A2.1040003@wanadoo.fr> <450ED555.7010000@wanadoo.fr>
Hi!
This patch causes compilation failure on SPEC cpu2000/facerec.
Below is the minimal reproducer:
Subroutine ReadParameters (Album)
Implicit NONE
Type GalleryP
Integer :: NoOfEntries
Character(80), Pointer :: FileName (:)
End Type GalleryP
Type(GalleryP), Intent(Out) :: Album
Allocate (Album%FileName (Album%NoOfEntries))
end
Error message:
In file small2.f90:10
Allocate (Album%FileName (Album%NoOfEntries))
1
Error: 'album' must not appear an the array specification at (1) in the
same ALLOCATE statement where it is itself allocated
- Grigory
Paul Thomas wrote:
Bother! Sorry about forgetting the patch.
Paul
:ADDPATCH fortran:
This patch provides a diagnostic of standard violating code, which has:
allocate (i, x(i)) or allocate (i, stat = i) ;
ie. allocation of objects used in specification expressions or of the
stat variable, within the same allocate statement. The bit of the
patch that deals with the stat variable being allocated is straight
forward; each new variable to be allocated has its symbol checked
against the symbol for stat. If the two are the same, this is an
error. The specification expressions are a bit more complicated; each
symbol to be allocated is checked by a new recursive function against
the symbols referenced in all the specification expressions in the
allocate statement. The testcase combines those received from each
reporter.
Regtested on FC5/Athlon - OK for trunk and 4.1?
Paul
2006-09-17 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-09-17 Paul Thomas <pault@gcc.gnu.org>
PR fortran/20779
PR fortran/20891
* gfortran.dg/alloc_alloc_expr_1.f90: New test.
------------------------------------------------------------------------
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c (révision 116697)
+++ gcc/fortran/resolve.c (copie de travail)
@@ -3308,6 +3308,81 @@
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
@@ -3352,10 +3427,17 @@
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. */
@@ -3376,6 +3458,14 @@
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)
{
@@ -3438,8 +3528,8 @@
return FAILURE;
}
- if (ref2->u.ar.type == AR_ELEMENT)
- return SUCCESS;
+/* 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. */
@@ -3447,25 +3537,45 @@
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;
}
Index: gcc/testsuite/gfortran.dg/alloc_alloc_expr_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/alloc_alloc_expr_1.f90 (révision 0)
+++ gcc/testsuite/gfortran.dg/alloc_alloc_expr_1.f90 (révision 0)
@@ -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