[gcc r13-9734] Fortran: Fix gimplification error on assignment to pointer [PR103391]

[Paul Thomas via Gcc-cvs]

https://gcc.gnu.org/g:6c1684e124fc527c5ffd7dc4e829b07b8e307fbb

commit r13-9734-g6c1684e124fc527c5ffd7dc4e829b07b8e307fbb
Author: Andre Vehreschild <ve...@gcc.gnu.org>
Date:   Tue Mar 4 12:56:20 2025 +0100

    Fortran: Fix gimplification error on assignment to pointer [PR103391]
    
            PR fortran/103391
    
    gcc/fortran/ChangeLog:
    
            * trans-expr.cc (gfc_trans_assignment_1): Do not use poly assign
            for pointer arrays on lhs (as it is done for allocatables
            already).
    
    gcc/testsuite/ChangeLog:
    
            * gfortran.dg/assign_12.f90: New test.
    
    (cherry picked from commit 04909c7ecc023874c3444b85f88c60b7b7cc7778)

Diff:
---
 gcc/fortran/trans-expr.cc               | 16 ++++++++--------
 gcc/testsuite/gfortran.dg/assign_12.f90 | 28 ++++++++++++++++++++++++++++
 2 files changed, 36 insertions(+), 8 deletions(-)

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 6a4fd1bd27b3..1a8c1e25b61c 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -11917,14 +11917,14 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * 
expr2, bool init_flag,
      needed.  */
   lhs_attr = gfc_expr_attr (expr1);
 
-  is_poly_assign = (use_vptr_copy || lhs_attr.pointer
-                   || (lhs_attr.allocatable && !lhs_attr.dimension))
-                  && (expr1->ts.type == BT_CLASS
-                      || gfc_is_class_array_ref (expr1, NULL)
-                      || gfc_is_class_scalar_expr (expr1)
-                      || gfc_is_class_array_ref (expr2, NULL)
-                      || gfc_is_class_scalar_expr (expr2))
-                  && lhs_attr.flavor != FL_PROCEDURE;
+  is_poly_assign
+    = (use_vptr_copy
+       || ((lhs_attr.pointer || lhs_attr.allocatable) && !lhs_attr.dimension))
+      && (expr1->ts.type == BT_CLASS || gfc_is_class_array_ref (expr1, NULL)
+         || gfc_is_class_scalar_expr (expr1)
+         || gfc_is_class_array_ref (expr2, NULL)
+         || gfc_is_class_scalar_expr (expr2))
+      && lhs_attr.flavor != FL_PROCEDURE;
 
   realloc_flag = flag_realloc_lhs
                 && gfc_is_reallocatable_lhs (expr1)
diff --git a/gcc/testsuite/gfortran.dg/assign_12.f90 
b/gcc/testsuite/gfortran.dg/assign_12.f90
new file mode 100644
index 000000000000..be31021f24c6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assign_12.f90
@@ -0,0 +1,28 @@
+!{ dg-do run }
+!
+! Check assignment works for derived types to memory referenced by pointer
+! Contributed by G. Steinmetz  <gs...@t-online.de>
+
+program pr103391
+   type t
+     character(1) :: c
+   end type
+   type t2
+      type(t), pointer :: a(:)
+   end type
+
+   type(t), target :: arr(2)
+   type(t2) :: r
+
+   arr = [t('a'), t('b')]
+
+   r = f([arr])
+   if (any(r%a(:)%c /= ['a', 'b'])) stop 1
+contains
+   function f(x)
+      class(t), intent(in), target :: x(:)
+      type(t2) :: f
+      allocate(f%a(size(x,1)))
+      f%a = x
+   end
+end