diff mbox series

Fortran: handle zero-sized arrays in ctors with typespec [PR108010]

Message ID trinity-63117869-4396-41cc-8f80-3f7d4d02e5d6-1670446640941@3c-app-gmx-bs03
State New
Headers
Series Fortran: handle zero-sized arrays in ctors with typespec [PR108010] |

Commit Message

Harald Anlauf Dec. 7, 2022, 8:57 p.m. UTC 
  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

Comments

Li, Pan2 via Gcc-patches Dec. 7, 2022, 9:50 p.m. UTC | #1 
On Wed, Dec 07, 2022 at 09:57:20PM +0100, Harald Anlauf via Fortran wrote:
> 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?
> 

Yes.  Thanks for the patch.
diff mbox series

Patch

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