This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[gfortran, PR33689] Fix fallout form patch for PR20851
- From: Tobias Schlüter <tobias dot schlueter at physik dot uni-muenchen dot de>
- To: Fortran List <fortran at gcc dot gnu dot org>, gcc-patches <gcc-patches at gcc dot gnu dot org>
- Date: Mon, 08 Oct 2007 22:25:01 +0200
- Subject: [gfortran, PR33689] Fix fallout form patch for PR20851
Hi,
this patch fixes an issue introduced by my fix for PR20851. As you may
remember, I was talking about side-effects and double-error messages
there. I had reordered the code to call less often
is_non_constant_shape_array(), which resolves array bounds, so there now
arose a new situation, where an array bound was not resolved where it
should have been. This patch fixes this.
The patch itself is trivial, it replaces a scan of the various bounds
with a call to is_non_constant_shape_array(). Since this clarified the
code somewhat, I was able to understand more of the logic, so I decided
to combine this patch with a minor simplification of the part that
checks if the variable under consideration may be initialized.
Built and tested on i386-darwin. Ok?
Cheers,
- Tobi
2007-10-08 Tobias Schlüter <tobi@gcc.gnu.org>
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.
diff -r 6e2e5bfb3732 gcc/fortran/resolve.c
--- a/gcc/fortran/resolve.c Sun Oct 07 18:40:02 2007 +0000
+++ b/gcc/fortran/resolve.c Mon Oct 08 21:59:48 2007 +0200
@@ -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
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
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
/* 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 @@ static try
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, in
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)
- {
- /* 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;
- }
- }
+ || sym->attr.intrinsic || sym->attr.result)
+ no_init_flag = 1;
+ else if (sym->attr.dimension && !sym->attr.pointer
+ && is_non_constant_shape_array (sym))
+ {
+ 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, in
}
/* 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, in
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, in
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;
}
diff -r 6e2e5bfb3732 gcc/testsuite/gfortran.dg/spec_expr_5.f90
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/testsuite/gfortran.dg/spec_expr_5.f90 Mon Oct 08 21:59:48 2007 +0200
@@ -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