Re: [PATCH] Fortran: fixes for procedures with ALLOCATABLE,INTENT(OUT) arguments [PR92178]

[Harald Anlauf <anlauf@gmx.de>]

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