OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Fortran: fix simplification of TRANSFER for zero-sized character array result

Browse Source 
gcc/fortran/ChangeLog:

	PR fortran/104127
	* simplify.cc (gfc_simplify_transfer): Ensure that the result
	typespec is set up for TRANSFER with MOLD of type CHARACTER
	including character length even if the result is a zero-sized
	array.

gcc/testsuite/ChangeLog:

	PR fortran/104127
	* gfortran.dg/transfer_simplify_11.f90: Fix logic.
	* gfortran.dg/transfer_simplify_13.f90: New test.
This commit is contained in:
Harald Anlauf 2022-01-20 22:36:50 +01:00
parent 0f4f9c0085
commit 6c1a93102b
3 changed files with 47 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
gcc/fortran/simplify.cc
View File

@ -8162,7 +8162,18 @@ gfc_simplify_transfer (gfc_expr *source, gfc_expr *mold, gfc_expr *size)
set even for array expressions, in order to pass this information into
gfc_target_interpret_expr. */
if (result->ts.type == BT_CHARACTER && gfc_is_constant_expr (mold_element))
result->value.character.length = mold_element->value.character.length;
{
result->value.character.length = mold_element->value.character.length;
/* Let the typespec of the result inherit the string length.
This is crucial if a resulting array has size zero. */
if (mold_element->ts.u.cl->length)
result->ts.u.cl->length = gfc_copy_expr (mold_element->ts.u.cl->length);
else
result->ts.u.cl->length =
gfc_get_int_expr (gfc_charlen_int_kind, NULL,
mold_element->value.character.length);
}
/* Set the number of elements in the result, and determine its size. */

2
gcc/testsuite/gfortran.dg/transfer_simplify_11.f90
View File

@ -4,5 +4,5 @@
integer, parameter :: N = 2
character(len=1) :: chr(N)
chr = transfer(repeat("x",ncopies=N),[character(len=1) ::], N)
if (chr(1) /= 'x' .and. chr(2) /= 'x') STOP 1
if (chr(1) /= 'x' .or. chr(2) /= 'x') STOP 1
end

34
gcc/testsuite/gfortran.dg/transfer_simplify_13.f90 Normal file
View File

@ -0,0 +1,34 @@
! { dg-do compile }
! { dg-options "-fdump-tree-original" }
! PR fortran/104127 - ICE in get_array_charlen
! Contributed by G.Steinmetz
program p
character(4) :: mold = "XYZ"
integer :: i = 0
integer, parameter :: l1 = len (transfer('ab', 'xyz', size=0))
integer, parameter :: s1 = size (transfer('ab', 'xyz', size=0))
integer, parameter :: l4 = len (transfer(4_'abcd', 4_'xy', size=0))
integer, parameter :: s4 = size (transfer(4_'abcd', 4_'xy', size=0))
integer, parameter :: l2 = len (transfer('ab', mold, size=0))
integer, parameter :: l3 = len (transfer('ab', mold, size=1))
integer, parameter :: l5 = len (transfer('ab',['xyz'], size=0))
integer, parameter :: s5 = size (transfer('ab',['xyz'], size=0))
call sub0 ( transfer('a', 'y', size=0) )
call sub1 ([transfer('a', 'y', size=0)])
call sub2 ([transfer('a',['y'],size=0)])
call sub3 ( transfer('a', 'y', size=1) )
call sub4 ([transfer('a', 'y', size=1)])
call sub5 ( transfer('a', 'y', size=i) )
call sub6 ( transfer(1_'abcd', 1_'xy' , size=0))
call sub7 ( transfer(1_'abcd',[1_'xy'], size=0))
call sub8 ( transfer(4_'abcd', 4_'xy' , size=0))
call sub9 ( transfer(4_'abcd',[4_'xy'], size=0))
print *, transfer('abcd', 'xy', size=0)
if (l1 /= 3 .or. s1 /= 0) stop 1
if (l4 /= 2 .or. s4 /= 0) stop 2
if (l2 /= 4 .or. l3 /= 4) stop 3
if (l5 /= 3 .or. s5 /= 0) stop 4
end
! { dg-final { scan-tree-dump-not "_gfortran_stop_numeric" "original" } }