From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 2071) id 9D61E3858D1E; Wed, 9 Feb 2022 21:16:03 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 9D61E3858D1E MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Harald Anlauf To: gcc-cvs@gcc.gnu.org Subject: [gcc r12-7153] Fortran: try simplifications during reductions of array constructors X-Act-Checkin: gcc X-Git-Author: Harald Anlauf X-Git-Refname: refs/heads/master X-Git-Oldrev: f6ff6738fa25fb012ed208e01de5a84d8668d538 X-Git-Newrev: f3ffea93ef31c03ad8cdcb54e71ec868b57b264f Message-Id: <20220209211603.9D61E3858D1E@sourceware.org> Date: Wed, 9 Feb 2022 21:16:03 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Wed, 09 Feb 2022 21:16:03 -0000 https://gcc.gnu.org/g:f3ffea93ef31c03ad8cdcb54e71ec868b57b264f commit r12-7153-gf3ffea93ef31c03ad8cdcb54e71ec868b57b264f Author: Harald Anlauf Date: Sun Feb 6 21:47:20 2022 +0100 Fortran: try simplifications during reductions of array constructors gcc/fortran/ChangeLog: PR fortran/66193 * arith.cc (reduce_binary_ac): When reducing binary expressions, try simplification. Handle case of empty constructor. (reduce_binary_ca): Likewise. gcc/testsuite/ChangeLog: PR fortran/66193 * gfortran.dg/array_constructor_55.f90: New test. Diff: --- gcc/fortran/arith.cc | 36 +++++++++++--- gcc/testsuite/gfortran.dg/array_constructor_55.f90 | 55 ++++++++++++++++++++++ 2 files changed, 85 insertions(+), 6 deletions(-) diff --git a/gcc/fortran/arith.cc b/gcc/fortran/arith.cc index b3323ecf640..06e032e22db 100644 --- a/gcc/fortran/arith.cc +++ b/gcc/fortran/arith.cc @@ -1305,6 +1305,8 @@ reduce_binary_ac (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **), head = gfc_constructor_copy (op1->value.constructor); for (c = gfc_constructor_first (head); c; c = gfc_constructor_next (c)) { + gfc_simplify_expr (c->expr, 0); + if (c->expr->expr_type == EXPR_CONSTANT) rc = eval (c->expr, op2, &r); else @@ -1321,9 +1323,19 @@ reduce_binary_ac (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **), else { gfc_constructor *c = gfc_constructor_first (head); - r = gfc_get_array_expr (c->expr->ts.type, c->expr->ts.kind, - &op1->where); - r->shape = gfc_copy_shape (op1->shape, op1->rank); + if (c) + { + r = gfc_get_array_expr (c->expr->ts.type, c->expr->ts.kind, + &op1->where); + r->shape = gfc_copy_shape (op1->shape, op1->rank); + } + else + { + gcc_assert (op1->ts.type != BT_UNKNOWN); + r = gfc_get_array_expr (op1->ts.type, op1->ts.kind, + &op1->where); + r->shape = gfc_get_shape (op1->rank); + } r->rank = op1->rank; r->value.constructor = head; *result = r; @@ -1345,6 +1357,8 @@ reduce_binary_ca (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **), head = gfc_constructor_copy (op2->value.constructor); for (c = gfc_constructor_first (head); c; c = gfc_constructor_next (c)) { + gfc_simplify_expr (c->expr, 0); + if (c->expr->expr_type == EXPR_CONSTANT) rc = eval (op1, c->expr, &r); else @@ -1361,9 +1375,19 @@ reduce_binary_ca (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **), else { gfc_constructor *c = gfc_constructor_first (head); - r = gfc_get_array_expr (c->expr->ts.type, c->expr->ts.kind, - &op2->where); - r->shape = gfc_copy_shape (op2->shape, op2->rank); + if (c) + { + r = gfc_get_array_expr (c->expr->ts.type, c->expr->ts.kind, + &op2->where); + r->shape = gfc_copy_shape (op2->shape, op2->rank); + } + else + { + gcc_assert (op2->ts.type != BT_UNKNOWN); + r = gfc_get_array_expr (op2->ts.type, op2->ts.kind, + &op2->where); + r->shape = gfc_get_shape (op2->rank); + } r->rank = op2->rank; r->value.constructor = head; *result = r; diff --git a/gcc/testsuite/gfortran.dg/array_constructor_55.f90 b/gcc/testsuite/gfortran.dg/array_constructor_55.f90 new file mode 100644 index 00000000000..52142cb10c0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_constructor_55.f90 @@ -0,0 +1,55 @@ +! { dg-do run } +! PR fortran/66193 - ICE for initialisation of some non-zero-sized arrays +! Testcase by G.Steinmetz + +program p + implicit none + call s1 + call s2 + call s3 + call s4 +contains + subroutine s1 + integer(8), parameter :: z1(2) = 10 + [ integer(8) :: [ integer(4) ::],1,2] + integer(8) :: z2(2) = 10 + [ integer(8) :: [ integer(4) ::],1,2] + integer(8) :: z3(2) + z3 = 10 + [ integer(8) :: [ integer(4) :: ], 1, 2 ] + if ( z1(1) /= 11 .or. z1(2) /= 12 ) stop 1 + if ( z2(1) /= 11 .or. z2(2) /= 12 ) stop 2 + if ( z3(1) /= 11 .or. z3(2) /= 12 ) stop 3 + end subroutine s1 + + subroutine s2 + logical(8), parameter :: z1(3) = .true. .or. & + [ logical(8) :: [ logical(4) :: ], .false., .false., .true. ] + logical(8) :: z2(3) = .true. .or. & + [ logical(8) :: [ logical(4) :: ], .false., .false., .true. ] + logical(8) :: z3(3) + z3 = .true. .or. & + [ logical(8) :: [ logical(4) :: ], .false., .false., .true. ] + if ( .not. all(z1) ) stop 11 + if ( .not. all(z2) ) stop 12 + if ( .not. all(z3) ) stop 13 + end subroutine s2 + + subroutine s3 + real(8), parameter :: eps = 4.0_8 * epsilon(1.0_8) + real(8), parameter :: z1(2) = 10. + [ real(8) :: [ real(4) :: ], 1., 2. ] + real(8) :: z2(2) = 10. + [ real(8) :: [ real(4) :: ], 1., 2. ] + real(8) :: z3(2) + z3 = 10.0 + [ real(8) :: [ real(4) :: ], 1.0, 2.0 ] + + if ( abs(1-z1(1)/11) > eps ) stop 21 + if ( abs(1-z1(2)/12) > eps ) stop 22 + if ( abs(1-z2(1)/11) > eps ) stop 23 + if ( abs(1-z2(2)/12) > eps ) stop 24 + if ( abs(1-z3(1)/11) > eps ) stop 25 + if ( abs(1-z3(2)/12) > eps ) stop 26 + end subroutine s3 + + subroutine s4 + real, parameter :: x(3) = 2.0 * [real :: 1, (2), 3] + real, parameter :: y(2) = [real :: 1, (2)] + 10.0 + real, parameter :: z(2) = [real ::(1),(2)] + 10.0 + end subroutine s4 +end program p