Fortran: Free alloc. comp. in allocated coarrays only.

When freeing allocatable components of an allocatable coarray, add
a check that the coarray is still allocated, before accessing the
components.

This patch adds to PR fortran/37336, but does not fix it completely.

gcc/fortran/ChangeLog:
	PR fortran/37336
	* trans-array.cc (structure_alloc_comps): Deref coarray.
	(gfc_trans_deferred_array): Add freeing of components after
	check for allocated coarray.

gcc/testsuite/ChangeLog:
	PR fortran/37336
	* gfortran.dg/coarray/alloc_comp_6.f90: New test.
	* gfortran.dg/coarray/alloc_comp_7.f90: New test.
This commit is contained in:
Andre Vehreschild 2023-09-28 09:30:12 +02:00
parent 574cec45b2
commit a680274616
3 changed files with 92 additions and 2 deletions

View file

@ -9320,6 +9320,12 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest,
gfc_add_expr_to_block (&fnblock, tmp);
}
/* Still having a descriptor array of rank == 0 here, indicates an
allocatable coarrays. Dereference it correctly. */
if (GFC_DESCRIPTOR_TYPE_P (decl_type))
{
decl = build_fold_indirect_ref (gfc_conv_array_data (decl));
}
/* Otherwise, act on the components or recursively call self to
act on a chain of components. */
for (c = der_type->components; c; c = c->next)
@ -11507,7 +11513,11 @@ gfc_trans_deferred_array (gfc_symbol * sym, gfc_wrapped_block * block)
{
int rank;
rank = sym->as ? sym->as->rank : 0;
tmp = gfc_deallocate_alloc_comp (sym->ts.u.derived, descriptor, rank);
tmp = gfc_deallocate_alloc_comp (sym->ts.u.derived, descriptor, rank,
(sym->attr.codimension
&& flag_coarray == GFC_FCOARRAY_LIB)
? GFC_STRUCTURE_CAF_MODE_IN_COARRAY
: 0);
gfc_add_expr_to_block (&cleanup, tmp);
}
@ -11521,9 +11531,11 @@ gfc_trans_deferred_array (gfc_symbol * sym, gfc_wrapped_block * block)
NULL_TREE, NULL_TREE, true, e,
sym->attr.codimension
? GFC_CAF_COARRAY_DEREGISTER
: GFC_CAF_COARRAY_NOCOARRAY);
: GFC_CAF_COARRAY_NOCOARRAY,
NULL_TREE, gfc_finish_block (&cleanup));
if (e)
gfc_free_expr (e);
gfc_init_block (&cleanup);
gfc_add_expr_to_block (&cleanup, tmp);
}

View file

@ -0,0 +1,29 @@
! { dg-do run }
program alloc_comp_6
implicit none
type :: foo
real :: x
integer, allocatable :: y(:)
end type
call check()
contains
subroutine check()
block
type(foo), allocatable :: example[:] ! needs to be a coarray
allocate(example[*])
allocate(example%y(10))
example%x = 3.4
example%y = 4
deallocate(example)
end block ! example%y shall not be accessed here by the finalizer,
! because example is already deallocated
end subroutine check
end program alloc_comp_6

View file

@ -0,0 +1,49 @@
! { dg-do run }
module alloc_comp_module_7
public :: check
type :: foo
real :: x
integer, allocatable :: y(:)
contains
final :: foo_final
end type
contains
subroutine foo_final(f)
type(foo), intent(inout) :: f
if (allocated(f%y)) then
f%y = -1
end if
end subroutine foo_final
subroutine check()
block
type(foo), allocatable :: example[:] ! needs to be a coarray
allocate(example[*])
allocate(example%y(10))
example%x = 3.4
example%y = 4
deallocate(example%y)
deallocate(example)
end block ! example%y shall not be accessed here by the finalizer,
! because example is already deallocated
end subroutine check
end module alloc_comp_module_7
program alloc_comp_7
use alloc_comp_module_7, only: check
implicit none
call check()
end program alloc_comp_7