Hi Mikael,
Am 03.07.23 um 13:46 schrieb Mikael Morin:
A few thing to double check below.
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 30946ba3f63..16e8f037cfc 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
(...)
@@ -6117,6 +6118,33 @@ gfc_conv_procedure_call (gfc_se * se,
gfc_symbol * sym,
&& UNLIMITED_POLY (sym)
&& comp && (strcmp ("_copy", comp->name) == 0);
+ /* First scan argument list for allocatable actual arguments passed to
+ allocatable dummy arguments with INTENT(OUT). As the corresponding
+ actual arguments are deallocated before execution of the
procedure, we
+ evaluate actual argument expressions to avoid problems with
possible
+ dependencies. */
+ bool force_eval_args = false;
+ gfc_formal_arglist *tmp_formal;
+ for (arg = args, tmp_formal = formal; arg != NULL;
+ arg = arg->next, tmp_formal = tmp_formal ? tmp_formal->next :
NULL)
+ {
+ e = arg->expr;
+ fsym = tmp_formal ? tmp_formal->sym : NULL;
+ if (e && fsym
+ && e->expr_type == EXPR_VARIABLE
+ && fsym->attr.intent == INTENT_OUT
+ && (fsym->ts.type == BT_CLASS && fsym->attr.class_ok
+ ? CLASS_DATA (fsym)->attr.allocatable
+ : fsym->attr.allocatable)
+ && e->symtree
+ && e->symtree->n.sym
+ && gfc_variable_attr (e, NULL).allocatable)
+ {
+ force_eval_args = true;
+ break;
+ }
+ }
+
The function is already big enough, would you mind outlining this to its
own function?
This can be done. At least it is not part of the monster loop.
/* Evaluate the arguments. */
for (arg = args, argc = 0; arg != NULL;
arg = arg->next, formal = formal ? formal->next : NULL, ++argc)
@@ -6680,7 +6708,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol
* sym,
else
tmp = gfc_finish_block (&block);
- gfc_add_expr_to_block (&se->pre, tmp);
+ gfc_add_expr_to_block (&dealloc_blk, tmp);
}
/* A class array element needs converting back to be a
@@ -6980,7 +7008,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol
* sym,
build_empty_stmt (input_location));
}
if (tmp != NULL_TREE)
- gfc_add_expr_to_block (&se->pre, tmp);
+ gfc_add_expr_to_block (&dealloc_blk, tmp);
}
tmp = parmse.expr;
@@ -7004,7 +7032,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol
* sym,
void_type_node,
gfc_conv_expr_present (e->symtree->n.sym),
tmp, build_empty_stmt (input_location));
- gfc_add_expr_to_block (&se->pre, tmp);
+ gfc_add_expr_to_block (&dealloc_blk, tmp);
}
}
}
These look good, but I'm surprised that there is no similar change at
the 6819 line.
This is the class array actual vs class array dummy case.
It seems to be checked by the "bar" subroutine in your testcase, except
that the intent(out) argument comes last there, whereas it was coming
first with the original testcases in the PR.
Can you double check?
I believe I tried that before and encountered regressions.
The change
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 16e8f037cfc..43e013fa720 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6844,7 +6844,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol *
sym,
else
tmp = gfc_finish_block (&block);
- gfc_add_expr_to_block (&se->pre, tmp);
+// gfc_add_expr_to_block (&se->pre, tmp);
+ gfc_add_expr_to_block (&dealloc_blk, tmp);
}
/* The conversion does not repackage the reference to a class
regresses on:
gfortran.dg/class_array_16.f90
gfortran.dg/finalize_12.f90
gfortran.dg/optional_class_1.f90
A simplified testcase for further study:
program p
implicit none
class(*), allocatable :: c(:)
c = [3, 4]
call bar (allocated (c), c, allocated (c))
if (allocated (c)) stop 14
contains
subroutine bar (alloc, x, alloc2)
logical :: alloc, alloc2
class(*), allocatable, intent(out) :: x(:)
if (allocated (x)) stop 5
if (.not. alloc) stop 6
if (.not. alloc2) stop 16
end subroutine bar
end
(This fails in a different place for the posted patch and for
the above trial change. Need to go to the drawing board...)
@@ -7101,6 +7129,21 @@ gfc_conv_procedure_call (gfc_se * se,
gfc_symbol * sym,
}
}
+ /* If any actual argument of the procedure is allocatable and
passed
+ to an allocatable dummy with INTENT(OUT), we conservatively
+ evaluate all actual argument expressions before deallocations are
+ performed and the procedure is executed. This ensures we conform
+ to F2023:15.5.3, 15.5.4. Create temporaries except for constants,
+ variables, and functions returning pointers that can appear in a
+ variable definition context. */
+ if (e && fsym && force_eval_args
+ && e->expr_type != EXPR_VARIABLE
+ && !gfc_is_constant_expr (e)
+ && (e->expr_type != EXPR_FUNCTION
+ || !(gfc_expr_attr (e).pointer
+ || gfc_expr_attr (e).proc_pointer)))
+ parmse.expr = gfc_evaluate_now (parmse.expr, &parmse.pre);
+
I'm not sure about the guarding condition.
It looks like it may miss evaluation in some cases (one testcase below).
With a value dummy, it is always safe to evaluate to a temporary
variable, and with a non-value dummy, parmse.expr contains a pointer, so
it is safe as well to evaluate that to a temporary pointer?
At least a || fsym->attr.value condition is missing somewhere, but I
think the condition can be reduced to this:
if (e && fsym && force_eval_args
&& !gfc_is_constant_expr (e))
Were there failures that drove to your above guarding conditions?
It seems that your simpler version essentially behaves the same way,
at least as far as regtesting is concerned.
Mikael
PS: The testcase (as promised):
program p
implicit none
type t
integer :: i
integer, pointer :: pi
end type t
integer, target :: j
type(t), allocatable :: ta
j = 1
ta = t(2, j)
call assign(ta, id(ta%pi))
if (ta%i /= 1) stop 1
if (associated(ta%pi)) stop 2
contains
subroutine assign(a, b)
type(t), intent(out), allocatable :: a
integer, intent(in) , value :: b
allocate(a)
a%i = b
a%pi => null()
end subroutine assign
function id(a)
integer, pointer :: id, a
id => a
end function id
end program p
Indeed, this is a nice demonstration.
While playing, I was wondering whether the following code is conforming:
program p
call s ((1))
contains
subroutine s (x)
integer :: x
x = 42
end subroutine
end
(It crashes with gfortran, but not with any foreign brand tested).
Harald
