diff options
author | Harald Anlauf <anlauf@gmx.de> | 2024-06-03 22:02:06 +0200 |
---|---|---|
committer | Harald Anlauf <anlauf@gmx.de> | 2024-06-04 19:15:38 +0200 |
commit | 7f21aee0d4ef95eee7d9f7f42e9a056715836648 (patch) | |
tree | f3b9e15c14f6baa2e4e9e890d5ddd29e4819cb96 | |
parent | 54e5cbcd82e36f5aa8205b56880821eea25701ae (diff) | |
download | gcc-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.cc | 3 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/allocate_with_source_32.f90 | 33 |
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 |