FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
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.

(cherry picked from commit 7f21aee0d4ef95eee7d9f7f42e9a056715836648)
This commit is contained in:
Harald Anlauf 2024-06-03 22:02:06 +02:00
parent 96f9b06822
commit c3e16edcf2
2 changed files with 35 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
gcc/fortran/trans-stmt.cc
View file

@ -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);

33
gcc/testsuite/gfortran.dg/allocate_with_source_32.f90 Normal file
View file

@ -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