aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHarald Anlauf <anlauf@gmx.de>2024-06-03 22:02:06 +0200
committerHarald Anlauf <anlauf@gmx.de>2024-06-04 19:15:38 +0200
commit7f21aee0d4ef95eee7d9f7f42e9a056715836648 (patch)
treef3b9e15c14f6baa2e4e9e890d5ddd29e4819cb96
parent54e5cbcd82e36f5aa8205b56880821eea25701ae (diff)
downloadgcc-7f21aee0d4ef95eee7d9f7f42e9a056715836648.zip
gcc-7f21aee0d4ef95eee7d9f7f42e9a056715836648.tar.gz
gcc-7f21aee0d4ef95eee7d9f7f42e9a056715836648.tar.bz2
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.
-rw-r--r--gcc/fortran/trans-stmt.cc3
-rw-r--r--gcc/testsuite/gfortran.dg/allocate_with_source_32.f9033
2 files changed, 35 insertions, 1 deletions
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 9b497d6..93b633e 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 0000000..4a9bd46
--- /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