gfc_charlen cl;
gfc_expr *e;
gfc_symbol *fsym;
- stmtblock_t post;
enum {MISSING = 0, ELEMENTAL, SCALAR, SCALAR_POINTER, ARRAY};
gfc_component *comp = NULL;
int arglen;
else
info = NULL;
+ stmtblock_t post, clobbers;
gfc_init_block (&post);
+ gfc_init_block (&clobbers);
gfc_init_interface_mapping (&mapping);
if (!comp)
{
var = build_fold_indirect_ref_loc (input_location,
parmse.expr);
tree clobber = build_clobber (TREE_TYPE (var));
- gfc_add_modify (&se->pre, var, clobber);
+ gfc_add_modify (&clobbers, var, clobber);
}
}
/* Catch base objects that are not variables. */
vec_safe_push (arglist, parmse.expr);
}
+ gfc_add_block_to_block (&se->pre, &clobbers);
gfc_finish_interface_mapping (&mapping, &se->pre, &se->post);
if (comp)
--- /dev/null
+! { dg-do run }
+! { dg-additional-options "-fdump-tree-original" }
+! { dg-final { scan-tree-dump-times "CLOBBER" 2 "original" } }
+!
+! PR fortran/106817
+! Check that for an actual argument whose dummy is INTENT(OUT),
+! the clobber that is emitted in the caller before a procedure call
+! happens after any expression depending on the argument value has been
+! evaluated.
+!
+
+module m
+ implicit none
+contains
+ subroutine copy1(out, in)
+ integer, intent(in) :: in
+ integer, intent(out) :: out
+ out = in
+ end subroutine copy1
+ subroutine copy2(in, out)
+ integer, intent(in) :: in
+ integer, intent(out) :: out
+ out = in
+ end subroutine copy2
+end module m
+
+program p
+ use m
+ implicit none
+ integer :: a, b
+
+ ! Clobbering of a should happen after a+1 has been evaluated.
+ a = 3
+ call copy1(a, a+1)
+ if (a /= 4) stop 1
+
+ ! Clobbering order does not depend on the order of arguments.
+ ! It should also come last with reversed arguments.
+ b = 12
+ call copy2(b+1, b)
+ if (b /= 13) stop 2
+
+end program p