From: Mikael Morin <mik...@gcc.gnu.org> 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