[patch, fortran] Fix PR 93956, wrong pointer when returned via function

[Thomas Koenig via Gcc-patches]

Hello world,

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.

Regression-tested. OK for trunk, gcc 9 and gcc8 (all are affected)?

Regards

        Thomas

2020-04-21  Thomas Koenig  <tkoe...@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-21  Thomas Koenig  <tkoe...@gcc.gnu.org>

        PR fortran/93956
        * gfortran.dg/pointer_assign_13.f90: New test.

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index a9fa03ad153..618c98a592d 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -4242,8 +4242,11 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr 
*rvalue,
   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 ba1c8bc322e..58b7abf31e9 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -3788,6 +3788,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
@@ -3968,6 +3998,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;
 }