diff mbox series

Fortran: fix ALLOCATE with SOURCE=, zero-length character [PR83865]

Message ID trinity-6c5615b1-2a6a-476e-8586-dcd5abf56d25-1717445528946@3c-app-gmx-bap34
State New
Headers show
Series Fortran: fix ALLOCATE with SOURCE=, zero-length character [PR83865] | expand

Commit Message

Harald Anlauf June 3, 2024, 8:12 p.m. UTC 
Dear all,

the attached simple patch fixes an ICE for ALLOCATE with SOURCE=
of a deferred-length character array with source-expression
being an array of character with length zero.  The reason was
that the array descriptor of the source-expression was discarded
in the special case of length 0.

Solution: restrict special case to rank 0.

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

The offending code was introduced during 7-development,
so it is technically a regression.  I would therefore
like to backport after waiting for a week or two.

Thanks,
Harald

Comments

Jerry D June 3, 2024, 11:59 p.m. UTC | #1 
On 6/3/24 1:12 PM, Harald Anlauf wrote:
> Dear all,
> 
> the attached simple patch fixes an ICE for ALLOCATE with SOURCE=
> of a deferred-length character array with source-expression
> being an array of character with length zero.  The reason was
> that the array descriptor of the source-expression was discarded
> in the special case of length 0.
> 
> Solution: restrict special case to rank 0.
> 
> Regtested on x86_64-pc-linux-gnu.  OK for mainline?
> 
> The offending code was introduced during 7-development,
> so it is technically a regression.  I would therefore
> like to backport after waiting for a week or two.
> 
> Thanks,
> Harald

OK and thanks for patch.

Jerry
diff mbox series

Patch

From ae5e3654d30d17584cfcfc3bbcc48cf75cb7453c Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Mon, 3 Jun 2024 22:02:06 +0200
Subject: [PATCH] Fortran: fix ALLOCATE with SOURCE=, zero-length character
 [PR83865]

gcc/fortran/ChangeLog:

	PR fortran/83865
	* trans-stmt.cc (gfc_trans_allocate): Restrict special case for
	source-expression with zero-length character to rank 0, so that
	the array shape is not discarded.

gcc/testsuite/ChangeLog:

	PR fortran/83865
	* gfortran.dg/allocate_with_source_32.f90: New test.
---
 gcc/fortran/trans-stmt.cc                     |  3 +-
 .../gfortran.dg/allocate_with_source_32.f90   | 33 +++++++++++++++++++
 2 files changed, 35 insertions(+), 1 deletion(-)
 create mode 100644 gcc/testsuite/gfortran.dg/allocate_with_source_32.f90

diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 9b497d6bdc6..93b633e212e 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -6449,8 +6449,9 @@  gfc_trans_allocate (gfc_code * code, gfc_omp_namelist *omp_allocate)
       else
 	gfc_add_block_to_block (&post, &se.post);

-      /* Special case when string in expr3 is zero.  */
+      /* Special case when string in expr3 is scalar and has length zero.  */
       if (code->expr3->ts.type == BT_CHARACTER
+	  && code->expr3->rank == 0
 	  && integer_zerop (se.string_length))
 	{
 	  gfc_init_se (&se, NULL);
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_32.f90 b/gcc/testsuite/gfortran.dg/allocate_with_source_32.f90
new file mode 100644
index 00000000000..4a9bd46da4d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_source_32.f90
@@ -0,0 +1,33 @@ 
+! { dg-do run }
+!
+! PR fortran/83865
+!
+! Test ALLOCATE with SOURCE= of deferred length character, where
+! the source-expression is an array of character with length 0.
+
+program p
+  implicit none
+  character(:), allocatable :: z(:)
+  character(1) :: cc(4) = ""
+  allocate (z, source=[''])
+  if (len (z) /= 0 .or. size (z) /= 1) stop 1
+  deallocate (z)
+  allocate (z, source=['',''])
+  if (len (z) /= 0 .or. size (z) /= 2) stop 2
+  deallocate (z)
+  allocate (z, source=[ character(0) :: 'a','b','c'])
+  if (len (z) /= 0 .or. size (z) /= 3) stop 3
+  deallocate (z)
+  allocate (z, source=[ character(0) :: cc ])
+  if (len (z) /= 0 .or. size (z) /= 4) stop 4
+  deallocate (z)
+  associate (x => f())
+    if (len (x) /= 0 .or. size (x) /= 1) stop 5
+    if (x(1) /= '') stop 6
+  end associate
+contains
+  function f() result(z)
+    character(:), allocatable :: z(:)
+    allocate (z, source=[''])
+  end function f
+end
--
2.35.3