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 --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 2dd093673ebf61607e0189f1abf81ced1a217517..69952b33eaa8090d646376fb25db4fa97dacc441 100644 (file)
--- 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 (file)
index 0000000..9282283
--- /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