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

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

Le 04/07/2023 à 21:37, Mikael Morin a écrit :
> Le 04/07/2023 à 21:00, Harald Anlauf a écrit :
>> Hi Mikael, all,
>>
>> I think I've found it: there is a call to gfc_conv_class_to_class
>> that - according to a comment - does a repackaging to a class array.
>> Deferring that repackaging along with the deallocation not only fixes
>> the regression, but also the cases I tested.
>>
>> Attached is a "sneak preview", hoping that the experts (Paul, Mikael,
>> ...) can tell if I am going down the wrong road.
>>
> I think that's it mostly.  There is one last thing that I am not sure...
> 
>> diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
>> index 16e8f037cfc..a68c8d33acc 100644
>> --- a/gcc/fortran/trans-expr.cc
>> +++ b/gcc/fortran/trans-expr.cc
>> @@ -6858,6 +6860,10 @@ gfc_conv_procedure_call (gfc_se * se, 
>> gfc_symbol * sym,
>>                       && e->symtree->n.sym->attr.optional,
>>                       CLASS_DATA (fsym)->attr.class_pointer
>>                       || CLASS_DATA (fsym)->attr.allocatable);
>> +
>> +          /* Defer repackaging after deallocation.  */
>> +          if (defer_repackage)
>> +        gfc_add_block_to_block (&dealloc_blk, &parmse.pre);
>>          }
>>        else
>>          {
> 
> ... whether you will not be deferring too much here.  That is parmse.pre 
> contains both the argument evaluation and the class container setup from 
> gfc_conv_class_to_class.  If it's safe to defer both, that's fine, 
> otherwise a separate gfc_se struct should be passed to 
> gfc_conv_class_to_class so that only the latter part can be deferred.
> Need to think of an example...

Here is an example, admittedly artificial.  Fails with the above change, 
but fails with master as well.

program p
   implicit none
   type t
     integer :: i
   end type t
   type u
     class(t), allocatable :: ta(:)
   end type u
   type(u), allocatable, target :: c(:)
   c = [u([t(1), t(3)]), u([t(4), t(9)])]
   call bar (allocated (c(c(1)%ta(1)%i)%ta), c(c(1)%ta(1)%i)%ta, 
allocated (c(c(1)%ta(1)%i)%ta))
   if (allocated(c(1)%ta)) stop 11
   if (.not. allocated(c(2)%ta)) stop 12
contains
   subroutine bar (alloc, x, alloc2)
     logical :: alloc, alloc2
     class(t), allocatable, intent(out) :: x(:)
     if (allocated (x)) stop 1
     if (.not. alloc)   stop 2
     if (.not. alloc2)  stop 3
   end subroutine bar
end