https://gcc.gnu.org/g:b114312bbaae51567bc0436d07990c4fbaa3c81d
commit r15-7639-gb114312bbaae51567bc0436d07990c4fbaa3c81d
Author: Andre Vehreschild <ve...@gcc.gnu.org>
Date: Wed Jan 8 12:33:36 2025 +0100
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.
Diff:
---
gcc/fortran/gfortran.texi | 14 +-
gcc/fortran/trans-decl.cc | 25 +--
gcc/fortran/trans-intrinsic.cc | 236 ++++++++++++---------
gcc/fortran/trans.h | 3 +-
gcc/testsuite/gfortran.dg/coarray_lib_comm_1.f90 | 2 +-
.../gfortran.dg/coarray_stat_function.f90 | 6 +-
gcc/testsuite/gfortran.dg/coindexed_1.f90 | 4 +-
libgfortran/caf/libcaf.h | 18 +-
libgfortran/caf/single.c | 11 +-
9 files changed, 168 insertions(+), 151 deletions(-)
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index fa7f563ba2ae..3337a79319a8 100644
--- 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,
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index ebb63a47531c..0a6b7477c879 100644
--- 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,
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 51237d0d3be6..20309aa97765 100644
--- 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;
}
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 915f17549c9f..57e2794ddee1 100644
--- 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;
diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_comm_1.f90
b/gcc/testsuite/gfortran.dg/coarray_lib_comm_1.f90
index 609f3c10cefa..b73b7b1dd568 100644
--- 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" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_stat_function.f90
b/gcc/testsuite/gfortran.dg/coarray_stat_function.f90
index 4d85b6ca8529..627b07441777 100644
--- 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" } }
diff --git a/gcc/testsuite/gfortran.dg/coindexed_1.f90
b/gcc/testsuite/gfortran.dg/coindexed_1.f90
index ac62e26425f1..2bfd31c94421 100644
--- 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'
diff --git a/libgfortran/caf/libcaf.h b/libgfortran/caf/libcaf.h
index edeb1a6fc692..0917fad91f81 100644
--- 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);
diff --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c
index a877138f2447..11d0efb0ad18 100644
--- 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,
