Allow for class type coarray parameters. [PR77871]

gcc/fortran/ChangeLog:

	PR fortran/77871

	* trans-expr.cc (gfc_conv_derived_to_class): Assign token when
	converting a coarray to class.
	(gfc_get_tree_for_caf_expr): For classes get the caf decl from
	the saved descriptor.
	(gfc_get_caf_token_offset):Assert that coarray=lib is set and
	cover more cases where the tree having the coarray token can be.
	* trans-intrinsic.cc (gfc_conv_intrinsic_caf_get): Use unified
	test for pointers.

gcc/testsuite/ChangeLog:

	* gfortran.dg/coarray/dummy_3.f90: New test.

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 8094171eb275c58421a24255a83f3a5d1761b3f5..b9f585d0d2f13e4d90b068f0af3abdedd4c963b1 100644 (file)
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -810,6 +810,16 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym,
   /* Now set the data field.  */
   ctree = gfc_class_data_get (var);
 
+  if (flag_coarray == GFC_FCOARRAY_LIB && CLASS_DATA (fsym)->attr.codimension)
+    {
+      tree token;
+      tmp = gfc_get_tree_for_caf_expr (e);
+      if (POINTER_TYPE_P (TREE_TYPE (tmp)))
+       tmp = build_fold_indirect_ref (tmp);
+      gfc_get_caf_token_offset (parmse, &token, nullptr, tmp, NULL_TREE, e);
+      gfc_add_modify (&parmse->pre, gfc_conv_descriptor_token (ctree), token);
+    }
+
   if (optional)
     cond_optional = gfc_conv_expr_present (e->symtree->n.sym);
 
@@ -2344,6 +2354,10 @@ gfc_get_tree_for_caf_expr (gfc_expr *expr)
 
   if (expr->symtree->n.sym->ts.type == BT_CLASS)
     {
+      if (DECL_P (caf_decl) && DECL_LANG_SPECIFIC (caf_decl)
+         && GFC_DECL_SAVED_DESCRIPTOR (caf_decl))
+       caf_decl = GFC_DECL_SAVED_DESCRIPTOR (caf_decl);
+
       if (expr->ref && expr->ref->type == REF_ARRAY)
        {
          caf_decl = gfc_class_data_get (caf_decl);
@@ -2408,16 +2422,12 @@ gfc_get_caf_token_offset (gfc_se *se, tree *token, tree *offset, tree caf_decl,
 {
   tree tmp;
 
+  gcc_assert (flag_coarray == GFC_FCOARRAY_LIB);
+
   /* Coarray token.  */
   if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (caf_decl)))
-    {
-      gcc_assert (GFC_TYPE_ARRAY_AKIND (TREE_TYPE (caf_decl))
-                   == GFC_ARRAY_ALLOCATABLE
-                 || expr->symtree->n.sym->attr.select_type_temporary
-                 || expr->symtree->n.sym->assoc);
       *token = gfc_conv_descriptor_token (caf_decl);
-    }
-  else if (DECL_LANG_SPECIFIC (caf_decl)
+  else if (DECL_P (caf_decl) && DECL_LANG_SPECIFIC (caf_decl)
           && GFC_DECL_TOKEN (caf_decl) != NULL_TREE)
     *token = GFC_DECL_TOKEN (caf_decl);
   else
@@ -2435,7 +2445,7 @@ gfc_get_caf_token_offset (gfc_se *se, tree *token, tree *offset, tree caf_decl,
       && (GFC_TYPE_ARRAY_AKIND (TREE_TYPE (caf_decl)) == GFC_ARRAY_ALLOCATABLE
          || GFC_TYPE_ARRAY_AKIND (TREE_TYPE (caf_decl)) == GFC_ARRAY_POINTER))
     *offset = build_int_cst (gfc_array_index_type, 0);
-  else if (DECL_LANG_SPECIFIC (caf_decl)
+  else if (DECL_P (caf_decl) && DECL_LANG_SPECIFIC (caf_decl)
           && GFC_DECL_CAF_OFFSET (caf_decl) != NULL_TREE)
     *offset = GFC_DECL_CAF_OFFSET (caf_decl);
   else if (GFC_TYPE_ARRAY_CAF_OFFSET (TREE_TYPE (caf_decl)) != NULL_TREE)
@@ -2502,11 +2512,13 @@ gfc_get_caf_token_offset (gfc_se *se, tree *token, tree *offset, tree caf_decl,
     }
   else if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (caf_decl)))
     tmp = gfc_conv_descriptor_data_get (caf_decl);
+  else if (INDIRECT_REF_P (caf_decl))
+    tmp = TREE_OPERAND (caf_decl, 0);
   else
-   {
-     gcc_assert (POINTER_TYPE_P (TREE_TYPE (caf_decl)));
-     tmp = caf_decl;
-   }
+    {
+      gcc_assert (POINTER_TYPE_P (TREE_TYPE (caf_decl)));
+      tmp = caf_decl;
+    }
 
   *offset = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
                            fold_convert (gfc_array_index_type, *offset),

diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index a282ae1c090318a11bf882cd65352f075de385a4..80d75f26b0959737db7cb32bccf63afdd2e0d72d 100644 (file)
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -1900,7 +1900,7 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind,
   gfc_add_block_to_block (&se->post, &argse.post);
 
   caf_decl = gfc_get_tree_for_caf_expr (array_expr);
-  if (TREE_CODE (TREE_TYPE (caf_decl)) == REFERENCE_TYPE)
+  if (POINTER_TYPE_P (TREE_TYPE (caf_decl)))
     caf_decl = build_fold_indirect_ref_loc (input_location, caf_decl);
   image_index = gfc_caf_get_image_index (&se->pre, array_expr, caf_decl);
   gfc_get_caf_token_offset (se, &token, &offset, caf_decl, argse.expr,

diff --git a/gcc/testsuite/gfortran.dg/coarray/dummy_3.f90 b/gcc/testsuite/gfortran.dg/coarray/dummy_3.f90
new file mode 100644 (file)
index 0000000..4b45daa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/dummy_3.f90
@@ -0,0 +1,33 @@
+!{ dg-do run }
+
+! Check that PR77871 is fixed.
+
+! Contributed by Gerhard Steinmetz  <gerhard.steinmetz.fortran@t-online.de>
+
+program pr77871
+   type t
+      integer :: i
+   end type
+
+   type(t) :: p[*]
+   type(t), allocatable :: p2(:)[:]
+
+   p%i = 42
+   allocate (p2(5)[*])
+   p2(:)%i = (/(i, i=0, 4)/)
+   call s(p, 1)
+   call s2(p2, 1)
+contains
+   subroutine s(x, n)
+      class(t) :: x[*]
+      integer :: n
+      if (x[n]%i /= 42) stop 1
+   end
+
+   subroutine s2(x, n)
+      class(t) :: x(:)[*]
+      integer :: n
+      if (any(x(:)[n]%i /= (/(i, i= 0, 4)/) )) stop 2
+   end
+end
+