https://gcc.gnu.org/bugzilla/show_bug.cgi?id=92887
Mikael Morin <mikael at gcc dot gnu.org> changed:
What |Removed |Added
----------------------------------------------------------------------------
CC| |mikael at gcc dot gnu.org
--- Comment #5 from Mikael Morin <mikael at gcc dot gnu.org> ---
(In reply to anlauf from comment #4)
>
> I'll need broader feedback, so unless someone adds to this pr, I'll submit
> the present patch - with testcases - to get attention.
>
Here you go:
> diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
> index 45a984b6bdb..d9dcc11e5bd 100644
> --- a/gcc/fortran/trans-expr.cc
> +++ b/gcc/fortran/trans-expr.cc
> @@ -6396,7 +6399,28 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
> && fsym->ts.type != BT_CLASS
> && fsym->ts.type != BT_DERIVED)
> {
> - if (e->expr_type != EXPR_VARIABLE
> + /* F2018:15.5.2.12 Argument presence and
> + restrictions on arguments not present. */
> + if (e->expr_type == EXPR_VARIABLE
> + && (e->symtree->n.sym->attr.allocatable
> + || e->symtree->n.sym->attr.pointer))
Beware of expressions like derived%alloc_comp or derived%pointer_comp which
don't match the above.
> + {
> + gfc_se argse;
> + gfc_init_se (&argse, NULL);
> + argse.want_pointer = 1;
> + gfc_conv_expr (&argse, e);
> + tmp = fold_convert (TREE_TYPE (argse.expr),
> + null_pointer_node);
> + tmp = fold_build2_loc (input_location, NE_EXPR,
> + logical_type_node,
> + argse.expr, tmp);
> + vec_safe_push (optionalargs,
> + fold_convert (boolean_type_node,
> + tmp));
> + need_temp = true;
> + cond_temp = tmp;
> + }
> + else if (e->expr_type != EXPR_VARIABLE
> || !e->symtree->n.sym->attr.optional
> || e->ref != NULL)
> vec_safe_push (optionalargs, boolean_true_node);
> @@ -7072,6 +7096,42 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
> }
> }
>
> + /* F2023:15.5.3, 15.5.4: Actual argument expressions are evaluated
> + before they are associated and a procedure is executed. */
> + if (e && e->expr_type != EXPR_VARIABLE && !gfc_is_constant_expr (e))
> + {
> + /* Create temporary except for functions returning pointers that
> + can appear in a variable definition context. */
Maybe explain *why* we have to create a temporary, that is some data references
may become undefined by the procedure call (intent(out) dummies) so we have to
evaluate values depending on them beforehand (PR 92178).
> + if (e->expr_type != EXPR_FUNCTION
> + || !(gfc_expr_attr (e).pointer || gfc_expr_attr (e).proc_pointer))
Merge with the outer condition?
> + need_temp = true;
> + }
> +
> + if (need_temp)
> + {
> + if (cond_temp == NULL_TREE)
> + parmse.expr = gfc_evaluate_now (parmse.expr, &parmse.pre);
I'm not sure about this. The condition to set need_temp looks quite general
(especially it matches non-scalar cases, doesn't it?), but
gfc_conv_expr_reference should already take care of creating a variable, so
that a temporary is missing only for value dummies, I think. I would rather
move this to the place specific to value dummies.
I think this PR is only about scalars with basic types, is there the same
problem with derived types? with classes?
I guess arrays are different as they are always by reference?
> + else
I would rather move the else part to the place above where cond_temp is set, so
that the code is easier to follow.
> + {
> + /* "Conditional temporary" to handle variables that possibly
> + cannot be dereferenced. Use null value as fallback. */
> + tree dflt_temp;
> + gcc_assert (e->ts.type != BT_DERIVED && e->ts.type != BT_CLASS);
> + gcc_assert (e->rank == 0);
> + dflt_temp = gfc_create_var (TREE_TYPE (parmse.expr), "temp");
> + TREE_STATIC (dflt_temp) = 1;
> + TREE_CONSTANT (dflt_temp) = 1;
> + TREE_READONLY (dflt_temp) = 1;
> + DECL_INITIAL (dflt_temp) = build_zero_cst (TREE_TYPE (dflt_temp));
> + parmse.expr = fold_build3_loc (input_location, COND_EXPR,
> + TREE_TYPE (parmse.expr),
> + cond_temp,
> + parmse.expr, dflt_temp);
> + parmse.expr = gfc_evaluate_now (parmse.expr, &parmse.pre);
> + }
> + }
> +
> +
> if (fsym && need_interface_mapping && e)
> gfc_add_interface_mapping (&mapping, fsym, &parmse, e);
>
