]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
Fortran: Free alloc. comp. in allocated coarrays only.
authorAndre Vehreschild <vehre@gcc.gnu.org>
Thu, 28 Sep 2023 07:30:12 +0000 (09:30 +0200)
committerAndre Vehreschild <vehre@gcc.gnu.org>
Fri, 29 Sep 2023 13:01:21 +0000 (15:01 +0200)
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.

(cherry picked from commit 9a63a62dfd73e159f1956e9b04b555c445de4e78)

gcc/fortran/trans-array.cc
gcc/testsuite/gfortran.dg/coarray/alloc_comp_6.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/coarray/alloc_comp_7.f90 [new file with mode: 0644]

index e70af03d16dd8b84e633d4b9049bdb7c315220bf..35fc77e7541483fb043e9af28f70a759bd8cc8b3 100644 (file)
@@ -9200,6 +9200,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)
@@ -11387,7 +11393,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);
     }
 
@@ -11401,9 +11411,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);
     }
 
diff --git a/gcc/testsuite/gfortran.dg/coarray/alloc_comp_6.f90 b/gcc/testsuite/gfortran.dg/coarray/alloc_comp_6.f90
new file mode 100644 (file)
index 0000000..e8a74db
--- /dev/null
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/coarray/alloc_comp_7.f90 b/gcc/testsuite/gfortran.dg/coarray/alloc_comp_7.f90
new file mode 100644 (file)
index 0000000..5ebd31f
--- /dev/null
@@ -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
+