From c5a8e22c5dacf4f9d4f66e60990bf34c70f04714 Mon Sep 17 00:00:00 2001
From: Tobias Burnus <tburnus@baylibre.com>
Date: Thu, 16 Jan 2025 11:50:26 +0100
Subject: [PATCH] Fortran: Create fresh ts.u.cl for result in
 gfc_get_symbol_for_expr [PR118441]

For intrinsic routines, called in libraries, the prototype is created from
the call via gfc_get_symbol_for_expr. For the actual arguments, it calls
gfc_copy_formal_args_intr which already ensures that the ts.u.cl is freshly
allocated.

This commit now ensures the same for character-returning functions.

	PR fortran/118441

gcc/fortran/ChangeLog:

	* trans-intrinsic.cc (gfc_get_symbol_for_expr): Use
	gfc_new_charlen for character-returning functions.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/intrinsic_pack_7.f90: New test.
---
 gcc/fortran/trans-intrinsic.cc                      | 2 ++
 gcc/testsuite/gfortran.dg/gomp/intrinsic_pack_7.f90 | 9 +++++++++
 2 files changed, 11 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/gomp/intrinsic_pack_7.f90

diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index cc3a2e5fc105..afbec5b27522 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -4242,6 +4242,8 @@ gfc_get_symbol_for_expr (gfc_expr * expr, bool ignore_optional)
   sym = gfc_new_symbol (expr->value.function.name, NULL);
 
   sym->ts = expr->ts;
+  if (sym->ts.type == BT_CHARACTER)
+    sym->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);
   sym->attr.external = 1;
   sym->attr.function = 1;
   sym->attr.always_explicit = 1;
diff --git a/gcc/testsuite/gfortran.dg/gomp/intrinsic_pack_7.f90 b/gcc/testsuite/gfortran.dg/gomp/intrinsic_pack_7.f90
new file mode 100644
index 000000000000..576a89940922
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/intrinsic_pack_7.f90
@@ -0,0 +1,9 @@
+! PR fortran/118441
+
+subroutine sub(s)
+  character(len=*), intent(inout) :: s(:)
+  integer :: n
+  s( : ) =       s(:)                     ! OK
+  n      = count(s(:) /= '')
+  s(1:n) = pack (s(:), mask=(s(:) /= '')) ! ICE
+end subroutine sub
-- 
GitLab