Hi all,
attached patch fixes a 12-regression when an assignment to a pointer array is
done. The issue was a missing indirect ref on assign as it was already done for
allocatable arrays.
Regtests ok on x86_64-pc-linux-gnu / F41. Ok for mainline?
Regards,
Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
From 27ca62555c4b09349ab33f806b386b485dfe7c8a Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <[email protected]>
Date: Tue, 4 Mar 2025 12:56:20 +0100
Subject: [PATCH] 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.
---
gcc/fortran/trans-expr.cc | 16 +++++++-------
gcc/testsuite/gfortran.dg/assign_12.f90 | 28 +++++++++++++++++++++++++
2 files changed, 36 insertions(+), 8 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/assign_12.f90
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 0d790b63f95..fbe7333fd71 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -12876,14 +12876,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;
assoc_assign = is_assoc_assign (expr1, expr2);
diff --git a/gcc/testsuite/gfortran.dg/assign_12.f90 b/gcc/testsuite/gfortran.dg/assign_12.f90
new file mode 100644
index 00000000000..be31021f24c
--- /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 <[email protected]>
+
+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
--
2.48.1
