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.

5 files changed, 70 insertions, 11 deletions

diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 0ecb043..0632e3e 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 bc58208..38e1843 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 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 7b44c73..a27d740 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 b09552a..b69aa5f 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" } }
 !