https://gcc.gnu.org/bugzilla/show_bug.cgi?id=115260
Thomas Koenig <tkoenig at gcc dot gnu.org> changed:
What |Removed |Added
----------------------------------------------------------------------------
CC| |mikael at gcc dot gnu.org,
| |pault at gcc dot gnu.org
--- Comment #7 from Thomas Koenig <tkoenig at gcc dot gnu.org> ---
For the following, a bit simplified test case
program usegnufields
implicit none
type :: field_type
real, allocatable :: mydat(:)
end type field_type
type :: fieldholder
type(field_type) :: fieldset(2,4)
end type fieldholder
type(fieldholder) :: myfields
allocate(myfields%fieldset(2,1)%mydat(3))
myfields%fieldset(2,1)%mydat = 1.0
! print '(*(Z8.8:1X))',myfields%fieldset(2,1)%mydat
call setfields (myfields%fieldset(2,1:4))
! print *,'After calling setfields with fieldset(2,1:4)'
! print '(*(Z8.8:1X))',myfields%fieldset(2,1)%mydat
contains
subroutine setfields (fieldset)
type(field_type), intent(inout) :: fieldset(1:4) ! corruption with -O
end subroutine setfields
end
the tree generated below around the call is
if (__builtin_expect ((integer(kind=8)) contiguous.9, 1, 52))
{
arg_ptr.8 = (struct field_type[4] * restrict) parm.11.data;
}
else
{
D.4728 = &myfields.fieldset;
typedef struct field_type [4];
atmp.4.dtype = {.elem_len=64, .version=0, .rank=1, .type=5};
atmp.4.dim[0].stride = 1;
atmp.4.dim[0].lbound = 0;
atmp.4.dim[0].ubound = 3;
atmp.4.span = 64;
atmp.4.data = (void * restrict) &A.5;
atmp.4.offset = 0;
{
integer(kind=8) S.6;
S.6 = 0;
while (1)
{
if (S.6 > 3) goto L.2;
(*(struct field_type[4] * restrict) atmp.4.data)[S.6] =
(*D.4728)[(S.6 + 1) * 2 + -1];
S.6 = S.6 + 1;
}
L.2:;
}
arg_ptr.8 = (struct field_type[4] * restrict) atmp.4.data;
}
setfields (arg_ptr.8);
if (__builtin_expect ((integer(kind=8)) !contiguous.9, 0, 52))
{
D.4739 = &myfields.fieldset;
{
integer(kind=8) S.7;
D.4740 = -1;
S.7 = 1;
while (1)
{
if (S.7 > 4) goto L.3;
{
struct field_type D.4742;
D.4742 = (*D.4739)[S.7 * 2 + -1];
(*D.4739)[S.7 * 2 + -1] = *((struct field_type *) atmp.4.data
+ (sizetype) ((S.7 + D.4740) * 64));
if ((real(kind=4)[0:] * restrict) D.4742.mydat.data != 0B)
{
__builtin_free ((void *) D.4742.mydat.data);
(real(kind=4)[0:] * restrict) D.4742.mydat.data = 0B;
}
}
S.7 = S.7 + 1;
}
L.3:;
}
}
which manipulates the allocatable components, which should not happen.
So the problem is in the way that gfc_conv_subref_array_arg handles
this case.
It does so by unconditionally calling gfc_trans_scalar_assign
at trans-expr.cc:5727 at current trunk, which results in the
deallocations.
Further up, for handling the input argument, it does
if (intent != INTENT_OUT)
{
tmp = gfc_trans_scalar_assign (&lse, &rse, expr->ts, false, false);
gfc_add_expr_to_block (&body, tmp);
gcc_assert (rse.ss == gfc_ss_terminator);
gfc_trans_scalarizing_loops (&loop, &body);
}
else
{
/* Make sure that the temporary declaration survives by merging
all the loop declarations into the current context. */
for (n = 0; n < loop.dimen; n++)
{
gfc_merge_block_scope (&body);
body = loop.code[loop.order[n]];
}
gfc_merge_block_scope (&body);
}
So, this seems to be a bug in gfc_conv_subref_array_arg, which was exposed by
my patch. I would expect that other uses of gfc_conv_subref_array_arg
(such as the CFI work) are also affected.
My scalarizer-fu is weak to none-existing. Would it be possible for
somebody to help out?
