TeamHeptaMirrors/gcc
1
0
Fork 1
mirror of https://github.com/gcc-mirror/gcc.git synced 2026-05-06 23:14:49 +02:00
Code Issues Packages Projects Releases Wiki Activity

fortran: Fix character SPREAD intrinsic lowering [PR109788]

Browse Source 
Copy the SPREAD intrinsic descriptor before specializing the character
formal argument type so other uses keep the generic signature.

	PR fortran/109788

gcc/fortran/ChangeLog:

	* iresolve.cc (copy_intrinsic_sym): New helper.
	(gfc_resolve_spread): Copy the intrinsic descriptor before
	specializing the character formal argument type.

gcc/testsuite/ChangeLog:

	* gfortran.dg/pr109788.f90: New test.

Signed-off-by: Christopher Albert <albert@tugraz.at>
This commit is contained in:
Christopher Albert
2026-03-28 16:57:02 +01:00
committed by Paul Thomas
parent 5cc0ead362
commit ebc8ed3246
2 changed files with 34 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files

25
gcc/fortran/iresolve.cc
View File

@@ -103,6 +103,25 @@ check_charlen_present (gfc_expr *source)
}
}
static gfc_intrinsic_sym *
copy_intrinsic_sym (const gfc_intrinsic_sym *src)
{
gfc_intrinsic_sym *copy = XCNEW (gfc_intrinsic_sym);
gfc_intrinsic_arg *head = NULL;
gfc_intrinsic_arg **tail = &head;
*copy = *src;
for (const gfc_intrinsic_arg *arg = src->formal; arg; arg = arg->next)
{
*tail = XCNEW (gfc_intrinsic_arg);
**tail = *arg;
(*tail)->next = NULL;
tail = &(*tail)->next;
}
copy->formal = head;
return copy;
}
/* Helper function for resolving the "mask" argument. */
static void
@@ -2958,7 +2977,11 @@ gfc_resolve_spread (gfc_expr *f, gfc_expr *source, gfc_expr *dim,
gfc_resolve_substring_charlen (source);
if (source->ts.type == BT_CHARACTER)
check_charlen_present (source);
{
check_charlen_present (source);
f->value.function.isym = copy_intrinsic_sym (f->value.function.isym);
f->value.function.isym->formal->ts = source->ts;
}
f->ts = source->ts;
f->rank = source->rank + 1;

10
gcc/testsuite/gfortran.dg/pr109788.f90 Normal file
View File

@@ -0,0 +1,10 @@
! { dg-do compile }
! { dg-options "-Os -fdump-tree-original-raw" }
! { dg-final { scan-tree-dump {(?s)identifier_node strg: _gfortran_spread_char_scalar.*?function_type.*?prms: @[0-9]+.*?tree_list[^\n]*chan: @[0-9]+.*?tree_list[^\n]*chan: @[0-9]+.*?tree_list[^\n]*chan: @[0-9]+.*?tree_list[^\n]*chan: @[0-9]+.*?tree_list[^\n]*chan: @[0-9]+.*?tree_list[^\n]*chan: @8} "original" } }
character(3) :: a = 'abc'
associate (y => spread(trim(a), 1, 2) // 'd')
if (size(y) /= 2) stop 1
end associate
end