diff options
author | fxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4> | 2007-09-20 21:58:23 +0000 |
---|---|---|
committer | fxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4> | 2007-09-20 21:58:23 +0000 |
commit | f321262a0fa5f45378dd29188f67439d90c279c0 (patch) | |
tree | fe0494cb3b16d6bdc2d81609a958aedec1998bc4 /gcc | |
parent | 029dbf299ef5c5bf66df9c595e955a55bd6204cc (diff) | |
download | gcc-f321262a0fa5f45378dd29188f67439d90c279c0.tar.gz |
PR fortran/33288
* arith.c (reduce_unary, reduce_binary_ac, reduce_binary_ca,
reduce_binary_aa): Call ourselves recursively if an element of
the constructor is itself a constant array.
* gfortran.dg/array_constructor_19.f90: New test.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@128632 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/fortran/ChangeLog | 7 | ||||
-rw-r--r-- | gcc/fortran/arith.c | 22 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/array_constructor_19.f90 | 17 |
4 files changed, 47 insertions, 4 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 9e7ca3a389e..f3a65cd086b 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2007-09-20 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> + + PR fortran/33288 + * arith.c (reduce_unary, reduce_binary_ac, reduce_binary_ca, + reduce_binary_aa): Call ourselves recursively if an element of + the constructor is itself a constant array. + 2007-09-20 Tobias Schlüter <tobi@gcc.gnu.org> * io.c (resolve_tag_format): New function using code split out diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c index f95f5e7f763..149f93f08e1 100644 --- a/gcc/fortran/arith.c +++ b/gcc/fortran/arith.c @@ -1288,7 +1288,8 @@ reduce_unary (arith (*eval) (gfc_expr *, gfc_expr **), gfc_expr *op, for (c = head; c; c = c->next) { - rc = eval (c->expr, &r); + rc = reduce_unary (eval, c->expr, &r); + if (rc != ARITH_OK) break; @@ -1328,7 +1329,11 @@ reduce_binary_ac (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **), for (c = head; c; c = c->next) { - rc = eval (c->expr, op2, &r); + if (c->expr->expr_type == EXPR_CONSTANT) + rc = eval (c->expr, op2, &r); + else + rc = reduce_binary_ac (eval, c->expr, op2, &r); + if (rc != ARITH_OK) break; @@ -1368,7 +1373,11 @@ reduce_binary_ca (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **), for (c = head; c; c = c->next) { - rc = eval (op1, c->expr, &r); + if (c->expr->expr_type == EXPR_CONSTANT) + rc = eval (op1, c->expr, &r); + else + rc = reduce_binary_ca (eval, op1, c->expr, &r); + if (rc != ARITH_OK) break; @@ -1395,6 +1404,11 @@ reduce_binary_ca (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **), } +/* We need a forward declaration of reduce_binary. */ +static arith reduce_binary (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **), + gfc_expr *op1, gfc_expr *op2, gfc_expr **result); + + static arith reduce_binary_aa (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **), gfc_expr *op1, gfc_expr *op2, gfc_expr **result) @@ -1421,7 +1435,7 @@ reduce_binary_aa (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **), break; } - rc = eval (c->expr, d->expr, &r); + rc = reduce_binary (eval, c->expr, d->expr, &r); if (rc != ARITH_OK) break; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 9974bc3a0ec..ee10c4cfdcc 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2007-09-20 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> + + PR fortran/33288 + * gfortran.dg/array_constructor_19.f90: New test. + 2007-09-20 Jakub Jelinek <jakub@redhat.com> PR debug/33316 diff --git a/gcc/testsuite/gfortran.dg/array_constructor_19.f90 b/gcc/testsuite/gfortran.dg/array_constructor_19.f90 new file mode 100644 index 00000000000..460a34f5c1b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_constructor_19.f90 @@ -0,0 +1,17 @@ +! Simplification of unary and binary expressions containing +! array constructors. +! +! See PR33288 +! +! { dg-do run } + real, parameter :: x(1) = 42 + real, parameter :: x1(1) = (/ x /) + 1 + real, parameter :: x2(1) = 1 + (/ x /) + real, parameter :: x3(1) = -(/ x /) + real, parameter :: x4(2) = (/ x, 1. /) + (/ 2, (/3/) /) + + if (any (x1 /= (/43./))) call abort + if (any (x2 /= (/43./))) call abort + if (any (x3 /= (/-42./))) call abort + if (any (x4 /= (/44., 4./))) call abort +end |