From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 2071) id A1FC23858C83; Sun, 23 Apr 2023 18:53:22 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org A1FC23858C83 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1682276002; bh=l9lL+i9ybq+zk6akNuJ6svRNBhqhBgl9RHuDxbV5h0U=; h=From:To:Subject:Date:From; b=hAw/w0u05JutRF2QtPmscffW2HOewrGVn8sH3+TRZMX9ghYxx0GdJqYJOXvPSMmvI 9bhowpyebSnYZ+FK81vBsC2DUCgOVk7UW3CwVYt6X7JzH4Bjx77Ls8DPw18Iq0/C4X YMruVit+uHQWlOzizsLottlGaNUE/81x1fUNXFt4= 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-9466] Fortran: handle zero-sized arrays in ctors with typespec [PR108010] X-Act-Checkin: gcc X-Git-Author: Harald Anlauf X-Git-Refname: refs/heads/releases/gcc-12 X-Git-Oldrev: 928374f8d5160b229702fa5e6016d72943915578 X-Git-Newrev: 767d85d69f3d3f718f2a294f8e03be3a8aa65c4b Message-Id: <20230423185322.A1FC23858C83@sourceware.org> Date: Sun, 23 Apr 2023 18:53:22 +0000 (GMT) List-Id: https://gcc.gnu.org/g:767d85d69f3d3f718f2a294f8e03be3a8aa65c4b commit r12-9466-g767d85d69f3d3f718f2a294f8e03be3a8aa65c4b Author: Harald Anlauf Date: Wed Dec 7 21:50:23 2022 +0100 Fortran: handle zero-sized arrays in ctors with typespec [PR108010] gcc/fortran/ChangeLog: PR fortran/108010 * arith.cc (reduce_unary): Handle zero-sized arrays. (reduce_binary_aa): Likewise. gcc/testsuite/ChangeLog: PR fortran/108010 * gfortran.dg/pr108010.f90: New test. (cherry picked from commit 7d6512d102a5a4fb3939de95bce38d154512a19f) Diff: --- gcc/fortran/arith.cc | 24 ++++++++++++--- gcc/testsuite/gfortran.dg/pr108010.f90 | 54 ++++++++++++++++++++++++++++++++++ 2 files changed, 74 insertions(+), 4 deletions(-) diff --git a/gcc/fortran/arith.cc b/gcc/fortran/arith.cc index d57059a375f..1e521cc0cc5 100644 --- a/gcc/fortran/arith.cc +++ b/gcc/fortran/arith.cc @@ -1281,8 +1281,16 @@ reduce_unary (arith (*eval) (gfc_expr *, gfc_expr **), gfc_expr *op, else { gfc_constructor *c = gfc_constructor_first (head); - r = gfc_get_array_expr (c->expr->ts.type, c->expr->ts.kind, - &op->where); + if (c == NULL) + { + /* Handle zero-sized arrays. */ + r = gfc_get_array_expr (op->ts.type, op->ts.kind, &op->where); + } + else + { + r = gfc_get_array_expr (c->expr->ts.type, c->expr->ts.kind, + &op->where); + } r->shape = gfc_copy_shape (op->shape, op->rank); r->rank = op->rank; r->value.constructor = head; @@ -1435,8 +1443,16 @@ reduce_binary_aa (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); + if (c == NULL) + { + /* Handle zero-sized arrays. */ + r = gfc_get_array_expr (op1->ts.type, op1->ts.kind, &op1->where); + } + else + { + r = gfc_get_array_expr (c->expr->ts.type, c->expr->ts.kind, + &op1->where); + } r->shape = gfc_copy_shape (op1->shape, op1->rank); r->rank = op1->rank; r->value.constructor = head; diff --git a/gcc/testsuite/gfortran.dg/pr108010.f90 b/gcc/testsuite/gfortran.dg/pr108010.f90 new file mode 100644 index 00000000000..303b2b98220 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr108010.f90 @@ -0,0 +1,54 @@ +! { dg-do run } +! PR fortran/108010 - ICE in reduce_unary, reduce_binary_aa +! Contributed by G.Steinmetz + +program p + implicit none + print *, + [integer :: [real ::]] + print *, - [integer :: [real ::]] + print *, 1 + [integer :: [real ::]] + print *, 1 - [integer :: [real ::]] + print *, 2 * [integer :: [real ::]] + print *, - [real :: [real ::], 2] + print *, + [integer :: [real ::], 2] + print *, - [integer :: [real ::], 2] + print *, 1 + [integer :: [real ::], 2] + print *, 1 - [integer :: [real ::], 2] + print *, 2 * [integer :: [real ::], 2] + print *, [integer :: [real ::]] + [integer :: [real ::]] + print *, [integer :: [real ::]] - [integer :: [real ::]] + print *, [integer :: [real ::]] * [integer :: [real ::]] + print *, [integer :: [real ::], 2] + [real :: [real ::], 3] + print *, [integer :: [real ::], 2] - [real :: [real ::], 3] + print *, [integer :: [real ::], 2] * [real :: [real ::], 3] + + ! Validate type of resulting arrays + if (.not. is_int ([integer :: [real ::]] )) stop 1 + if (.not. is_int ([integer :: [real ::]] + [integer :: [real ::]])) stop 2 + if (.not. is_real([real :: [integer ::]] )) stop 3 + if (.not. is_real([real :: [integer ::]] + [real :: [integer ::]])) stop 4 + if (.not. is_real([real :: [integer ::]] + [integer :: [real ::]])) stop 5 + if (.not. is_real([integer :: [real ::]] + [real :: [integer ::]])) stop 6 + +contains + + logical function is_int (x) + class(*) :: x(:) + select type (x) + type is (integer) + is_int = .true. + class default + is_int = .false. + end select + end function is_int + + logical function is_real (x) + class(*) :: x(:) + select type (x) + type is (real) + is_real = .true. + class default + is_real = .false. + end select + end function is_real +end