Fortran: Add view convert to pointer assign when only pointer/alloc attr differs...

	PR fortran/104684

gcc/fortran/ChangeLog:

	* trans-array.cc (gfc_conv_expr_descriptor): Look at the
	lang-specific akind and do a view convert when only the akind
	attribute differs between pointer and allocatable array.

gcc/testsuite/ChangeLog:

	* gfortran.dg/coarray/ptr_comp_6.f08: New test.

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 6a00d26cb2f3a43dae05d384c90affa65f7b4ba9..925030465ac37077c1dc273a5253b96f0c0af94f 100644 (file)
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -8186,8 +8186,16 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
        {
          if (se->direct_byref && !se->byref_noassign)
            {
+             struct lang_type *lhs_ls
+               = TYPE_LANG_SPECIFIC (TREE_TYPE (se->expr)),
+               *rhs_ls = TYPE_LANG_SPECIFIC (TREE_TYPE (desc));
+             /* When only the array_kind differs, do a view_convert.  */
+             tmp = lhs_ls && rhs_ls && lhs_ls->rank == rhs_ls->rank
+                       && lhs_ls->akind != rhs_ls->akind
+                     ? build1 (VIEW_CONVERT_EXPR, TREE_TYPE (se->expr), desc)
+                     : desc;
              /* Copy the descriptor for pointer assignments.  */
-             gfc_add_modify (&se->pre, se->expr, desc);
+             gfc_add_modify (&se->pre, se->expr, tmp);
 
              /* Add any offsets from subreferences.  */
              gfc_get_dataptr_offset (&se->pre, se->expr, desc, NULL_TREE,

diff --git a/gcc/testsuite/gfortran.dg/coarray/ptr_comp_6.f08 b/gcc/testsuite/gfortran.dg/coarray/ptr_comp_6.f08
new file mode 100644 (file)
index 0000000..397a09b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/ptr_comp_6.f08
@@ -0,0 +1,25 @@
+!{ dg-do run }
+!
+! Contributed by Arseny Solokha  <asolokha@gmx.com>
+
+program pr104684
+  type :: index_map
+    integer, allocatable :: send_index(:)
+  end type
+  type(index_map) :: imap
+
+  imap%send_index = [5,4,3]
+  call sub(imap)
+contains
+  subroutine sub(this)
+    type(index_map), intent(inout), target :: this
+    type :: box
+      integer, pointer :: array(:)
+    end type
+    type(box), allocatable :: buffer[:]
+    allocate(buffer[*])
+    buffer%array => this%send_index
+    if (any(buffer%array /= [5,4,3])) stop 1    
+  end subroutine
+end program
+