mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-24 19:21:12 +08:00
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/33689 ([Regression 4.3] Array with constant bound rejected as automatic array)

Browse Source 
PR fortran/33689
fortran/
* resolve.c (gfc_resolve_expr): Fix indentation.
(resolve_fl_variable_derived): Rename argument.
(resolve_fl_variable): Fix case in message.  Clarify logic.
Correctly simplify array bounds.
testsuite/
* gfortran.dg/spec_expr_5.f90: New.

From-SVN: r129139
This commit is contained in:
Tobias Schlüter 2007-10-08 22:54:47 +02:00
parent d98f312ce6
commit 9de88093b6
4 changed files with 38 additions and 28 deletions
gcc
fortran
ChangeLogresolve.c
testsuite
ChangeLog
gfortran.dg
spec_expr_5.f90

8
gcc/fortran/ChangeLog

@ -1,3 +1,11 @@
2007-10-08 Tobias Schlüter <tobi@gcc.gnu.org>
PR fortran/33689
* resolve.c (gfc_resolve_expr): Fix indentation.
(resolve_fl_variable_derived): Rename argument.
(resolve_fl_variable): Fix case in message. Clarify logic.
Correctly simplify array bounds.
2007-10-07 Thomas Koenig <tkoenig@gcc.gnu.org>
PR libfortran/33683

45
gcc/fortran/resolve.c

@ -4138,7 +4138,7 @@ gfc_resolve_expr (gfc_expr *e)
}
if (e->ts.type == BT_CHARACTER && e->ts.cl == NULL && e->ref
&& e->ref->type != REF_SUBSTRING)
&& e->ref->type != REF_SUBSTRING)
gfc_resolve_substring_charlen (e);
break;
@ -6891,7 +6891,7 @@ resolve_fl_var_and_proc (gfc_symbol *sym, int mp_flag)
type. To be called from resolve_fl_variable. */
static try
resolve_fl_variable_derived (gfc_symbol *sym, int flag)
resolve_fl_variable_derived (gfc_symbol *sym, int no_init_flag)
{
gcc_assert (sym->ts.type == BT_DERIVED);
@ -6924,7 +6924,7 @@ resolve_fl_variable_derived (gfc_symbol *sym, int flag)
The check for initializers is performed with
has_default_initializer because gfc_default_initializer generates
a hidden default for allocatable components. */
if (!(sym->value || flag) && sym->ns->proc_name
if (!(sym->value || no_init_flag) && sym->ns->proc_name
&& sym->ns->proc_name->attr.flavor == FL_MODULE
&& !sym->ns->save_all && !sym->attr.save
&& !sym->attr.pointer && !sym->attr.allocatable
@ -6938,7 +6938,7 @@ resolve_fl_variable_derived (gfc_symbol *sym, int flag)
/* Assign default initializer. */
if (!(sym->value || sym->attr.pointer || sym->attr.allocatable)
&& (!flag || sym->attr.intent == INTENT_OUT))
&& (!no_init_flag || sym->attr.intent == INTENT_OUT))
{
sym->value = gfc_default_initializer (&sym->ts);
}
@ -6952,12 +6952,11 @@ resolve_fl_variable_derived (gfc_symbol *sym, int flag)
static try
resolve_fl_variable (gfc_symbol *sym, int mp_flag)
{
int flag;
int i;
int no_init_flag, automatic_flag;
gfc_expr *e;
const char *auto_save_msg;
auto_save_msg = "automatic object '%s' at %L cannot have the "
auto_save_msg = "Automatic object '%s' at %L cannot have the "
"SAVE attribute";
if (resolve_fl_var_and_proc (sym, mp_flag) == FAILURE)
@ -7019,29 +7018,19 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
if (sym->value == NULL && sym->attr.referenced)
apply_default_init_local (sym); /* Try to apply a default initialization. */
/* Can the symbol have an initializer? */
flag = 0;
/* Determine if the symbol may not have an initializer. */
no_init_flag = automatic_flag = 0;
if (sym->attr.allocatable || sym->attr.external || sym->attr.dummy
|| sym->attr.intrinsic || sym->attr.result)
flag = 1;
else if (sym->attr.dimension && !sym->attr.pointer)
|| sym->attr.intrinsic || sym->attr.result)
no_init_flag = 1;
else if (sym->attr.dimension && !sym->attr.pointer
&& is_non_constant_shape_array (sym))
{
/* Don't allow initialization of automatic arrays. */
for (i = 0; i < sym->as->rank; i++)
{
if (sym->as->lower[i] == NULL
|| sym->as->lower[i]->expr_type != EXPR_CONSTANT
|| sym->as->upper[i] == NULL
|| sym->as->upper[i]->expr_type != EXPR_CONSTANT)
{
flag = 2;
break;
}
}
no_init_flag = automatic_flag = 1;
/* Also, they must not have the SAVE attribute.
SAVE_IMPLICIT is checked below. */
if (flag && sym->attr.save == SAVE_EXPLICIT)
if (sym->attr.save == SAVE_EXPLICIT)
{
gfc_error (auto_save_msg, sym->name, &sym->declared_at);
return FAILURE;
@ -7049,7 +7038,7 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
}
/* Reject illegal initializers. */
if (!sym->mark && sym->value && flag)
if (!sym->mark && sym->value)
{
if (sym->attr.allocatable)
gfc_error ("Allocatable '%s' at %L cannot have an initializer",
@ -7067,7 +7056,7 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
else if (sym->attr.result)
gfc_error ("Function result '%s' at %L cannot have an initializer",
sym->name, &sym->declared_at);
else if (flag == 2)
else if (automatic_flag)
gfc_error ("Automatic array '%s' at %L cannot have an initializer",
sym->name, &sym->declared_at);
else
@ -7077,7 +7066,7 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
no_init_error:
if (sym->ts.type == BT_DERIVED)
return resolve_fl_variable_derived (sym, flag);
return resolve_fl_variable_derived (sym, no_init_flag);
return SUCCESS;
}

5
gcc/testsuite/ChangeLog

@ -1,3 +1,8 @@
2007-10-08 Tobias Schlüter <tobi@gcc.gnu.org>
PR fortran/33689
* gfortran.dg/spec_expr_5.f90: New.
2007-10-08 Geoffrey Keating <geoffk@apple.com>
* gcc.dg/pragma-darwin-2.c: New.

8
gcc/testsuite/gfortran.dg/spec_expr_5.f90 Normal file

@ -0,0 +1,8 @@
! { dg-do compile }
! PR 33689
! Wrongly rejected valid code due to non-trivial expression for array bound
subroutine grylmr()
integer, parameter :: lmaxd = 20
REAL, save :: c(0:(lmaxd+1)*(lmaxd+1))
end subroutine grylmr
end