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

[Mikael Morin <morin-mikael@orange.fr>]

Le 03/07/2023 à 22:49, Harald Anlauf a écrit :
> Hi Mikael,
> 
> Am 03.07.23 um 13:46 schrieb Mikael Morin:
>> 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...)
> 
I've had a quick look.

The code originally generated looks like:

     D.4343 = (void *[0:] * restrict) c._data.data != 0B;
     if (c._data.data != 0B)
       // free c._data.data
     c._data.data = 0B;
     ...
     class.3._data = c._data;
     ...
     D.4345 = (void *[0:] * restrict) c._data.data != 0B;
     bar (&D.4343, &class.3, &D.4345);

this fails because D.4345 has the wrong value.
With your change, it becomes:

     D.4343 = (void *[0:] * restrict) c._data.data != 0B;
     ...
     class.3._data = c._data;
     ...
     D.4345 = (void *[0:] * restrict) c._data.data != 0B;
     if (c._data.data != 0B)
       // free c._data.data
     c._data.data = 0B;
     bar (&D.4343, &class.3, &D.4345);

and then it is class.3._data that has the wrong value.
So basically the initialization of class.3 should move with the 
deallocation.

I can reproduce a similar problem with your unmodified patch on the 
following variant:

program p
   implicit none
   class(*),  allocatable :: c
   c = 3
   call bar (c, allocated (c))
   if (allocated (c)) stop 14
contains
   subroutine bar (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