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:
parent
574cec45b2
commit
a680274616
3 changed files with 92 additions and 2 deletions
|
@ -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);
|
||||
}
|
||||
|
||||
|
|
29
gcc/testsuite/gfortran.dg/coarray/alloc_comp_6.f90
Normal file
29
gcc/testsuite/gfortran.dg/coarray/alloc_comp_6.f90
Normal 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
|
49
gcc/testsuite/gfortran.dg/coarray/alloc_comp_7.f90
Normal file
49
gcc/testsuite/gfortran.dg/coarray/alloc_comp_7.f90
Normal 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
|
||||
|
Loading…
Add table
Reference in a new issue