Hi All,

This patch is rather simple in principle and is adequately explained
by the comment in the patch and the ChangeLog.

Regtested and checked with valgrind on FC42/x86_64. OK for mainline?

Paul
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index f25335d6bdb..0e82d2a4e9a 100644
--- 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
index 00000000000..20b97b0b1eb
--- /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  <[email protected]>
+!
+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

Attachment: Change.Logs
Description: Binary data

Reply via email to