Fortran: Allow to use non-pure/non-elemental functions in coarray indexes [PR107635]

Extract calls to non-pure or non-elemental functions from index
expressions on a coarray.

gcc/fortran/ChangeLog:

	PR fortran/107635

	* coarray.cc (get_arrayspec_from_expr): Treat array result of
	function calls correctly.
	(remove_coarray_from_derived_type): Prevent memory loss.
	(add_caf_get_from_remote): Correct locus.
	(find_comp): New function to find or create a new component in a
	derived type.
	(check_add_new_comp_handle_array): Handle allocatable arrays or
	non-pure/non-elemental functions in indexes of coarrays.
	(check_add_new_component): Use above function.
	(create_get_parameter_type): Rename to
	create_caf_add_data_parameter_type.
	(create_caf_add_data_parameter_type): Renaming of variable and
	make the additional data a coarray.
	(remove_caf_ref): Factor out to reuse in other caf-functions.
	(create_get_callback): Use function factored out, set locus
	correctly and ensure a kind is set for parameters.
	(add_caf_get_intrinsic): Rename to add_caf_get_from_remote and
	rename some variables.
	(coindexed_expr_callback): Skip over function created by the
	rewriter.
	(coindexed_code_callback): Filter some intrinsics not to
	process.
	(gfc_coarray_rewrite): Rewrite also contained functions.
	* trans-intrinsic.cc (gfc_conv_intrinsic_caf_get): Reflect
	changed order on caf_get_from_remote ().

libgfortran/ChangeLog:

	* caf/libcaf.h (_gfortran_caf_register_accessor): Reflect
	changed parameter order.
	* caf/single.c (struct accessor_hash_t): Same.
	(_gfortran_caf_register_accessor): Call accessor using a token
	for accessing arrays with a descriptor on the source side.

gcc/testsuite/ChangeLog:

	* gfortran.dg/coarray_lib_comm_1.f90: Adapt scan expression.
	* gfortran.dg/coarray/get_with_fn_parameter.f90: New test.
	* gfortran.dg/coarray/get_with_scalar_fn.f90: New test.

2 files changed, 19 insertions, 9 deletions

diff --git a/libgfortran/caf/libcaf.h b/libgfortran/caf/libcaf.h
index 0917fad9..4f41f5d 100644
--- a/libgfortran/caf/libcaf.h
+++ b/libgfortran/caf/libcaf.h
@@ -234,8 +234,9 @@ void _gfortran_caf_sendget_by_ref (
 	int *src_stat, int dst_type, int src_type);
 
 void _gfortran_caf_register_accessor (
-  const int hash, void (*accessor) (void **, int32_t *, void *, void *,
-				    size_t *, const size_t *));
+  const int hash,
+  void (*accessor) (void *, const int *, void **, int32_t *, void *,
+		    caf_token_t, const size_t, size_t *, const size_t *));
 
 void _gfortran_caf_register_accessors_finish (void);
 
diff --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c
index 11d0efb..573da1b 100644
--- a/libgfortran/caf/single.c
+++ b/libgfortran/caf/single.c
@@ -57,13 +57,17 @@ typedef struct caf_single_token *caf_single_token_t;
 /* Global variables.  */
 caf_static_t *caf_static_list = NULL;
 
-typedef void (*accessor_t) (void **, int32_t *, void *, void *, size_t *,
+typedef void (*accessor_t) (void *, const int *, void **, int32_t *, void *,
+			    caf_token_t, const size_t, size_t *,
 			    const size_t *);
 struct accessor_hash_t
 {
   int hash;
   int pad;
-  accessor_t accessor;
+  union
+  {
+    accessor_t accessor;
+  } u;
 };
 
 static struct accessor_hash_t *accessor_hash_table = NULL;
@@ -2874,7 +2878,7 @@ _gfortran_caf_register_accessor (const int hash, accessor_t accessor)
       accessor_hash_table_state = AHT_OPEN;
     }
   accessor_hash_table[aht_size].hash = hash;
-  accessor_hash_table[aht_size].accessor = accessor;
+  accessor_hash_table[aht_size].u.accessor = accessor;
   ++aht_size;
 }
 
@@ -2919,7 +2923,7 @@ _gfortran_caf_get_remote_function_index (const int hash)
 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 __attribute__ ((unused)),
+  const size_t *opt_src_charlen, const int image_index,
   const size_t dst_size __attribute__ ((unused)), 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,
@@ -2932,6 +2936,10 @@ _gfortran_caf_get_from_remote (
   int32_t free_buffer;
   void *dst_ptr = opt_dst_desc ? (void *)opt_dst_desc : dst_data;
   void *old_dst_data_ptr = NULL;
+  struct caf_single_token cb_token;
+  cb_token.memptr = get_data;
+  cb_token.desc = NULL;
+  cb_token.owning_memory = false;
 
   if (stat)
     *stat = 0;
@@ -2942,9 +2950,10 @@ _gfortran_caf_get_from_remote (
       opt_dst_desc->base_addr = NULL;
     }
 
-  accessor_hash_table[getter_index].accessor (dst_ptr, &free_buffer, src_ptr,
-					      get_data, opt_dst_charlen,
-					      opt_src_charlen);
+  accessor_hash_table[getter_index].u.accessor (get_data, &image_index, dst_ptr,
+						&free_buffer, src_ptr,
+						&cb_token, 0, opt_dst_charlen,
+						opt_src_charlen);
   if (opt_dst_desc && old_dst_data_ptr && !may_realloc_dst
       && opt_dst_desc->base_addr != old_dst_data_ptr)
     {