Commit f2cbd86c by Daniel Franke Committed by Daniel Franke

re PR fortran/35779 (error pointer wrong in PARAMETER)

gcc/fortran/:
2010-05-13  Daniel Franke  <franke.daniel@gmail.com>

        PR fortran/35779
        * intrinsic.c (gfc_init_expr): Renamed to gfc_init_expr_flag.
        Updated all usages.
        * expr.c (init_flag): Removed; use gfc_init_expr_flag everywhere.
        * array.c (match_array_list): Pass on gfc_init_expr_flag when matching
        iterators.

gcc/testsuite/:
2010-05-13  Daniel Franke  <franke.daniel@gmail.com>

        PR fortran/35779
        * gfortran.dg/initialization_25.f90: New.

From-SVN: r159366
parent 917ed773
2010-05-13 Daniel Franke <franke.daniel@gmail.com>
PR fortran/35779
* intrinsic.c (gfc_init_expr): Renamed to gfc_init_expr_flag.
Updated all usages.
* expr.c (init_flag): Removed; use gfc_init_expr_flag everywhere.
* array.c (match_array_list): Pass on gfc_init_expr_flag when matching
iterators.
2010-05-13 Jakub Jelinek <jakub@redhat.com> 2010-05-13 Jakub Jelinek <jakub@redhat.com>
PR fortran/44036 PR fortran/44036
......
...@@ -784,7 +784,6 @@ arith_power (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp) ...@@ -784,7 +784,6 @@ arith_power (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
int power_sign; int power_sign;
gfc_expr *result; gfc_expr *result;
arith rc; arith rc;
extern bool init_flag;
rc = ARITH_OK; rc = ARITH_OK;
result = gfc_get_constant_expr (op1->ts.type, op1->ts.kind, &op1->where); result = gfc_get_constant_expr (op1->ts.type, op1->ts.kind, &op1->where);
...@@ -899,7 +898,7 @@ arith_power (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp) ...@@ -899,7 +898,7 @@ arith_power (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
case BT_REAL: case BT_REAL:
if (init_flag) if (gfc_init_expr_flag)
{ {
if (gfc_notify_std (GFC_STD_F2003,"Fortran 2003: Noninteger " if (gfc_notify_std (GFC_STD_F2003,"Fortran 2003: Noninteger "
"exponent in an initialization " "exponent in an initialization "
...@@ -921,7 +920,7 @@ arith_power (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp) ...@@ -921,7 +920,7 @@ arith_power (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
case BT_COMPLEX: case BT_COMPLEX:
{ {
if (init_flag) if (gfc_init_expr_flag)
{ {
if (gfc_notify_std (GFC_STD_F2003,"Fortran 2003: Noninteger " if (gfc_notify_std (GFC_STD_F2003,"Fortran 2003: Noninteger "
"exponent in an initialization " "exponent in an initialization "
......
...@@ -879,7 +879,7 @@ match_array_list (gfc_constructor_base *result) ...@@ -879,7 +879,7 @@ match_array_list (gfc_constructor_base *result)
for (n = 1;; n++) for (n = 1;; n++)
{ {
m = gfc_match_iterator (&iter, 0); m = gfc_match_iterator (&iter, gfc_init_expr_flag);
if (m == MATCH_YES) if (m == MATCH_YES)
break; break;
if (m == MATCH_ERROR) if (m == MATCH_ERROR)
......
...@@ -1895,7 +1895,7 @@ gfc_simplify_expr (gfc_expr *p, int type) ...@@ -1895,7 +1895,7 @@ gfc_simplify_expr (gfc_expr *p, int type)
/* Only substitute array parameter variables if we are in an /* Only substitute array parameter variables if we are in an
initialization expression, or we want a subsection. */ initialization expression, or we want a subsection. */
if (p->symtree->n.sym->attr.flavor == FL_PARAMETER if (p->symtree->n.sym->attr.flavor == FL_PARAMETER
&& (gfc_init_expr || p->ref && (gfc_init_expr_flag || p->ref
|| p->symtree->n.sym->value->expr_type != EXPR_ARRAY)) || p->symtree->n.sym->value->expr_type != EXPR_ARRAY))
{ {
if (simplify_parameter_variable (p, type) == FAILURE) if (simplify_parameter_variable (p, type) == FAILURE)
...@@ -2626,11 +2626,11 @@ gfc_reduce_init_expr (gfc_expr *expr) ...@@ -2626,11 +2626,11 @@ gfc_reduce_init_expr (gfc_expr *expr)
{ {
gfc_try t; gfc_try t;
gfc_init_expr = 1; gfc_init_expr_flag = true;
t = gfc_resolve_expr (expr); t = gfc_resolve_expr (expr);
if (t == SUCCESS) if (t == SUCCESS)
t = check_init_expr (expr); t = check_init_expr (expr);
gfc_init_expr = 0; gfc_init_expr_flag = false;
if (t == FAILURE) if (t == FAILURE)
return FAILURE; return FAILURE;
...@@ -2648,11 +2648,7 @@ gfc_reduce_init_expr (gfc_expr *expr) ...@@ -2648,11 +2648,7 @@ gfc_reduce_init_expr (gfc_expr *expr)
/* Match an initialization expression. We work by first matching an /* Match an initialization expression. We work by first matching an
expression, then reducing it to a constant. The reducing it to expression, then reducing it to a constant. */
constant part requires a global variable to flag the prohibition
of a non-integer exponent in -std=f95 mode. */
bool init_flag = false;
match match
gfc_match_init_expr (gfc_expr **result) gfc_match_init_expr (gfc_expr **result)
...@@ -2663,12 +2659,12 @@ gfc_match_init_expr (gfc_expr **result) ...@@ -2663,12 +2659,12 @@ gfc_match_init_expr (gfc_expr **result)
expr = NULL; expr = NULL;
init_flag = true; gfc_init_expr_flag = true;
m = gfc_match_expr (&expr); m = gfc_match_expr (&expr);
if (m != MATCH_YES) if (m != MATCH_YES)
{ {
init_flag = false; gfc_init_expr_flag = false;
return m; return m;
} }
...@@ -2676,12 +2672,12 @@ gfc_match_init_expr (gfc_expr **result) ...@@ -2676,12 +2672,12 @@ gfc_match_init_expr (gfc_expr **result)
if (t != SUCCESS) if (t != SUCCESS)
{ {
gfc_free_expr (expr); gfc_free_expr (expr);
init_flag = false; gfc_init_expr_flag = false;
return MATCH_ERROR; return MATCH_ERROR;
} }
*result = expr; *result = expr;
init_flag = false; gfc_init_expr_flag = false;
return MATCH_YES; return MATCH_YES;
} }
......
...@@ -2537,8 +2537,8 @@ void gfc_free_finalizer (gfc_finalizer *el); /* Needed in resolve.c, too */ ...@@ -2537,8 +2537,8 @@ void gfc_free_finalizer (gfc_finalizer *el); /* Needed in resolve.c, too */
gfc_try gfc_check_symbol_typed (gfc_symbol*, gfc_namespace*, bool, locus); gfc_try gfc_check_symbol_typed (gfc_symbol*, gfc_namespace*, bool, locus);
/* intrinsic.c */ /* intrinsic.c -- true if working in an init-expr, false otherwise. */
extern int gfc_init_expr; extern bool gfc_init_expr_flag;
/* Given a symbol that we have decided is intrinsic, mark it as such /* Given a symbol that we have decided is intrinsic, mark it as such
by placing it into a special module that is otherwise impossible to by placing it into a special module that is otherwise impossible to
......
...@@ -30,7 +30,7 @@ along with GCC; see the file COPYING3. If not see ...@@ -30,7 +30,7 @@ along with GCC; see the file COPYING3. If not see
/* Namespace to hold the resolved symbols for intrinsic subroutines. */ /* Namespace to hold the resolved symbols for intrinsic subroutines. */
static gfc_namespace *gfc_intrinsic_namespace; static gfc_namespace *gfc_intrinsic_namespace;
int gfc_init_expr = 0; bool gfc_init_expr_flag = false;
/* Pointers to an intrinsic function and its argument names that are being /* Pointers to an intrinsic function and its argument names that are being
checked. */ checked. */
...@@ -3803,7 +3803,7 @@ gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag) ...@@ -3803,7 +3803,7 @@ gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
if ((isym->id == GFC_ISYM_REAL || isym->id == GFC_ISYM_DBLE if ((isym->id == GFC_ISYM_REAL || isym->id == GFC_ISYM_DBLE
|| isym->id == GFC_ISYM_CMPLX) || isym->id == GFC_ISYM_CMPLX)
&& gfc_init_expr && gfc_init_expr_flag
&& gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Function '%s' " && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Function '%s' "
"as initialization expression at %L", name, "as initialization expression at %L", name,
&expr->where) == FAILURE) &expr->where) == FAILURE)
...@@ -3879,7 +3879,7 @@ got_specific: ...@@ -3879,7 +3879,7 @@ got_specific:
(4) A reference to an elemental standard intrinsic function, (4) A reference to an elemental standard intrinsic function,
where each argument is an initialization expression */ where each argument is an initialization expression */
if (gfc_init_expr && isym->elemental && flag if (gfc_init_expr_flag && isym->elemental && flag
&& gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Elemental function " && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Elemental function "
"as initialization expression with non-integer/non-" "as initialization expression with non-integer/non-"
"character arguments at %L", &expr->where) == FAILURE) "character arguments at %L", &expr->where) == FAILURE)
......
...@@ -5180,7 +5180,7 @@ gfc_simplify_transfer (gfc_expr *source, gfc_expr *mold, gfc_expr *size) ...@@ -5180,7 +5180,7 @@ gfc_simplify_transfer (gfc_expr *source, gfc_expr *mold, gfc_expr *size)
unsigned char *buffer; unsigned char *buffer;
if (!gfc_is_constant_expr (source) if (!gfc_is_constant_expr (source)
|| (gfc_init_expr && !gfc_is_constant_expr (mold)) || (gfc_init_expr_flag && !gfc_is_constant_expr (mold))
|| !gfc_is_constant_expr (size)) || !gfc_is_constant_expr (size))
return NULL; return NULL;
......
2010-05-13 Daniel Franke <franke.daniel@gmail.com>
PR fortran/35779
* gfortran.dg/initialization_25.f90: New.
2010-05-13 Martin Jambor <mjambor@suse.cz> 2010-05-13 Martin Jambor <mjambor@suse.cz>
* g++.dg/otr-fold-1.C: New test. * g++.dg/otr-fold-1.C: New test.
......
! { dg-do "compile" }
!
! PR fortran/35779 - unrelated error message
! Tescase contributed by
! Dick Hendrickson <dick DOT hendrickson AT gmail DOT com>
!
INTEGER :: J1
INTEGER,PARAMETER :: I3(10) = (/(J1,J1=10,1,-1)/)
INTEGER,PARAMETER :: I2(10) = (/(J1,J1=its_bad,1,-1)/) ! { dg-error "does not reduce" }
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