diff options
| author | Andre Vehreschild <vehre@gcc.gnu.org> | 2025-03-04 12:56:20 +0100 |
|---|---|---|
| committer | Andre Vehreschild <vehre@gcc.gnu.org> | 2025-03-04 16:14:15 +0100 |
| commit | 04909c7ecc023874c3444b85f88c60b7b7cc7778 (patch) | |
| tree | 00c62911d340a0862ba1d611fd222174e3813206 | |
| parent | c84be624e079cd748df93a3dc0b5168865fefee9 (diff) | |
| download | gcc-04909c7ecc023874c3444b85f88c60b7b7cc7778.zip gcc-04909c7ecc023874c3444b85f88c60b7b7cc7778.tar.gz gcc-04909c7ecc023874c3444b85f88c60b7b7cc7778.tar.bz2 | |
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.
| -rw-r--r-- | gcc/fortran/trans-expr.cc | 16 | ||||
| -rw-r--r-- | 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 0d790b6..fbe7333 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 0000000..be31021 --- /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 <gscfq@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 |