[gcc(refs/vendors/redhat/heads/gcc-8-branch)] Fix PR 93956, wrong pointer when returned via function.

[gcc(refs/vendors/redhat/heads/gcc-8-branch)] Fix PR 93956, wrong pointer when returned via function.

[Jakub Jelinek]

https://gcc.gnu.org/g:3db4d50143513806087a15b225f8c108f08af539

commit 3db4d50143513806087a15b225f8c108f08af539
Author: Thomas König <tkoenig@gcc.gnu.org>
Date:   Fri Apr 24 09:26:48 2020 +0200

    Fix PR 93956, wrong pointer when returned via function.
    
    Backport from trunk.
    
    This one took a bit of detective work.  When array pointers point
    to components of derived types, we currently set the span field
    and then create an array temporary when we pass the array
    pointer to a procedure as a non-pointer or non-target argument.
    (This is inefficient, but that's for another release).
    
    Now, the compiler detected this case when there was a direct assignment
    like p => a%b, but not when p was returned either as a function result
    or via an argument.  This patch fixes that.
    
    2020-04-24  Thomas Koenig  <tkoenig@gcc.gnu.org>
    
            PR fortran/93956
            * expr.c (gfc_check_pointer_assign): Also set subref_array_pointer
            when a function returns a pointer.
            * interface.c (gfc_set_subref_array_pointer_arg): New function.
            (gfc_procedure_use): Call it.
    
    2020-04-24  Thomas Koenig  <tkoenig@gcc.gnu.org>
    
            PR fortran/93956
            * gfortran.dg/pointer_assign_13.f90: New test.

Diff:
---
 gcc/fortran/ChangeLog                           |  9 +++++
 gcc/fortran/expr.c                              |  7 ++--
 gcc/fortran/interface.c                         | 34 ++++++++++++++++++
 gcc/testsuite/ChangeLog                         |  6 ++++
 gcc/testsuite/gfortran.dg/pointer_assign_13.f90 | 47 +++++++++++++++++++++++++
 5 files changed, 101 insertions(+), 2 deletions(-)

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 9104f16a847..4b4c1d8e886 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2020-04-24  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	Backport from trunk.
+	PR fortran/93956
+	* expr.c (gfc_check_pointer_assign): Also set subref_array_pointer
+	when a function returns a pointer.
+	* interface.c (gfc_set_subref_array_pointer_arg): New function.
+	(gfc_procedure_use): Call it.
+
 2020-04-14  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	Backport from trunk.
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index f145e9b363b..5348f1bf4ce 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -3895,8 +3895,11 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue, bool is_init_expr)
   if (rvalue->expr_type == EXPR_NULL)
     return true;
 
-  if (rvalue->expr_type == EXPR_VARIABLE && is_subref_array (rvalue))
-    lvalue->symtree->n.sym->attr.subref_array_pointer = 1;
+  /* A function may also return subref arrray pointer.  */
+
+  if ((rvalue->expr_type == EXPR_VARIABLE && is_subref_array (rvalue))
+      || rvalue->expr_type == EXPR_FUNCTION)
+      lvalue->symtree->n.sym->attr.subref_array_pointer = 1;
 
   attr = gfc_expr_attr (rvalue);
 
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 04850b0406c..26837d7c1fa 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -3619,6 +3619,36 @@ check_intents (gfc_formal_arglist *f, gfc_actual_arglist *a)
   return true;
 }
 
+/* Go through the argument list of a procedure and look for
+   pointers which may be set, possibly introducing a span.  */
+
+static void
+gfc_set_subref_array_pointer_arg (gfc_formal_arglist *dummy_args,
+				  gfc_actual_arglist *actual_args)
+{
+  gfc_formal_arglist *f;
+  gfc_actual_arglist *a;
+  gfc_symbol *a_sym;
+  for (f = dummy_args, a = actual_args; f && a ; f = f->next, a = a->next)
+    {
+
+      if (f->sym == NULL)
+	continue;
+
+      if (!f->sym->attr.pointer || f->sym->attr.intent == INTENT_IN)
+	continue;
+
+      if (a->expr == NULL || a->expr->expr_type != EXPR_VARIABLE)
+	continue;
+      a_sym = a->expr->symtree->n.sym;
+
+      if (!a_sym->attr.pointer)
+	continue;
+
+      a_sym->attr.subref_array_pointer = 1;
+    }
+  return;
+}
 
 /* Check how a procedure is used against its interface.  If all goes
    well, the actual argument list will also end up being properly
@@ -3765,6 +3795,10 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where)
   if (warn_aliasing)
     check_some_aliasing (dummy_args, *ap);
 
+  /* Set the subref_array_pointer_arg if needed.  */
+  if (dummy_args)
+    gfc_set_subref_array_pointer_arg (dummy_args, *ap);
+
   return true;
 }
 
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 8b743e20743..ab81335d25d 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2020-04-24  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	Backport from trunk
+	PR fortran/93956
+	* gfortran.dg/pointer_assign_13.f90: New test.
+
 2020-04-16  Andre Vieira  <andre.simoesdiasvieira@arm.com>
 
 	Backport from mainline
diff --git a/gcc/testsuite/gfortran.dg/pointer_assign_13.f90 b/gcc/testsuite/gfortran.dg/pointer_assign_13.f90
new file mode 100644
index 00000000000..b3f2cd9dab7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_assign_13.f90
@@ -0,0 +1,47 @@
+! { dg-do run }
+! PR 93956 - span was set incorrectly, leading to wrong code.
+! Original test case by "martin".
+program array_temps
+  implicit none
+  
+  type :: tt
+     integer :: u = 1
+     integer :: v = 2
+  end type tt
+
+  type(tt), dimension(:), pointer :: r
+  integer :: n
+  integer, dimension(:), pointer :: p, q, u
+
+  n = 10
+  allocate(r(1:n))
+  call foo(r%v,n)
+  p => get(r(:))
+  call foo(p, n)
+  call get2(r,u)
+  call foo(u,n)
+  q => r%v
+  call foo(q, n)
+
+deallocate(r)
+
+contains
+
+   subroutine foo(a, n)
+      integer, dimension(:), intent(in) :: a
+      integer, intent(in) :: n
+      if (sum(a(1:n)) /= 2*n) stop 1
+   end subroutine foo
+
+   function get(x) result(q)
+      type(tt), dimension(:), target, intent(in) :: x
+      integer, dimension(:), pointer :: q
+      q => x(:)%v
+   end function get
+
+   subroutine get2(x,q)
+      type(tt), dimension(:), target, intent(in) :: x
+      integer, dimension(:), pointer, intent(out) :: q
+      q => x(:)%v
+    end subroutine get2
+end program array_temps