Fortran: fix issues with internal conversion between default and wide char

gcc/fortran/ChangeLog:

	PR fortran/104128
	* expr.cc (gfc_copy_expr): Convert internal representation of
	string to wide char in value only for default character kind.
	* target-memory.cc (interpret_array): Pass flag for conversion of
	wide chars.
	(gfc_target_interpret_expr): Likewise.

gcc/testsuite/ChangeLog:

	PR fortran/104128
	* gfortran.dg/transfer_simplify_14.f90: New test.
This commit is contained in:
Harald Anlauf 2022-01-23 21:55:33 +01:00
parent fd59d5d4a2
commit b51fb28ed2
3 changed files with 33 additions and 4 deletions

View File

@ -312,7 +312,8 @@ gfc_copy_expr (gfc_expr *p)
break;
case BT_CHARACTER:
if (p->representation.string)
if (p->representation.string
&& p->ts.kind == gfc_default_character_kind)
q->value.character.string
= gfc_char_to_widechar (q->representation.string);
else

View File

@ -365,7 +365,8 @@ gfc_target_encode_expr (gfc_expr *source, unsigned char *buffer,
static size_t
interpret_array (unsigned char *buffer, size_t buffer_size, gfc_expr *result)
interpret_array (unsigned char *buffer, size_t buffer_size, gfc_expr *result,
bool convert_widechar)
{
gfc_constructor_base base = NULL;
size_t array_size = 1;
@ -390,7 +391,7 @@ interpret_array (unsigned char *buffer, size_t buffer_size, gfc_expr *result)
gfc_constructor_append_expr (&base, e, &result->where);
ptr += gfc_target_interpret_expr (&buffer[ptr], buffer_size - ptr, e,
true);
convert_widechar);
}
result->value.constructor = base;
@ -580,7 +581,7 @@ gfc_target_interpret_expr (unsigned char *buffer, size_t buffer_size,
gfc_expr *result, bool convert_widechar)
{
if (result->expr_type == EXPR_ARRAY)
return interpret_array (buffer, buffer_size, result);
return interpret_array (buffer, buffer_size, result, convert_widechar);
switch (result->ts.type)
{

View File

@ -0,0 +1,27 @@
! { dg-do compile }
! { dg-options "-fdump-tree-original" }
! PR fortran/104128 - ICE in gfc_widechar_to_char
! Contributed by G.Steinmetz
program p
implicit none
integer, parameter :: k = 4
character(*), parameter :: a = 'abc'
character(*,kind=4), parameter :: b = 'abc'
character(2,kind=k), parameter :: s = k_"FG"
character(*,kind=1), parameter :: x = transfer (s, 'abcdefgh')
character(2,kind=k), parameter :: t = transfer (x, s)
character(2,kind=k) :: u = transfer (x, s)
logical, parameter :: l = (s == t)
print *, transfer (a , 4_'xy', size=2)
print *, transfer ('xyz', [b], size=2)
print *, s
print *, t
print *, u
if (.not. l) stop 1
if (t /= s) stop 2
if (u /= s) stop 3 ! not optimized away
end
! { dg-final { scan-tree-dump-times "_gfortran_stop_numeric" 1 "original" } }
! { dg-final { scan-tree-dump "_gfortran_stop_numeric \\(3, 0\\);" "original" } }