[patch, RFC. Fortran] Some clobbering for INTENT(OUT) arrays

[Thomas Koenig <tkoenig@netcologne.de>]

[-- Attachment #1: Type: text/plain, Size: 1339 bytes --]


Hi,

following Mikael's recent patch series, here is a first idea
of what extending clobbering to arrays wold look like.

The attached patch works for a subset of cases, for example

program main
   implicit none
   interface
     subroutine foo(a)
       integer, intent(out) :: a(*)
     end subroutine foo
   end interface
   integer, dimension(10) :: a
   call foo(a)
end program main

and

program main
   implicit none
   interface
     subroutine foo(a)
       integer, intent(out) :: a(:)
     end subroutine foo
   end interface
   integer, dimension(10) :: a
   a(1) = 32
   a(2) = 32
   call foo(a)
end program main

but it does not cover cases like an assumed-size array
being handed down to an INTENT(OUT) argument.

What happens if the

+                     if (!sym->attr.allocatable && !sym->attr.pointer
+                         && !POINTER_TYPE_P (TREE_TYPE 
(sym->backend_decl)))


part is taken out is that the whole descriptor can be clobbered in
such a case, which is of course not what is wanted.

I am a bit stuck of how to generate a reference to the first element
of the array (really, just dereferencing the data pointer)
in the most elegant way.  I am currently leaning towards
building a gfc_expr, which should work, but would be less
than elegant.

So, anything more elegant at hand?

Best regards

	Thomas

[-- Attachment #2: p1.diff --]
[-- Type: text/x-patch, Size: 2482 bytes --]

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 4f3ae82d39c..bbb00f90a77 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -43,6 +43,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "gimplify.h"
 #include "tm.h"		/* For CHAR_TYPE_SIZE.  */
 
+#include "debug.h"
 
 /* Calculate the number of characters in a string.  */
 
@@ -5981,7 +5982,6 @@ post_call:
     gfc_add_block_to_block (&parmse->post, &block);
 }
 
-
 /* Generate code for a procedure call.  Note can return se->post != NULL.
    If se->direct_byref is set then se->expr contains the return parameter.
    Return nonzero, if the call has alternate specifiers.
@@ -6099,6 +6099,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
     {
       bool finalized = false;
       tree derived_array = NULL_TREE;
+      tree clobber_array = NULL_TREE;
 
       e = arg->expr;
       fsym = formal ? formal->sym : NULL;
@@ -6896,10 +6897,23 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 					     fsym->attr.pointer);
 		}
 	      else
-		/* This is where we introduce a temporary to store the
-		   result of a non-lvalue array expression.  */
-		gfc_conv_array_parameter (&parmse, e, nodesc_arg, fsym,
-					  sym->name, NULL);
+		{
+		  /* This is where we introduce a temporary to store the
+		     result of a non-lvalue array expression.  */
+		  gfc_conv_array_parameter (&parmse, e, nodesc_arg, fsym,
+					    sym->name, NULL);
+		  if (fsym && fsym->attr.intent == INTENT_OUT
+		      && gfc_full_array_ref_p (e->ref, NULL))
+		    {
+		      gfc_symbol *sym = e->symtree->n.sym;
+		      if (!sym->attr.allocatable && !sym->attr.pointer
+			  && !POINTER_TYPE_P (TREE_TYPE (sym->backend_decl)))
+			clobber_array
+			  = gfc_build_array_ref (e->symtree->n.sym->backend_decl,
+						 build_int_cst (size_type_node, 0),
+						 NULL_TREE, true, NULL_TREE);
+		    }
+		}
 
 	      /* If an ALLOCATABLE dummy argument has INTENT(OUT) and is
 		 allocated on entry, it must be deallocated.
@@ -6952,6 +6966,13 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 				       tmp, build_empty_stmt (input_location));
 		  gfc_add_expr_to_block (&se->pre, tmp);
 		}
+
+	      if (clobber_array != NULL_TREE)
+		{
+		  tree clobber;
+		  clobber = build_clobber (TREE_TYPE(clobber_array));
+		  gfc_add_modify (&clobbers, clobber_array, clobber);
+		}
 	    }
 	}
       /* Special case for an assumed-rank dummy argument. */