From 9de88093b6e322a53b20ea23560ca3cd753120ec Mon Sep 17 00:00:00 2001 From: =?utf8?q?Tobias=20Schl=C3=BCter?= Date: Mon, 8 Oct 2007 22:54:47 +0200 Subject: [PATCH] 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 --- gcc/fortran/ChangeLog | 8 ++++ gcc/fortran/resolve.c | 45 +++++++++-------------- gcc/testsuite/ChangeLog | 5 +++ gcc/testsuite/gfortran.dg/spec_expr_5.f90 | 8 ++++ 4 files changed, 38 insertions(+), 28 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/spec_expr_5.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 0f5758a135b..85cb8194db2 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2007-10-08 Tobias Schlüter + + 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 PR libfortran/33683 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 61be64f26f9..2686c3dac82 100644 --- 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 d4d0ad9c36a..17060ee1f99 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2007-10-08 Tobias Schlüter + + PR fortran/33689 + * gfortran.dg/spec_expr_5.f90: New. + 2007-10-08 Geoffrey Keating * 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 index 00000000000..819038348c2 --- /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 -- 2.30.2