From db75a6657e9de6ee7effe46cd2626d9bb946f2e6 Mon Sep 17 00:00:00 2001 From: Andre Vehreschild Date: Tue, 11 Jun 2024 15:24:55 +0200 Subject: Fix ICE when compiling with -fcoarray=single, when derefing a non-array. PR fortran/96418 PR fortran/103112 gcc/fortran/ChangeLog: * trans.cc (gfc_deallocate_with_status): Check that object to deref is an array, before applying array deref. gcc/testsuite/ChangeLog: * gfortran.dg/coarray_alloc_comp_3.f08: Moved to... * gfortran.dg/coarray/alloc_comp_8.f90: ...here. Should be tested for both -fcoarray=single and lib, resp. * gfortran.dg/coarray_alloc_comp_4.f08: Fix program name. --- gcc/fortran/trans.cc | 3 +- gcc/testsuite/gfortran.dg/coarray/alloc_comp_8.f90 | 51 +++++++++++++++++++++ gcc/testsuite/gfortran.dg/coarray_alloc_comp_3.f08 | 52 ---------------------- gcc/testsuite/gfortran.dg/coarray_alloc_comp_4.f08 | 2 +- 4 files changed, 54 insertions(+), 54 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/coarray/alloc_comp_8.f90 delete mode 100644 gcc/testsuite/gfortran.dg/coarray_alloc_comp_3.f08 (limited to 'gcc') diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc index a208afe..1335b8c 100644 --- a/gcc/fortran/trans.cc +++ b/gcc/fortran/trans.cc @@ -1838,7 +1838,8 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg, else caf_dereg_type = (enum gfc_coarray_deregtype) coarray_dealloc_mode; } - else if (flag_coarray == GFC_FCOARRAY_SINGLE) + else if (flag_coarray == GFC_FCOARRAY_SINGLE + && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (pointer))) pointer = gfc_conv_descriptor_data_get (pointer); } else if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (pointer))) diff --git a/gcc/testsuite/gfortran.dg/coarray/alloc_comp_8.f90 b/gcc/testsuite/gfortran.dg/coarray/alloc_comp_8.f90 new file mode 100644 index 0000000..8b15392 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray/alloc_comp_8.f90 @@ -0,0 +1,51 @@ +! { dg-do run } +! { dg-additional-options "-latomic" { target libatomic_available } } +! +! Contributed by Andre Vehreschild +! Check that manually freeing components does not lead to a runtime crash, +! when the auto-deallocation is taking care. + +program alloc_comp_6 + implicit none + + type dt + integer, allocatable :: i + end type dt + + type linktype + type(dt), allocatable :: link + end type linktype + + type(linktype), allocatable :: obj[:] + + allocate(obj[*]) + allocate(obj%link) + + if (.not. allocated(obj)) error stop "Test failed. 'obj' not allocated." + if (.not. allocated(obj%link)) error stop "Test failed. 'obj%link' not allocated." + if (allocated(obj%link%i)) error stop "Test failed. 'obj%link%i' already allocated." + + allocate(obj%link%i, source = 42) + + if (.not. allocated(obj)) error stop "Test failed. 'obj' not allocated." + if (.not. allocated(obj%link)) error stop "Test failed. 'obj%link' not allocated." + if (.not. allocated(obj%link%i)) error stop "Test failed. 'obj%link%i' not allocated." + if (obj%link%i /= 42) error stop "Test failed. obj%link%i /= 42." + + deallocate(obj%link%i) + + if (allocated(obj%link%i)) error stop "Test failed. 'obj%link%i' still allocated." + if (.not. allocated(obj%link)) error stop "Test failed. 'obj%link' no longer allocated." + if (.not. allocated(obj)) error stop "Test failed. 'obj' no longer allocated." + + ! Freeing this object, lead to crash with older gfortran... + deallocate(obj%link) + + if (allocated(obj%link)) error stop "Test failed. 'obj%link' still allocated." + if (.not. allocated(obj)) error stop "Test failed. 'obj' no longer allocated." + + ! ... when auto-deallocating the allocated components. + deallocate(obj) + + if (allocated(obj)) error stop "Test failed. 'obj' still allocated." +end program diff --git a/gcc/testsuite/gfortran.dg/coarray_alloc_comp_3.f08 b/gcc/testsuite/gfortran.dg/coarray_alloc_comp_3.f08 deleted file mode 100644 index e2037aa..0000000 --- a/gcc/testsuite/gfortran.dg/coarray_alloc_comp_3.f08 +++ /dev/null @@ -1,52 +0,0 @@ -! { dg-do run } -! { dg-options "-fcoarray=lib -lcaf_single" } -! { dg-additional-options "-latomic" { target libatomic_available } } -! -! Contributed by Andre Vehreschild -! Check that manually freeing components does not lead to a runtime crash, -! when the auto-deallocation is taking care. - -program coarray_alloc_comp_3 - implicit none - - type dt - integer, allocatable :: i - end type dt - - type linktype - type(dt), allocatable :: link - end type linktype - - type(linktype), allocatable :: obj[:] - - allocate(obj[*]) - allocate(obj%link) - - if (.not. allocated(obj)) error stop "Test failed. 'obj' not allocated." - if (.not. allocated(obj%link)) error stop "Test failed. 'obj%link' not allocated." - if (allocated(obj%link%i)) error stop "Test failed. 'obj%link%i' already allocated." - - allocate(obj%link%i, source = 42) - - if (.not. allocated(obj)) error stop "Test failed. 'obj' not allocated." - if (.not. allocated(obj%link)) error stop "Test failed. 'obj%link' not allocated." - if (.not. allocated(obj%link%i)) error stop "Test failed. 'obj%link%i' not allocated." - if (obj%link%i /= 42) error stop "Test failed. obj%link%i /= 42." - - deallocate(obj%link%i) - - if (allocated(obj%link%i)) error stop "Test failed. 'obj%link%i' still allocated." - if (.not. allocated(obj%link)) error stop "Test failed. 'obj%link' no longer allocated." - if (.not. allocated(obj)) error stop "Test failed. 'obj' no longer allocated." - - ! Freeing this object, lead to crash with older gfortran... - deallocate(obj%link) - - if (allocated(obj%link)) error stop "Test failed. 'obj%link' still allocated." - if (.not. allocated(obj)) error stop "Test failed. 'obj' no longer allocated." - - ! ... when auto-deallocating the allocated components. - deallocate(obj) - - if (allocated(obj)) error stop "Test failed. 'obj' still allocated." -end program diff --git a/gcc/testsuite/gfortran.dg/coarray_alloc_comp_4.f08 b/gcc/testsuite/gfortran.dg/coarray_alloc_comp_4.f08 index 6586ec6..4c71a90 100644 --- a/gcc/testsuite/gfortran.dg/coarray_alloc_comp_4.f08 +++ b/gcc/testsuite/gfortran.dg/coarray_alloc_comp_4.f08 @@ -5,7 +5,7 @@ ! Contributed by Andre Vehreschild ! Check that sub-components are caf_deregistered and not freed. -program coarray_alloc_comp_3 +program coarray_alloc_comp_4 implicit none type dt -- cgit v1.1