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'll wrap up all pieces and resubmit when the dust settles.
We can then address the other findings later.
Harald
Am 04.07.23 um 15:35 schrieb Mikael Morin:
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
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
@@ -6804,6 +6804,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
/* Pass a class array. */
parmse.use_offset = 1;
gfc_conv_expr_descriptor (&parmse, e);
+ bool defer_repackage = false;
/* If an ALLOCATABLE dummy argument has INTENT(OUT) and is
allocated on entry, it must be deallocated. */
@@ -6844,7 +6845,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 (&dealloc_blk, tmp);
+ defer_repackage = true;
}
/* The conversion does not repackage the reference to a class
@@ -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
{
@@ -7131,17 +7137,12 @@ 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
+ evaluate 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. */
+ to F2023:15.5.3, 15.5.4. May create temporaries when needed. */
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)))
+ && fsym->attr.intent != INTENT_OUT
+ && !gfc_is_constant_expr (e))
parmse.expr = gfc_evaluate_now (parmse.expr, &parmse.pre);
if (fsym && need_interface_mapping && e)
