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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@129139 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 0f5758a..85cb819 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/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

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 61be64f..2686c3d 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/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;
 }

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index d4d0ad9..17060ee 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/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.

diff --git a/gcc/testsuite/gfortran.dg/spec_expr_5.f90 b/gcc/testsuite/gfortran.dg/spec_expr_5.f90
new file mode 100644 (file)
index 0000000..8190383
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/spec_expr_5.f90
@@ -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