Hi all,
attached patch fixes an ICE in gimplify by assuring that the corank of a
non-pointer, non-coarray array component in a derived type is zero. Previously
(erroneously) the full corank of the type has been used. There is one exception
for pointer typed array components in coarray derived types. These can be
associated only to coarray array targets (compare F2018 C1024 and C1026).
Therefore for those the corank is still propagated.
Regtests ok on x86_64-pc-linux-gnu / Fedora 39. Ok for mainline?
Regards,
Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
From 0ba7ab80bce08f0b3c6f1f4928f95c87b4bbd39d Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <ve...@gcc.gnu.org>
Date: Fri, 16 Aug 2024 15:07:39 +0200
Subject: [PATCH] [Fortran] 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 | 16 +++---
.../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, 68 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 586fc65f21d..ceda7843fa9 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 bc582085f57..ba2ffba8ec1 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,14 @@ 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 00000000000..4a8e54ced6b
--- /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.reu...@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 7b44c73211b..a27d7407833 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 b09552a7f03..b69aa5fce89 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" } }
!
--
2.46.0
