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.

diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 0ecb043977833f2b6fa29a72264e616ae9b61883..0632e3e4d2fcfcdb5771e8b5eede64b7e6f17c45 100644 (file)
--- 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 bc582085f57fbc50ca9261f67ec9fcdaa720b989..38e18434f7c5e03f641a3395fff848bacb6fb35f 100644 (file)
--- 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 (file)
index 0000000..4a8e54c
--- /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 7b44c73211bfef6c12a212a25ed77c57d6793895..a27d74078333642b4a80765d4a4b254cc114ad13 100644 (file)
--- 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 b09552a7f0320d1830d8f07d00ddaab78bd6ab82..b69aa5fce89a36ea687cb35d3e614513fec6d9c0 100644 (file)
--- 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" } }
 !