Fortran: Prepare for more caf-rework. [PR107635]

Factor out generation of code to get remote function index and to create the additional data structure. Rename caf_get_by_ct to caf_get_from_remote. gcc/fortran/ChangeLog: PR fortran/107635 * gfortran.texi: Rename caf_get_by_ct to caf_get_from_remote. * trans-decl.cc (gfc_build_builtin_function_decls): Rename intrinsic. * trans-intrinsic.cc (conv_caf_func_index): Factor out functionality to be reused by other caf-functions. (conv_caf_add_call_data): Same. (gfc_conv_intrinsic_caf_get): Use functions factored out. * trans.h: Rename intrinsic symbol. libgfortran/ChangeLog: * caf/libcaf.h (_gfortran_caf_get_by_ref): Remove from ABI. This function is replaced by caf_get_from_remote (). (_gfortran_caf_get_remote_function_index): Use better name. * caf/single.c (_gfortran_caf_finalize): Free internal data. (_gfortran_caf_get_by_ref): Remove from public interface, but keep it, because it is still used by sendget (). gcc/testsuite/ChangeLog: * gfortran.dg/coarray_lib_comm_1.f90: Adapt to renamed ABI function. * gfortran.dg/coarray_stat_function.f90: Same. * gfortran.dg/coindexed_1.f90: Same.
2025-01-08 12:33:36 +01:00 · 2025-01-08 12:33:36 +01:00 · b114312bba
commit b114312bba
parent 90ba8291c3
9 changed files with 168 additions and 151 deletions
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@ -4211,7 +4211,7 @@ future implementation of teams.  It is about to change without further notice.
 * _gfortran_caf_sendget:: Sending data between remote images
 * _gfortran_caf_send_by_ref:: Sending data from a local image to a remote image using enhanced references
 * _gfortran_caf_get_by_ref:: Getting data from a remote image using enhanced references
-* _gfortran_caf_get_by_ct:: Getting data from a remote image using a remote side accessor
+* _gfortran_caf_get_from_remote:: Getting data from a remote image using a remote side accessor
 * _gfortran_caf_sendget_by_ref:: Sending data between remote images using enhanced references
 * _gfortran_caf_lock:: Locking a lock variable
 * _gfortran_caf_unlock:: Unlocking a lock variable
@ -4617,8 +4617,8 @@ Return the index of the accessor in the lookup table build by
 fast, because it may be called often.  A log(N) lookup time for a given hash is
 preferred.  The reference implementation uses @code{bsearch ()}, for example.
 The index returned shall be an array index to be used by
-@ref{_gfortran_caf_get_by_ct}, i.e. a constant time operation is mandatory for
-quick access.
+@ref{_gfortran_caf_get_from_remote}, i.e. a constant time operation is mandatory
+for quick access.

 The GFortran compiler ensures that
@code{_gfortran_caf_get_remote_function_index} is called once only for each
@ -4975,9 +4975,9 @@ error message why the operation is not permitted.
@end table


-@node _gfortran_caf_get_by_ct
-@subsection @code{_gfortran_caf_get_by_ct} --- Getting data from a remote image using a remote side accessor
-@cindex Coarray, _gfortran_caf_get_by_ct
+@node _gfortran_caf_get_from_remote
+@subsection @code{_gfortran_caf_get_from_remote} --- Getting data from a remote image using a remote side accessor
+@cindex Coarray, _gfortran_caf_get_from_remote

@table @asis
@item @emph{Description}:
@ -4985,7 +4985,7 @@ Called to get a scalar, an array section or a whole array from a remote image
 identified by the @var{image_index}.

@item @emph{Syntax}:
-@code{void _gfortran_caf_get_by_ct (caf_token_t token,
+@code{void _gfortran_caf_get_from_remote (caf_token_t token,
 const gfc_descriptor_t *opt_src_desc, const size_t *opt_src_charlen,
 const int image_index, const size_t dst_size, void **dst_data,
 size_t *opt_dst_charlen, gfc_descriptor_t *opt_dst_desc,
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@ -140,7 +140,6 @@ tree gfor_fndecl_caf_deregister;
 tree gfor_fndecl_caf_get;
 tree gfor_fndecl_caf_send;
 tree gfor_fndecl_caf_sendget;
-tree gfor_fndecl_caf_get_by_ref;
 tree gfor_fndecl_caf_send_by_ref;
 tree gfor_fndecl_caf_sendget_by_ref;
 // Deprecate end
@ -148,7 +147,7 @@ tree gfor_fndecl_caf_sendget_by_ref;
 tree gfor_fndecl_caf_register_accessor;
 tree gfor_fndecl_caf_register_accessors_finish;
 tree gfor_fndecl_caf_get_remote_function_index;
-tree gfor_fndecl_caf_get_by_ct;
+tree gfor_fndecl_caf_get_from_remote;

 tree gfor_fndecl_caf_sync_all;
 tree gfor_fndecl_caf_sync_memory;
@ -4094,13 +4093,6 @@ gfc_build_builtin_function_decls (void)
 	integer_type_node, pvoid_type_node, pvoid_type_node, integer_type_node,
 	integer_type_node, boolean_type_node, integer_type_node);

-      gfor_fndecl_caf_get_by_ref = gfc_build_library_function_decl_with_spec (
-	get_identifier (PREFIX("caf_get_by_ref")), ". r . w r . . . . w . ",
-	void_type_node,
-	10, pvoid_type_node, integer_type_node, pvoid_type_node,
-	pvoid_type_node, integer_type_node, integer_type_node,
-	boolean_type_node, boolean_type_node, pint_type, integer_type_node);
-
      gfor_fndecl_caf_send_by_ref = gfc_build_library_function_decl_with_spec (
 	get_identifier (PREFIX("caf_send_by_ref")), ". r . r r . . . . w . ",
 	void_type_node,	10, pvoid_type_node, integer_type_node, pvoid_type_node,
@ -4133,13 +4125,14 @@ gfc_build_builtin_function_decls (void)
 	  get_identifier (PREFIX ("caf_get_remote_function_index")), ". r ",
 	  integer_type_node, 1, integer_type_node);

-      gfor_fndecl_caf_get_by_ct = gfc_build_library_function_decl_with_spec (
-	get_identifier (PREFIX ("caf_get_by_ct")),
-	". r r r r r w w w r r w r w r r ", void_type_node, 15, pvoid_type_node,
-	pvoid_type_node, psize_type, integer_type_node, size_type_node,
-	ppvoid_type_node, psize_type, pvoid_type_node, boolean_type_node,
-	integer_type_node, pvoid_type_node, size_type_node, pint_type,
-	pvoid_type_node, pint_type);
+      gfor_fndecl_caf_get_from_remote
+	= gfc_build_library_function_decl_with_spec (
+	  get_identifier (PREFIX ("caf_get_from_remote")),
+	  ". r r r r r w w w r r w r w r r ", void_type_node, 15,
+	  pvoid_type_node, pvoid_type_node, psize_type, integer_type_node,
+	  size_type_node, ppvoid_type_node, psize_type, pvoid_type_node,
+	  boolean_type_node, integer_type_node, pvoid_type_node, size_type_node,
+	  pint_type, pvoid_type_node, pint_type);

      gfor_fndecl_caf_sync_all = gfc_build_library_function_decl_with_spec (
 	get_identifier (PREFIX("caf_sync_all")), ". w w . ", void_type_node,
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@ -1668,6 +1668,120 @@ conv_expr_ref_to_caf_ref (stmtblock_t *block, gfc_expr *expr)
 			      : NULL_TREE;
 }

+static int caf_call_cnt = 0;
+
+static tree
+conv_caf_func_index (stmtblock_t *block, gfc_namespace *ns, const char *pat,
+		     gfc_expr *hash)
+{
+  char *name;
+  gfc_se argse;
+  gfc_expr func_index;
+  gfc_symtree *index_st;
+  tree func_index_tree;
+  stmtblock_t blk;
+
+  name = xasprintf (pat, caf_call_cnt);
+  gcc_assert (!gfc_get_sym_tree (name, ns, &index_st, false));
+  free (name);
+
+  index_st->n.sym->attr.flavor = FL_VARIABLE;
+  index_st->n.sym->attr.save = SAVE_EXPLICIT;
+  index_st->n.sym->value
+    = gfc_get_constant_expr (BT_INTEGER, gfc_default_integer_kind,
+			     &gfc_current_locus);
+  mpz_init_set_si (index_st->n.sym->value->value.integer, -1);
+  index_st->n.sym->ts.type = BT_INTEGER;
+  index_st->n.sym->ts.kind = gfc_default_integer_kind;
+  gfc_set_sym_referenced (index_st->n.sym);
+  memset (&func_index, 0, sizeof (gfc_expr));
+  gfc_clear_ts (&func_index.ts);
+  func_index.expr_type = EXPR_VARIABLE;
+  func_index.symtree = index_st;
+  func_index.ts = index_st->n.sym->ts;
+  gfc_commit_symbol (index_st->n.sym);
+
+  gfc_init_se (&argse, NULL);
+  gfc_conv_expr (&argse, &func_index);
+  gfc_add_block_to_block (block, &argse.pre);
+  func_index_tree = argse.expr;
+
+  gfc_init_se (&argse, NULL);
+  gfc_conv_expr (&argse, hash);
+
+  gfc_init_block (&blk);
+  gfc_add_modify (&blk, func_index_tree,
+		  build_call_expr (gfor_fndecl_caf_get_remote_function_index, 1,
+				   argse.expr));
+  gfc_add_expr_to_block (
+    block,
+    build3 (COND_EXPR, void_type_node,
+	    gfc_likely (build2 (EQ_EXPR, logical_type_node, func_index_tree,
+				build_int_cst (integer_type_node, -1)),
+			PRED_FIRST_MATCH),
+	    gfc_finish_block (&blk), NULL_TREE));
+
+  return func_index_tree;
+}
+
+static tree
+conv_caf_add_call_data (stmtblock_t *blk, gfc_namespace *ns, const char *pat,
+			gfc_symbol *data_sym, tree *data_size)
+{
+  char *name;
+  gfc_symtree *data_st;
+  gfc_constructor *con;
+  gfc_expr data, data_init;
+  gfc_se argse;
+  tree data_tree;
+
+  memset (&data, 0, sizeof (gfc_expr));
+  gfc_clear_ts (&data.ts);
+  data.expr_type = EXPR_VARIABLE;
+  name = xasprintf (pat, caf_call_cnt);
+  gcc_assert (!gfc_get_sym_tree (name, ns, &data_st, false));
+  free (name);
+  data_st->n.sym->attr.flavor = FL_VARIABLE;
+  data_st->n.sym->ts = data_sym->ts;
+  data.symtree = data_st;
+  gfc_set_sym_referenced (data.symtree->n.sym);
+  data.ts = data_st->n.sym->ts;
+  gfc_commit_symbol (data_st->n.sym);
+
+  memset (&data_init, 0, sizeof (gfc_expr));
+  gfc_clear_ts (&data_init.ts);
+  data_init.expr_type = EXPR_STRUCTURE;
+  data_init.ts = data.ts;
+  for (gfc_component *comp = data.ts.u.derived->components; comp;
+       comp = comp->next)
+    {
+      con = gfc_constructor_get ();
+      con->expr = comp->initializer;
+      comp->initializer = NULL;
+      gfc_constructor_append (&data_init.value.constructor, con);
+    }
+
+  if (data.ts.u.derived->components)
+    {
+      gfc_init_se (&argse, NULL);
+      gfc_conv_expr (&argse, &data);
+      data_tree = argse.expr;
+      gfc_add_expr_to_block (blk,
+			     gfc_trans_structure_assign (data_tree, &data_init,
+							 true, true));
+      gfc_constructor_free (data_init.value.constructor);
+      *data_size = TREE_TYPE (data_tree)->type_common.size_unit;
+      data_tree = gfc_build_addr_expr (pvoid_type_node, data_tree);
+    }
+  else
+    {
+      data_tree = build_zero_cst (pvoid_type_node);
+      *data_size = build_zero_cst (size_type_node);
+    }
+
+  return data_tree;
+}
+
 static tree
 conv_shape_to_cst (gfc_expr *e)
 {
@ -1689,23 +1803,16 @@ static void
 gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs,
 			    bool may_realloc, symbol_attribute *caf_attr)
 {
-  static int call_cnt = 0;
  gfc_expr *array_expr, *tmp_stat;
-  gfc_se argse;
  tree caf_decl, token, image_index, tmp, res_var, type, stat, dest_size,
-    dest_data, opt_dest_desc, rget_index_tree, rget_data_tree, rget_data_size,
+    dest_data, opt_dest_desc, get_fn_index_tree, add_data_tree, add_data_size,
    opt_src_desc, opt_src_charlen, opt_dest_charlen;
  symbol_attribute caf_attr_store;
  gfc_namespace *ns;
-  gfc_expr *rget_hash = expr->value.function.actual->next->expr,
-	   *rget_fn_expr = expr->value.function.actual->next->next->expr;
-  gfc_symbol *gdata_sym
-    = rget_fn_expr->symtree->n.sym->formal->next->next->next->sym;
-  gfc_expr rget_data, rget_data_init, rget_index;
-  char *name;
-  gfc_symtree *data_st, *index_st;
-  gfc_constructor *con;
-  stmtblock_t blk;
+  gfc_expr *get_fn_hash = expr->value.function.actual->next->expr,
+	   *get_fn_expr = expr->value.function.actual->next->next->expr;
+  gfc_symbol *add_data_sym
+    = get_fn_expr->symtree->n.sym->formal->next->next->next->sym;

  gcc_assert (flag_coarray == GFC_FCOARRAY_LIB);

@ -1745,90 +1852,13 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs,
  else
    stat = null_pointer_node;

-  memset (&rget_data, 0, sizeof (gfc_expr));
-  gfc_clear_ts (&rget_data.ts);
-  rget_data.expr_type = EXPR_VARIABLE;
-  name = xasprintf ("__caf_rget_data_%d", call_cnt);
-  gcc_assert (!gfc_get_sym_tree (name, ns, &data_st, false));
-  name = xasprintf ("__caf_rget_index_%d", call_cnt);
-  ++call_cnt;
-  gcc_assert (!gfc_get_sym_tree (name, ns, &index_st, false));
-  free (name);
-  data_st->n.sym->attr.flavor = FL_VARIABLE;
-  data_st->n.sym->ts = gdata_sym->ts;
-  rget_data.symtree = data_st;
-  gfc_set_sym_referenced (rget_data.symtree->n.sym);
-  rget_data.ts = data_st->n.sym->ts;
-  gfc_commit_symbol (data_st->n.sym);
-
-  memset (&rget_data_init, 0, sizeof (gfc_expr));
-  gfc_clear_ts (&rget_data_init.ts);
-  rget_data_init.expr_type = EXPR_STRUCTURE;
-  rget_data_init.ts = rget_data.ts;
-  for (gfc_component *comp = rget_data.ts.u.derived->components; comp;
-       comp = comp->next)
-    {
-      con = gfc_constructor_get ();
-      con->expr = comp->initializer;
-      comp->initializer = NULL;
-      gfc_constructor_append (&rget_data_init.value.constructor, con);
-    }
-
-  index_st->n.sym->attr.flavor = FL_VARIABLE;
-  index_st->n.sym->attr.save = SAVE_EXPLICIT;
-  index_st->n.sym->value
-    = gfc_get_constant_expr (BT_INTEGER, gfc_default_integer_kind,
-			     &gfc_current_locus);
-  mpz_init_set_si (index_st->n.sym->value->value.integer, -1);
-  index_st->n.sym->ts.type = BT_INTEGER;
-  index_st->n.sym->ts.kind = gfc_default_integer_kind;
-  gfc_set_sym_referenced (index_st->n.sym);
-  memset (&rget_index, 0, sizeof (gfc_expr));
-  gfc_clear_ts (&rget_index.ts);
-  rget_index.expr_type = EXPR_VARIABLE;
-  rget_index.symtree = index_st;
-  rget_index.ts = index_st->n.sym->ts;
-  gfc_commit_symbol (index_st->n.sym);
-
-  gfc_init_se (&argse, NULL);
-  gfc_conv_expr (&argse, &rget_index);
-  gfc_add_block_to_block (&se->pre, &argse.pre);
-  rget_index_tree = argse.expr;
-
-  gfc_init_se (&argse, NULL);
-  gfc_conv_expr (&argse, rget_hash);
-
-  gfc_init_block (&blk);
-  tmp = build_call_expr (gfor_fndecl_caf_get_remote_function_index, 1,
-			 argse.expr);
-
-  gfc_add_modify (&blk, rget_index_tree, tmp);
-  gfc_add_expr_to_block (
-    &se->pre,
-    build3 (COND_EXPR, void_type_node,
-	    gfc_likely (build2 (EQ_EXPR, logical_type_node, rget_index_tree,
-				build_int_cst (integer_type_node, -1)),
-			PRED_FIRST_MATCH),
-	    gfc_finish_block (&blk), NULL_TREE));
-
-  if (rget_data.ts.u.derived->components)
-    {
-      gfc_init_se (&argse, NULL);
-      gfc_conv_expr (&argse, &rget_data);
-      rget_data_tree = argse.expr;
-      gfc_add_expr_to_block (&se->pre,
-			     gfc_trans_structure_assign (rget_data_tree,
-							 &rget_data_init, true,
-							 false));
-      gfc_constructor_free (rget_data_init.value.constructor);
-      rget_data_size = TREE_TYPE (rget_data_tree)->type_common.size_unit;
-      rget_data_tree = gfc_build_addr_expr (pvoid_type_node, rget_data_tree);
-    }
-  else
-    {
-      rget_data_tree = build_zero_cst (pvoid_type_node);
-      rget_data_size = build_zero_cst (size_type_node);
-    }
+  get_fn_index_tree
+    = conv_caf_func_index (&se->pre, ns, "__caf_get_from_remote_fn_index_%d",
+			   get_fn_hash);
+  add_data_tree
+    = conv_caf_add_call_data (&se->pre, ns, "__caf_get_from_remote_add_data_%d",
+			      add_data_sym, &add_data_size);
+  ++caf_call_cnt;

  if (array_expr->rank == 0)
    {
@ -1836,9 +1866,9 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs,
      if (array_expr->ts.type == BT_CHARACTER)
 	{
 	  gfc_conv_string_length (array_expr->ts.u.cl, array_expr, &se->pre);
-	  argse.string_length = array_expr->ts.u.cl->backend_decl;
+	  se->string_length = array_expr->ts.u.cl->backend_decl;
 	  opt_src_charlen = gfc_build_addr_expr (
-	    NULL_TREE, gfc_trans_force_lval (&se->pre, argse.string_length));
+	    NULL_TREE, gfc_trans_force_lval (&se->pre, se->string_length));
 	  dest_size = build_int_cstu (size_type_node, array_expr->ts.kind);
 	}
      else
@ -1863,9 +1893,9 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs,
      res_var = se->ss->info->data.array.descriptor;
      if (array_expr->ts.type == BT_CHARACTER)
 	{
-	  argse.string_length = array_expr->ts.u.cl->backend_decl;
+	  se->string_length = array_expr->ts.u.cl->backend_decl;
 	  opt_src_charlen = gfc_build_addr_expr (
-	    NULL_TREE, gfc_trans_force_lval (&se->pre, argse.string_length));
+	    NULL_TREE, gfc_trans_force_lval (&se->pre, se->string_length));
 	  dest_size = build_int_cstu (size_type_node, array_expr->ts.kind);
 	}
      else
@ -1921,10 +1951,10 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs,
  gfc_add_expr_to_block (&se->pre, tmp);

  tmp = build_call_expr_loc (
-    input_location, gfor_fndecl_caf_get_by_ct, 15, token, opt_src_desc,
+    input_location, gfor_fndecl_caf_get_from_remote, 15, token, opt_src_desc,
    opt_src_charlen, image_index, dest_size, dest_data, opt_dest_charlen,
    opt_dest_desc, constant_boolean_node (may_realloc, boolean_type_node),
-    rget_index_tree, rget_data_tree, rget_data_size, stat, null_pointer_node,
+    get_fn_index_tree, add_data_tree, add_data_size, stat, null_pointer_node,
    null_pointer_node);

  gfc_add_expr_to_block (&se->pre, tmp);
@ -1933,8 +1963,6 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs,
    gfc_advance_se_ss_chain (se);

  se->expr = res_var;
-  if (array_expr->ts.type == BT_CHARACTER)
-    se->string_length = argse.string_length;

  return;
 }
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@ -888,7 +888,6 @@ extern GTY(()) tree gfor_fndecl_caf_deregister;
 extern GTY(()) tree gfor_fndecl_caf_get;
 extern GTY(()) tree gfor_fndecl_caf_send;
 extern GTY(()) tree gfor_fndecl_caf_sendget;
-extern GTY(()) tree gfor_fndecl_caf_get_by_ref;
 extern GTY(()) tree gfor_fndecl_caf_send_by_ref;
 extern GTY(()) tree gfor_fndecl_caf_sendget_by_ref;
 // Deprecate end
@ -896,7 +895,7 @@ extern GTY(()) tree gfor_fndecl_caf_sendget_by_ref;
 extern GTY (()) tree gfor_fndecl_caf_register_accessor;
 extern GTY (()) tree gfor_fndecl_caf_register_accessors_finish;
 extern GTY (()) tree gfor_fndecl_caf_get_remote_function_index;
-extern GTY (()) tree gfor_fndecl_caf_get_by_ct;
+extern GTY (()) tree gfor_fndecl_caf_get_from_remote;

 extern GTY(()) tree gfor_fndecl_caf_sync_all;
 extern GTY(()) tree gfor_fndecl_caf_sync_memory;
--- a/gcc/testsuite/gfortran.dg/coarray_lib_comm_1.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_lib_comm_1.f90
@ -38,6 +38,6 @@ B(1:5) = B(3:7)
 if (any (A-B /= 0)) STOP 4
 end

-! { dg-final { scan-tree-dump-times "_gfortran_caf_get_by_ct" 4 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_get_from_remote" 4 "original" } }
 ! { dg-final { scan-tree-dump-times "_gfortran_caf_sendget \\\(caf_token.., \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, caf_token.., \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, 4, 4, 1, 0B\\\);" 1 "original" } }

--- a/gcc/testsuite/gfortran.dg/coarray_stat_function.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_stat_function.f90
@ -40,6 +40,6 @@ contains
  
 end program function_stat

-! { dg-final { scan-tree-dump-times "_gfortran_caf_get_by_ct \\\(caf_token.., 0B, 0B, 4, 4, \\\(void \\\*\\\) &D....., 0B, 0B, 0, __caf_rget_index_., 0B, 0, &stat, 0B, 0B\\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_caf_get_by_ct \\\(caf_token.., 0B, 0B, 1, 4, \\\(void \\\*\\\) &D....., 0B, 0B, 0, __caf_rget_index_., 0B, 0, &stat2, 0B, 0B\\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_caf_get_by_ct \\\(caf_token.., 0B, 0B, 3, 4, \\\(void \\\*\\\) &D....., 0B, 0B, 0, __caf_rget_index_., 0B, 0, &stat, 0B, 0B\\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_get_from_remote \\\(caf_token.., 0B, 0B, 4, 4, \\\(void \\\*\\\) &D....., 0B, 0B, 0, __caf_get_from_remote_fn_index_., 0B, 0, &stat, 0B, 0B\\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_get_from_remote \\\(caf_token.., 0B, 0B, 1, 4, \\\(void \\\*\\\) &D....., 0B, 0B, 0, __caf_get_from_remote_fn_index_., 0B, 0, &stat2, 0B, 0B\\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_get_from_remote \\\(caf_token.., 0B, 0B, 3, 4, \\\(void \\\*\\\) &D....., 0B, 0B, 0, __caf_get_from_remote_fn_index_., 0B, 0, &stat, 0B, 0B\\\);" 1 "original" } }
--- a/gcc/testsuite/gfortran.dg/coindexed_1.f90
+++ b/gcc/testsuite/gfortran.dg/coindexed_1.f90
@ -8,7 +8,7 @@
 program pmup
  implicit none
  type t
-    integer :: b, a
+    integer :: b = 0, a
  end type t

  CLASS(*), allocatable :: a(:)[:]
@ -59,7 +59,7 @@ program pmup
      ii = a(1)[1]
      STOP 4
    TYPE IS (t)
-      IF (ALL(A(:)[1]%a == 4.0)) THEN
+      IF (ALL(A(:)[1]%a == 4.0) .AND. ALL(A(:)[1]%b == 0)) THEN
        !WRITE(*,*) 'OK'
      ELSE
        WRITE(*,*) 'FAIL'
--- a/libgfortran/caf/libcaf.h
+++ b/libgfortran/caf/libcaf.h
@ -223,10 +223,6 @@ void _gfortran_caf_sendget (caf_token_t, size_t, int, gfc_descriptor_t *,
 			    caf_vector_t *, caf_token_t, size_t, int,
 			    gfc_descriptor_t *, caf_vector_t *, int, int, bool);

-void _gfortran_caf_get_by_ref (caf_token_t token, int image_idx,
-	gfc_descriptor_t *dst, caf_reference_t *refs, int dst_kind,
-	int src_kind, bool may_require_tmp, bool dst_reallocatable, int *stat,
-	int src_type);
 void _gfortran_caf_send_by_ref (caf_token_t token, int image_index,
 	gfc_descriptor_t *src, caf_reference_t *refs, int dst_kind,
 	int src_kind, bool may_require_tmp, bool dst_reallocatable, int *stat,
@ -245,13 +241,13 @@ void _gfortran_caf_register_accessors_finish (void);

 int _gfortran_caf_get_remote_function_index (const int hash);

-void _gfortran_caf_get_by_ct (
-	caf_token_t token, const gfc_descriptor_t *opt_src_desc,
-	const size_t *opt_src_charlen, const int image_index,
-	const size_t dst_size, void **dst_data, size_t *opt_dst_charlen,
-	gfc_descriptor_t *opt_dst_desc, const bool may_realloc_dst,
-	const int getter_index, void *get_data, const size_t get_data_size,
-	int *stat, caf_team_t *team, int *team_number);
+void _gfortran_caf_get_from_remote (
+  caf_token_t token, const gfc_descriptor_t *opt_src_desc,
+  const size_t *opt_src_charlen, const int image_index, const size_t dst_size,
+  void **dst_data, size_t *opt_dst_charlen, gfc_descriptor_t *opt_dst_desc,
+  const bool may_realloc_dst, const int getter_index, void *get_data,
+  const size_t get_data_size, int *stat, caf_team_t *team, int *team_number);
+

 void _gfortran_caf_atomic_define (caf_token_t, size_t, int, void *, int *,
 				  int, int);
--- a/libgfortran/caf/single.c
+++ b/libgfortran/caf/single.c
@ -126,6 +126,8 @@ _gfortran_caf_init (int *argc __attribute__ ((unused)),
 void
 _gfortran_caf_finalize (void)
 {
+  free (accessor_hash_table);
+
  while (caf_static_list != NULL)
    {
      caf_static_t *tmp = caf_static_list->prev;
@ -1562,15 +1564,14 @@ get_for_ref (caf_reference_t *ref, size_t *i, size_t *dst_index,
    }
 }

-
-void
+/* For internal use only.  */
+static void
 _gfortran_caf_get_by_ref (caf_token_t token,
 			  int image_index __attribute__ ((unused)),
 			  gfc_descriptor_t *dst, caf_reference_t *refs,
 			  int dst_kind, int src_kind,
 			  bool may_require_tmp __attribute__ ((unused)),
-			  bool dst_reallocatable, int *stat,
-			  int src_type)
+			  bool dst_reallocatable, int *stat, int src_type)
 {
  const char vecrefunknownkind[] = "libcaf_single::caf_get_by_ref(): "
 				   "unknown kind in vector-ref.\n";
@ -2916,7 +2917,7 @@ _gfortran_caf_get_remote_function_index (const int hash)
 }

 void
-_gfortran_caf_get_by_ct (
+_gfortran_caf_get_from_remote (
  caf_token_t token, const gfc_descriptor_t *opt_src_desc,
  const size_t *opt_src_charlen, const int image_index __attribute__ ((unused)),
  const size_t dst_size __attribute__ ((unused)), void **dst_data,