Commit 9de88093 by Tobias Schlüter

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

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
parent d98f312c
2007-10-08 Tobias Schlter <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> 2007-10-07 Thomas Koenig <tkoenig@gcc.gnu.org>
PR libfortran/33683 PR libfortran/33683
......
...@@ -4138,7 +4138,7 @@ gfc_resolve_expr (gfc_expr *e) ...@@ -4138,7 +4138,7 @@ gfc_resolve_expr (gfc_expr *e)
} }
if (e->ts.type == BT_CHARACTER && e->ts.cl == NULL && e->ref 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); gfc_resolve_substring_charlen (e);
break; break;
...@@ -6891,7 +6891,7 @@ resolve_fl_var_and_proc (gfc_symbol *sym, int mp_flag) ...@@ -6891,7 +6891,7 @@ resolve_fl_var_and_proc (gfc_symbol *sym, int mp_flag)
type. To be called from resolve_fl_variable. */ type. To be called from resolve_fl_variable. */
static try 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); gcc_assert (sym->ts.type == BT_DERIVED);
...@@ -6924,7 +6924,7 @@ resolve_fl_variable_derived (gfc_symbol *sym, int flag) ...@@ -6924,7 +6924,7 @@ resolve_fl_variable_derived (gfc_symbol *sym, int flag)
The check for initializers is performed with The check for initializers is performed with
has_default_initializer because gfc_default_initializer generates has_default_initializer because gfc_default_initializer generates
a hidden default for allocatable components. */ 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->proc_name->attr.flavor == FL_MODULE
&& !sym->ns->save_all && !sym->attr.save && !sym->ns->save_all && !sym->attr.save
&& !sym->attr.pointer && !sym->attr.allocatable && !sym->attr.pointer && !sym->attr.allocatable
...@@ -6938,7 +6938,7 @@ resolve_fl_variable_derived (gfc_symbol *sym, int flag) ...@@ -6938,7 +6938,7 @@ resolve_fl_variable_derived (gfc_symbol *sym, int flag)
/* Assign default initializer. */ /* Assign default initializer. */
if (!(sym->value || sym->attr.pointer || sym->attr.allocatable) 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); sym->value = gfc_default_initializer (&sym->ts);
} }
...@@ -6952,12 +6952,11 @@ resolve_fl_variable_derived (gfc_symbol *sym, int flag) ...@@ -6952,12 +6952,11 @@ resolve_fl_variable_derived (gfc_symbol *sym, int flag)
static try static try
resolve_fl_variable (gfc_symbol *sym, int mp_flag) resolve_fl_variable (gfc_symbol *sym, int mp_flag)
{ {
int flag; int no_init_flag, automatic_flag;
int i;
gfc_expr *e; gfc_expr *e;
const char *auto_save_msg; 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"; "SAVE attribute";
if (resolve_fl_var_and_proc (sym, mp_flag) == FAILURE) if (resolve_fl_var_and_proc (sym, mp_flag) == FAILURE)
...@@ -7019,29 +7018,19 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag) ...@@ -7019,29 +7018,19 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
if (sym->value == NULL && sym->attr.referenced) if (sym->value == NULL && sym->attr.referenced)
apply_default_init_local (sym); /* Try to apply a default initialization. */ apply_default_init_local (sym); /* Try to apply a default initialization. */
/* Can the symbol have an initializer? */ /* Determine if the symbol may not have an initializer. */
flag = 0; no_init_flag = automatic_flag = 0;
if (sym->attr.allocatable || sym->attr.external || sym->attr.dummy if (sym->attr.allocatable || sym->attr.external || sym->attr.dummy
|| sym->attr.intrinsic || sym->attr.result) || sym->attr.intrinsic || sym->attr.result)
flag = 1; no_init_flag = 1;
else if (sym->attr.dimension && !sym->attr.pointer) else if (sym->attr.dimension && !sym->attr.pointer
&& is_non_constant_shape_array (sym))
{ {
/* Don't allow initialization of automatic arrays. */ no_init_flag = automatic_flag = 1;
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;
}
}
/* Also, they must not have the SAVE attribute. /* Also, they must not have the SAVE attribute.
SAVE_IMPLICIT is checked below. */ 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); gfc_error (auto_save_msg, sym->name, &sym->declared_at);
return FAILURE; return FAILURE;
...@@ -7049,7 +7038,7 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag) ...@@ -7049,7 +7038,7 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
} }
/* Reject illegal initializers. */ /* Reject illegal initializers. */
if (!sym->mark && sym->value && flag) if (!sym->mark && sym->value)
{ {
if (sym->attr.allocatable) if (sym->attr.allocatable)
gfc_error ("Allocatable '%s' at %L cannot have an initializer", gfc_error ("Allocatable '%s' at %L cannot have an initializer",
...@@ -7067,7 +7056,7 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag) ...@@ -7067,7 +7056,7 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
else if (sym->attr.result) else if (sym->attr.result)
gfc_error ("Function result '%s' at %L cannot have an initializer", gfc_error ("Function result '%s' at %L cannot have an initializer",
sym->name, &sym->declared_at); sym->name, &sym->declared_at);
else if (flag == 2) else if (automatic_flag)
gfc_error ("Automatic array '%s' at %L cannot have an initializer", gfc_error ("Automatic array '%s' at %L cannot have an initializer",
sym->name, &sym->declared_at); sym->name, &sym->declared_at);
else else
...@@ -7077,7 +7066,7 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag) ...@@ -7077,7 +7066,7 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
no_init_error: no_init_error:
if (sym->ts.type == BT_DERIVED) if (sym->ts.type == BT_DERIVED)
return resolve_fl_variable_derived (sym, flag); return resolve_fl_variable_derived (sym, no_init_flag);
return SUCCESS; return SUCCESS;
} }
......
2007-10-08 Tobias Schlter <tobi@gcc.gnu.org>
PR fortran/33689
* gfortran.dg/spec_expr_5.f90: New.
2007-10-08 Geoffrey Keating <geoffk@apple.com> 2007-10-08 Geoffrey Keating <geoffk@apple.com>
* gcc.dg/pragma-darwin-2.c: New. * gcc.dg/pragma-darwin-2.c: New.
! { 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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment