From: Mikael Morin <[email protected]>
In this case the isolated field write causes wrong code.
Regression-tested on x86_64-pc-linux-gnu.
OK for master?
-- >8 --
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.
---
gcc/fortran/trans-expr.cc | 5 ----
.../gfortran.dg/pointer_assign_16.f90 | 25 +++++++++++++++++++
2 files changed, 25 insertions(+), 5 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/pointer_assign_16.f90
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index ec240844a5e..e1a53643ef5 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -11148,11 +11148,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 00000000000..9282283df49
--- /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
--
2.47.2
