Fortran: Fix ICE due to PDT selector expression in ASSOCIATE [PR95541]

2025-10-27  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran
	PR fortran/922290
	* resolve.cc (resolve_typebound_intrinsic_op): Add pdt_template
	to the list of preemted specifics.

	PR fortran/95541
	* trans-stmt.cc (trans_associate_var): PDT array and string
	components are separately allocated for each element of a PDT
	array, so copy in and copy out the selector expression.

gcc/testsuite/
	PR fortran/95541
	* gfortran.dg/pdt_61.f03: New test.

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 0d5444848f0211acdcef1035f9416e689029c450..117a51c7e9a321f20b890326e4fb7644712e4c5c 100644 (file)
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -16083,7 +16083,8 @@ resolve_typebound_intrinsic_op (gfc_symbol* derived, gfc_intrinsic_op op,
          for (intr = derived->ns->op[op]; intr; intr = intr->next)
            if (intr->sym == target_proc
                && (target_proc->attr.used_in_submodule
-                   || derived->attr.pdt_type))
+                   || derived->attr.pdt_type
+                   || derived->attr.pdt_template))
              return true;
 
          if (!gfc_check_new_interface (derived->ns->op[op],

diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index f25335d6bdbdde71f2e1a98d2926fff69a05b8a5..0e82d2a4e9acb916d1499e4bc10dd5d1ce6a3f8d 100644 (file)
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -2092,6 +2092,22 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
       gfc_free_expr (expr1);
       gfc_free_expr (expr2);
     }
+  /* PDT array and string components are separately allocated for each element
+     of a PDT array. Therefore, there is no choice but to copy in and copy out
+     the target expression.  */
+  else if (e && is_subref_array (e)
+          && (gfc_expr_attr (e).pdt_array || gfc_expr_attr (e).pdt_string))
+    {
+      gfc_se init;
+      gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (sym->backend_decl)));
+      gfc_init_se (&init, NULL);
+      gfc_conv_subref_array_arg (&init, e, false, INTENT_INOUT,
+                                sym && sym->attr.pointer);
+      init.expr = build_fold_indirect_ref_loc (input_location, init.expr);
+      gfc_add_modify (&init.pre, sym->backend_decl, init.expr);
+      gfc_add_init_cleanup (block, gfc_finish_block (&init.pre),
+                           gfc_finish_block (&init.post));
+    }
   else if ((sym->attr.dimension || sym->attr.codimension) && !class_target
           && (sym->as->type == AS_DEFERRED || sym->assoc->variable))
     {

diff --git a/gcc/testsuite/gfortran.dg/pdt_61.f03 b/gcc/testsuite/gfortran.dg/pdt_61.f03
new file mode 100644 (file)
index 0000000..20b97b0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pdt_61.f03
@@ -0,0 +1,35 @@
+! { dg-do run }
+!
+! Test the fix for PR95541, in which parameterized array and string components
+! of PDT arrays caused an ICE in the ASSOCIATE selector expressions below.
+!
+! Contributed by Gerhard Steinmetz  <gscfq@t-online.de>
+!
+program p
+   type t(n)
+      integer, len :: n
+      integer :: a(n)
+      character(len = n) :: chr
+   end type
+   type(t(3)) :: x(2)
+   integer :: tgt(2)
+   x(1)%a = [1, 2, 3]
+   x(1)%chr = "abc"
+   x(2)%a = [4, 5, 6]
+   x(2)%chr = "def"
+   associate (y => x(:)%a(3))
+      if (any (y /= [3,6]))          stop 1
+      y = -y
+   end associate
+   associate (y => x%a(3))
+      if (any (y /= [-3,-6]))        stop 2
+      y = -y * 10
+   end associate
+   if (any (x%a(3) /= [30,60]))      stop 3
+   if (any (x%a(2) /= [2,5]))        stop 4
+   associate (y => x%chr(2:2))
+      if (any (y /= ["b","e"]))      stop 5
+      y = ["x", "y"]
+   end associate
+   if (any (x%chr /= ["axc","dyf"])) stop 6
+end