From 723b30bee4e4fa3feba9ef03ce7dca95501e1555 Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <vehre@gcc.gnu.org>
Date: Fri, 16 Aug 2024 15:07:39 +0200
Subject: [PATCH] Fix coarray rank for non-coarrays in derived types. [PR86468]
The corank was propagated to array components in derived types. Fix
this by setting a zero corank when the array component is not a pointer.
For pointer typed array components propagate the corank of the derived
type to allow associating the component to a coarray.
gcc/fortran/ChangeLog:
PR fortran/86468
* trans-intrinsic.cc (conv_intrinsic_move_alloc): Correct
comment.
* trans-types.cc (gfc_sym_type): Pass coarray rank, not false.
(gfc_get_derived_type): Only propagate codimension for coarrays
and pointers to array components in derived typed coarrays.
gcc/testsuite/ChangeLog:
* gfortran.dg/coarray_lib_this_image_2.f90: Fix array rank in
tree dump scan.
* gfortran.dg/coarray_lib_token_4.f90: Same.
* gfortran.dg/coarray/move_alloc_2.f90: New test.
---
gcc/fortran/trans-intrinsic.cc | 2 +-
gcc/fortran/trans-types.cc | 18 +++---
.../gfortran.dg/coarray/move_alloc_2.f90 | 55 +++++++++++++++++++
.../gfortran.dg/coarray_lib_this_image_2.f90 | 2 +-
.../gfortran.dg/coarray_lib_token_4.f90 | 4 +-
5 files changed, 70 insertions(+), 11 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/coarray/move_alloc_2.f90
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 0ecb04397783..0632e3e4d2fc 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -12906,7 +12906,7 @@ conv_intrinsic_move_alloc (gfc_code *code)
gfc_add_expr_to_block (&block, tmp);
}
- /* Move the pointer and update the array descriptor data. */
+ /* Copy the array descriptor data. */
gfc_add_modify_loc (input_location, &block, to_se.expr, from_se.expr);
/* Set "from" to NULL. */
diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index bc582085f57f..38e18434f7c5 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -2386,7 +2386,7 @@ gfc_sym_type (gfc_symbol * sym, bool is_bind_c)
else if (sym->attr.allocatable)
akind = GFC_ARRAY_ALLOCATABLE;
type = gfc_build_array_type (type, sym->as, akind, restricted,
- sym->attr.contiguous, false);
+ sym->attr.contiguous, sym->as->corank);
}
}
else
@@ -2909,12 +2909,16 @@ gfc_get_derived_type (gfc_symbol * derived, int codimen)
else
akind = GFC_ARRAY_ALLOCATABLE;
/* Pointers to arrays aren't actually pointer types. The
- descriptors are separate, but the data is common. */
- field_type = gfc_build_array_type (field_type, c->as, akind,
- !c->attr.target
- && !c->attr.pointer,
- c->attr.contiguous,
- codimen);
+ descriptors are separate, but the data is common. Every
+ array pointer in a coarray derived type needs to provide space
+ for the coarray management, too. Therefore treat coarrays
+ and pointers to coarrays in derived types the same. */
+ field_type = gfc_build_array_type
+ (
+ field_type, c->as, akind, !c->attr.target && !c->attr.pointer,
+ c->attr.contiguous,
+ c->attr.codimension || c->attr.pointer ? codimen : 0
+ );
}
else
field_type = gfc_get_nodesc_array_type (field_type, c->as,
diff --git a/gcc/testsuite/gfortran.dg/coarray/move_alloc_2.f90 b/gcc/testsuite/gfortran.dg/coarray/move_alloc_2.f90
new file mode 100644
index 000000000000..4a8e54ced6bf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/move_alloc_2.f90
@@ -0,0 +1,55 @@
+!{ dg-do run }
+
+! Check gimplify with checking works. [PR86468]
+! This rather complicated code is needed to produce two "different"
+! types in the move_alloc.
+
+! Contributed by Juergen Reuter <juergen.reuter@desy.de>
+
+module classes
+ implicit none
+ private
+ public :: wrapped_coarray
+
+ type :: wrapped_point
+ integer, allocatable :: point(:)
+ contains
+ procedure :: add => wrapped_point_add
+ end type wrapped_point
+
+ type :: wrapped_coarray
+ type(wrapped_point), allocatable :: caf(:)[:]
+ end type wrapped_coarray
+
+contains
+
+ subroutine wrapped_point_add(self, to_add)
+ class(wrapped_point), intent(inout) :: self
+ integer, intent(in) :: to_add
+ integer, allocatable :: point(:)
+ integer :: points_number
+
+ if (allocated(self%point)) then
+ points_number = size(self%point, dim=1)
+ allocate(point(1:points_number+1))
+ point(1:points_number) = self%point
+ point(points_number+1) = to_add
+ call move_alloc(from=point, to=self%point)
+ else
+ allocate(self%point(1))
+ self%point(1) = to_add
+ end if
+ end subroutine wrapped_point_add
+end module classes
+
+program test
+ use classes
+ implicit none
+
+ type(wrapped_coarray) :: foo
+ allocate(foo%caf(99)[*])
+ call foo%caf(32)%add(this_image())
+ call foo%caf(32)%add(this_image())
+ if (any (foo%caf(32)%point /= [this_image(), this_image()])) stop 1
+end program test
+
diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_this_image_2.f90 b/gcc/testsuite/gfortran.dg/coarray_lib_this_image_2.f90
index 7b44c73211bf..a27d74078333 100644
--- a/gcc/testsuite/gfortran.dg/coarray_lib_this_image_2.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_lib_this_image_2.f90
@@ -16,7 +16,7 @@ contains
end subroutine bar
end
-! { dg-final { scan-tree-dump-times "bar \\(struct array01_real\\(kind=4\\) & restrict x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) caf_offset..\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "bar \\(struct array02_real\\(kind=4\\) & restrict x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) caf_offset..\\)" 1 "original" } }
! { dg-final { scan-tree-dump-times "mylcobound = 5;" 1 "original" } }
! { dg-final { scan-tree-dump-times "parm...dim\\\[1\\\].lbound = 5;" 1 "original" } }
! { dg-final { scan-tree-dump-times "myucobound =\[^\n\r\]* parm...dim\\\[1\\\].lbound \\+ \[^\n\r\]*_gfortran_caf_num_images \\(0, -1\\).? \\+ -?\[0-9\]+\\);" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_token_4.f90 b/gcc/testsuite/gfortran.dg/coarray_lib_token_4.f90
index b09552a7f032..b69aa5fce89a 100644
--- a/gcc/testsuite/gfortran.dg/coarray_lib_token_4.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_lib_token_4.f90
@@ -35,9 +35,9 @@ end program test_caf
! { dg-final { scan-tree-dump-times "expl \\(integer\\(kind=4\\).0:. . restrict z, void . restrict caf_token.\[0-9\]+, integer\\(kind=.\\) caf_offset.\[0-9\]+\\)" 1 "original" } }
!
-! { dg-final { scan-tree-dump-times "bar \\(struct array01_integer\\(kind=4\\) & restrict y, void . restrict caf_token.\[0-9\]+, integer\\(kind=.\\) caf_offset.\[0-9\]+\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "bar \\(struct array02_integer\\(kind=4\\) & restrict y, void . restrict caf_token.\[0-9\]+, integer\\(kind=.\\) caf_offset.\[0-9\]+\\)" 1 "original" } }
!
-! { dg-final { scan-tree-dump-times "foo \\(struct array01_integer\\(kind=4\\) & restrict x, struct array01_integer\\(kind=4\\) & restrict y, integer\\(kind=4\\) & restrict test, void . restrict caf_token.\[0-9\]+, integer\\(kind=.\\) caf_offset.\[0-9\]+, void . restrict caf_token.\[0-9\]+, integer\\(kind=.\\) caf_offset.\[0-9\]+\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "foo \\(struct array02_integer\\(kind=4\\) & restrict x, struct array02_integer\\(kind=4\\) & restrict y, integer\\(kind=4\\) & restrict test, void . restrict caf_token.\[0-9\]+, integer\\(kind=.\\) caf_offset.\[0-9\]+, void . restrict caf_token.\[0-9\]+, integer\\(kind=.\\) caf_offset.\[0-9\]+\\)" 1 "original" } }
!
! { dg-final { scan-tree-dump-times "bar \\(&parm.\[0-9\]+, caf_token.\[0-9\]+, \\(\\(integer\\(kind=.\\)\\) parm.\[0-9\]+.data - \\(integer\\(kind=.\\)\\) x.\[0-9\]+\\) \\+ caf_offset.\[0-9\]+\\);" 1 "original" } }
!
--
GitLab