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


Reply via email to