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

Reply via email to