procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/23091 (ICE in gfc_trans_auto_array_allocation)

Browse source 
2006-06-07  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/23091
	* resolve.c (resolve_fl_variable): Error if an automatic
	object has the SAVE attribute.

	PR fortran/24168
	* expr.c (simplify_intrinsic_op): Transfer the rank and
	the locus to the simplified expression.

	PR fortran/25090
	PR fortran/25058
	* gfortran.h : Add int entry_id to gfc_symbol.
	* resolve.c : Add static variables current_entry_id and
	specification_expr.
	(resolve_variable): During code resolution, check if a
	reference to a dummy variable in an executable expression
	is preceded by its appearance as a parameter in an entry.
	Likewise check its specification expressions.
	(resolve_code): Update current_entry_id on EXEC_ENTRY.
	(resolve_charlen, resolve_fl_variable): Set and reset
	specifiaction_expr.
	(is_non_constant_shape_array): Do not return on detection
	of a variable but continue to resolve all the expressions.
	(resolve_codes): set current_entry_id to an out of range
	value.

2006-06-07  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/23091
	* gfortran.dg/saved_automatic_1.f90: New test.

	PR fortran/24168
	* gfortran.dg/array_simplify_1.f90: New test.

	PR fortran/25090
	* gfortran.dg/entry_dummy_ref_1.f90: New test.

	PR fortran/25058
	* gfortran.dg/entry_dummy_ref_2.f90: New test.

From-SVN: r114461
This commit is contained in:
Paul Thomas 2006-06-07 07:20:39 +00:00
parent d95c1c488a
commit 0e9a445b9d
9 changed files with 243 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
gcc/fortran/ChangeLog
View file

@ -1,3 +1,30 @@
2006-06-07 Paul Thomas <pault@gcc.gnu.org>
PR fortran/23091
* resolve.c (resolve_fl_variable): Error if an automatic
object has the SAVE attribute.
PR fortran/24168
* expr.c (simplify_intrinsic_op): Transfer the rank and
the locus to the simplified expression.
PR fortran/25090
PR fortran/25058
* gfortran.h : Add int entry_id to gfc_symbol.
* resolve.c : Add static variables current_entry_id and
specification_expr.
(resolve_variable): During code resolution, check if a
reference to a dummy variable in an executable expression
is preceded by its appearance as a parameter in an entry.
Likewise check its specification expressions.
(resolve_code): Update current_entry_id on EXEC_ENTRY.
(resolve_charlen, resolve_fl_variable): Set and reset
specifiaction_expr.
(is_non_constant_shape_array): Do not return on detection
of a variable but continue to resolve all the expressions.
(resolve_codes): set current_entry_id to an out of range
value.
2006-06-06 Mike Stump <mrs@apple.com>
* Make-lang.in: Rename to htmldir to build_htmldir to avoid

2
gcc/fortran/expr.c
View file

@ -869,6 +869,8 @@ simplify_intrinsic_op (gfc_expr * p, int type)
return FAILURE;
}
result->rank = p->rank;
result->where = p->where;
gfc_replace_expr (p, result);
return SUCCESS;

2
gcc/fortran/gfortran.h
View file

@ -838,6 +838,8 @@ typedef struct gfc_symbol
order. */
int dummy_order;
int entry_id;
gfc_namelist *namelist, *namelist_tail;
/* Change management fields. Symbols that might be modified by the

140
gcc/fortran/resolve.c
View file

@ -60,6 +60,12 @@ static int omp_workshare_flag;
resets the flag each time that it is read. */
static int formal_arg_flag = 0;
/* True if we are resolving a specification expression. */
static int specification_expr = 0;
/* The id of the last entry seen. */
static int current_entry_id;
int
gfc_is_formal_arg (void)
{
@ -2763,6 +2769,9 @@ static try
resolve_variable (gfc_expr * e)
{
gfc_symbol *sym;
try t;
t = SUCCESS;
if (e->ref && resolve_ref (e) == FAILURE)
return FAILURE;
@ -2790,7 +2799,73 @@ resolve_variable (gfc_expr * e)
if (check_assumed_size_reference (sym, e))
return FAILURE;
return SUCCESS;
/* Deal with forward references to entries during resolve_code, to
satisfy, at least partially, 12.5.2.5. */
if (gfc_current_ns->entries
&& current_entry_id == sym->entry_id
&& cs_base
&& cs_base->current
&& cs_base->current->op != EXEC_ENTRY)
{
gfc_entry_list *entry;
gfc_formal_arglist *formal;
int n;
bool seen;
/* If the symbol is a dummy... */
if (sym->attr.dummy)
{
entry = gfc_current_ns->entries;
seen = false;
/* ...test if the symbol is a parameter of previous entries. */
for (; entry && entry->id <= current_entry_id; entry = entry->next)
for (formal = entry->sym->formal; formal; formal = formal->next)
{
if (formal->sym && sym->name == formal->sym->name)
seen = true;
}
/* If it has not been seen as a dummy, this is an error. */
if (!seen)
{
if (specification_expr)
gfc_error ("Variable '%s',used in a specification expression, "
"is referenced at %L before the ENTRY statement "
"in which it is a parameter",
sym->name, &cs_base->current->loc);
else
gfc_error ("Variable '%s' is used at %L before the ENTRY "
"statement in which it is a parameter",
sym->name, &cs_base->current->loc);
t = FAILURE;
}
}
/* Now do the same check on the specification expressions. */
specification_expr = 1;
if (sym->ts.type == BT_CHARACTER
&& gfc_resolve_expr (sym->ts.cl->length) == FAILURE)
t = FAILURE;
if (sym->as)
for (n = 0; n < sym->as->rank; n++)
{
specification_expr = 1;
if (gfc_resolve_expr (sym->as->lower[n]) == FAILURE)
t = FAILURE;
specification_expr = 1;
if (gfc_resolve_expr (sym->as->upper[n]) == FAILURE)
t = FAILURE;
}
specification_expr = 0;
if (t == SUCCESS)
/* Update the symbol's entry level. */
sym->entry_id = current_entry_id + 1;
}
return t;
}
@ -4490,7 +4565,11 @@ resolve_code (gfc_code * code, gfc_namespace * ns)
case EXEC_EXIT:
case EXEC_CONTINUE:
case EXEC_DT_END:
break;
case EXEC_ENTRY:
/* Keep track of which entry we are up to. */
current_entry_id = code->ext.entry->id;
break;
case EXEC_WHERE:
@ -4769,7 +4848,6 @@ resolve_values (gfc_symbol * sym)
static try
resolve_index_expr (gfc_expr * e)
{
if (gfc_resolve_expr (e) == FAILURE)
return FAILURE;
@ -4792,8 +4870,13 @@ resolve_charlen (gfc_charlen *cl)
cl->resolved = 1;
specification_expr = 1;
if (resolve_index_expr (cl->length) == FAILURE)
return FAILURE;
{
specification_expr = 0;
return FAILURE;
}
return SUCCESS;
}
@ -4806,7 +4889,9 @@ is_non_constant_shape_array (gfc_symbol *sym)
{
gfc_expr *e;
int i;
bool not_constant;
not_constant = false;
if (sym->as != NULL)
{
/* Unfortunately, !gfc_is_compile_time_shape hits a legal case that
@ -4817,15 +4902,15 @@ is_non_constant_shape_array (gfc_symbol *sym)
e = sym->as->lower[i];
if (e && (resolve_index_expr (e) == FAILURE
|| !gfc_is_constant_expr (e)))
return true;
not_constant = true;
e = sym->as->upper[i];
if (e && (resolve_index_expr (e) == FAILURE
|| !gfc_is_constant_expr (e)))
return true;
not_constant = true;
}
}
return false;
return not_constant;
}
/* Resolution of common features of flavors variable and procedure. */
@ -4877,22 +4962,34 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
int i;
gfc_expr *e;
gfc_expr *constructor_expr;
const char * auto_save_msg;
auto_save_msg = "automatic object '%s' at %L cannot have the "
"SAVE attribute";
if (resolve_fl_var_and_proc (sym, mp_flag) == FAILURE)
return FAILURE;
/* The shape of a main program or module array needs to be constant. */
if (sym->ns->proc_name
&& (sym->ns->proc_name->attr.flavor == FL_MODULE
|| sym->ns->proc_name->attr.is_main_program)
&& !sym->attr.use_assoc
/* Set this flag to check that variables are parameters of all entries.
This check is effected by the call to gfc_resolve_expr through
is_non_constant_shape_array. */
specification_expr = 1;
if (!sym->attr.use_assoc
&& !sym->attr.allocatable
&& !sym->attr.pointer
&& is_non_constant_shape_array (sym))
{
gfc_error ("The module or main program array '%s' at %L must "
"have constant shape", sym->name, &sym->declared_at);
return FAILURE;
/* The shape of a main program or module array needs to be constant. */
if (sym->ns->proc_name
&& (sym->ns->proc_name->attr.flavor == FL_MODULE
|| sym->ns->proc_name->attr.is_main_program))
{
gfc_error ("The module or main program array '%s' at %L must "
"have constant shape", sym->name, &sym->declared_at);
specification_expr = 0;
return FAILURE;
}
}
if (sym->ts.type == BT_CHARACTER)
@ -4907,6 +5004,12 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
return FAILURE;
}
if (e && sym->attr.save && !gfc_is_constant_expr (e))
{
gfc_error (auto_save_msg, sym->name, &sym->declared_at);
return FAILURE;
}
if (!gfc_is_constant_expr (e)
&& !(e->expr_type == EXPR_VARIABLE
&& e->symtree->n.sym->attr.flavor == FL_PARAMETER)
@ -4940,6 +5043,13 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
break;
}
}
/* Also, they must not have the SAVE attribute. */
if (flag && sym->attr.save)
{
gfc_error (auto_save_msg, sym->name, &sym->declared_at);
return FAILURE;
}
}
/* Reject illegal initializers. */
@ -6416,6 +6526,8 @@ resolve_codes (gfc_namespace * ns)
gfc_current_ns = ns;
cs_base = NULL;
/* Set to an out of range value. */
current_entry_id = -1;
resolve_code (ns->code, ns);
}

14
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,17 @@
2006-06-07 Paul Thomas <pault@gcc.gnu.org>
PR fortran/23091
* gfortran.dg/saved_automatic_1.f90: New test.
PR fortran/24168
* gfortran.dg/array_simplify_1.f90: New test.
PR fortran/25090
* gfortran.dg/entry_dummy_ref_1.f90: New test.
PR fortran/25058
* gfortran.dg/entry_dummy_ref_2.f90: New test.
2006-06-06 Mark Mitchell <mark@codesourcery.com>
PR c++/27177

16
gcc/testsuite/gfortran.dg/array_simplify_1.f90 Normal file
View file

@ -0,0 +1,16 @@
! { dg-do compile }
! Tests the fix for PR24168, in which line would return
! Error: Incompatible ranks 2 and 1 in assignment at (1)
! This came about because the simplification of the binary
! operation, in the first actual argument of spread, was not
! returning the rank of the result. Thus the error could
! be generated with any operator and other intrinsics than
! cshift.
!
! Contributed by Steve Kargl <kargl@gcc.gnu.org>
!
integer, parameter :: nx=2, ny=2
real, dimension(nx, ny) :: f
f = spread(2 * cshift((/ 1, 2 /), nx/2), 2, ny)
end

15
gcc/testsuite/gfortran.dg/entry_dummy_ref_1.f90 Normal file
View file

@ -0,0 +1,15 @@
! { dg-do compile }
! Tests fix for PR25090 in which references in specification
! expressions to variables that were not entry formal arguments
! would be missed.
!
! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
!
SUBROUTINE S1(I)
CHARACTER(LEN=I+J) :: a
real :: x(i:j), z
a = "" ! { dg-error "before the ENTRY statement in which it is a parameter" }
x = 0.0 ! { dg-error "before the ENTRY statement in which it is a parameter" }
ENTRY E1(J)
END SUBROUTINE S1
END

20
gcc/testsuite/gfortran.dg/entry_dummy_ref_2.f90 Normal file
View file

@ -0,0 +1,20 @@
! { dg-do compile }
! Tests fix for PR25058 in which references to dummy
! parameters before the entry would be missed.
!
! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
!
MODULE M1
CONTAINS
FUNCTION F1(I) RESULT(RF1)
INTEGER :: I,K,RE1,RF1
RE1=K ! { dg-error "before the ENTRY statement" }
RETURN
ENTRY E1(K) RESULT(RE1)
RE1=-I
RETURN
END FUNCTION F1
END MODULE M1
END
! { dg-final { cleanup-modules "M1" } }

21
gcc/testsuite/gfortran.dg/saved_automatic_1.f90 Normal file
View file

@ -0,0 +1,21 @@
! { dg-do compile }
! Tests patch for PR23091, in which autmatic objects caused
! an ICE if they were given the SAVE attribute.
!
! Contributed by Valera Veryazov <valera.veryazov@teokem.lu.se>
!
Subroutine My(n1)
integer :: myArray(n1)
character(n1) :: ch
save ! OK because only allowed objects are saved globally.
call xxx(myArray, ch)
return
end
Subroutine Thy(n1)
integer, save :: myArray(n1) ! { dg-error "SAVE attribute" }
character(n1), save :: ch ! { dg-error "SAVE attribute" }
call xxx(myArray, ch)
return
end