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