https://gcc.gnu.org/g:d358dc6f331c58bb5f0046dd1e04fc100775c5e8
commit r16-3016-gd358dc6f331c58bb5f0046dd1e04fc100775c5e8
Author: Mikael Morin <morin-mik...@orange.fr>
Date: Tue Aug 5 14:57:58 2025 +0200
fortran: Remove span overwrite with pointer assignments
Remove an overwrite of the array descriptor span field when pointer-
assigning from a polymorphic function result to a non-polymorphic
pointer. That overwrite doesn't make sense because the span is
determined by the memory layout of the array; we can't change it
without also changing the data pointer.
gcc/fortran/ChangeLog:
* trans-expr.cc (gfc_trans_pointer_assignment): Remove overwrite
of the span after assignment of the array descriptor in the
polymorphic function result to non-polymorphic pointer case.
gcc/testsuite/ChangeLog:
* gfortran.dg/pointer_assign_16.f90: New test.
Diff:
---
gcc/fortran/trans-expr.cc | 5 -----
gcc/testsuite/gfortran.dg/pointer_assign_16.f90 | 25 +++++++++++++++++++++++++
2 files changed, 25 insertions(+), 5 deletions(-)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 2dd093673ebf..69952b33eaa8 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -11146,11 +11146,6 @@ gfc_trans_pointer_assignment (gfc_expr * expr1,
gfc_expr * expr2)
{
rse.expr = gfc_class_data_get (rse.expr);
gfc_add_modify (&lse.pre, desc, rse.expr);
- /* Set the lhs span. */
- tmp = TREE_TYPE (rse.expr);
- tmp = TYPE_SIZE_UNIT (gfc_get_element_type (tmp));
- tmp = fold_convert (gfc_array_index_type, tmp);
- gfc_conv_descriptor_span_set (&lse.pre, desc, tmp);
}
else
{
diff --git a/gcc/testsuite/gfortran.dg/pointer_assign_16.f90
b/gcc/testsuite/gfortran.dg/pointer_assign_16.f90
new file mode 100644
index 000000000000..9282283df491
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_assign_16.f90
@@ -0,0 +1,25 @@
+! { dg-do run }
+!
+! Check the span of the descriptor of an array pointer after it has been
+! assigned to from a polymorphic function result.
+
+program test
+ implicit none
+ type t
+ integer :: c
+ end type t
+ type, extends(t) :: u
+ integer :: d
+ end type u
+ type(t), pointer :: p(:)
+ class(t), allocatable, target :: a(:)
+ p => f()
+ ! print *, p%c
+ if (any(p%c /= [2,5,11,17,23])) error stop 1
+contains
+ function f()
+ class(t), pointer :: f(:)
+ a = [ u(2,3), u(5,7), u(11,13), u(17,19), u(23,29) ]
+ f => a
+ end function
+end program
