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
Thomasdiff --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. */
