From: Harald Anlauf <anlauf@gmx.de>
To: fortran <fortran@gcc.gnu.org>, gcc-patches <gcc-patches@gcc.gnu.org>
Subject: [PATCH] Fortran: handle zero-sized arrays in ctors with typespec [PR108010]
Date: Wed, 7 Dec 2022 21:57:20 +0100 [thread overview]
Message-ID: <trinity-63117869-4396-41cc-8f80-3f7d4d02e5d6-1670446640941@3c-app-gmx-bs03> (raw)
[-- Attachment #1: Type: text/plain, Size: 291 bytes --]
Dear all,
we need to be careful about zero-sized arrays in arithmetic
reductions (unary & binary), as we otherwise may hit a NULL
pointer dereference on valid code.
The actual fix is straightforward, see attached patch.
Regtested on x86_64-pc-linux-gnu. OK for mainline?
Thanks,
Harald
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: pr108010.diff --]
[-- Type: text/x-patch, Size: 4321 bytes --]
From 02a8b7308d04dc84fb13b077bd3b2fe01e15c92e Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Wed, 7 Dec 2022 21:50:23 +0100
Subject: [PATCH] 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.
---
gcc/fortran/arith.cc | 24 ++++++++++--
gcc/testsuite/gfortran.dg/pr108010.f90 | 54 ++++++++++++++++++++++++++
2 files changed, 74 insertions(+), 4 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/pr108010.f90
diff --git a/gcc/fortran/arith.cc b/gcc/fortran/arith.cc
index c4ab75b401c..c0d12cfad9d 100644
--- a/gcc/fortran/arith.cc
+++ b/gcc/fortran/arith.cc
@@ -1342,8 +1342,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;
@@ -1501,8 +1509,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
--
2.35.3
next reply other threads:[~2022-12-07 20:57 UTC|newest]
Thread overview: 2+ messages / expand[flat|nested] mbox.gz Atom feed top
2022-12-07 20:57 Harald Anlauf [this message]
2022-12-07 21:50 ` Steve Kargl
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=trinity-63117869-4396-41cc-8f80-3f7d4d02e5d6-1670446640941@3c-app-gmx-bs03 \
--to=anlauf@gmx.de \
--cc=fortran@gcc.gnu.org \
--cc=gcc-patches@gcc.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).