diff --git a/sys-cluster/opencoarrays/Manifest b/sys-cluster/opencoarrays/Manifest index 3c465f7de9..df6478942d 100644 --- a/sys-cluster/opencoarrays/Manifest +++ b/sys-cluster/opencoarrays/Manifest @@ -1 +1 @@ -DIST OpenCoarrays-2.10.3_p20251223.tar.gz 351175 BLAKE2B 8398ec1000358b495f7c126b40eb12fc742cb796c9da8fb04bbffdf13bc9f5fa42d029312a751505db63700d1be33d7ff9a18a124789a3580f88204a1b02aac3 SHA512 4daf632f6ca32b96e1a81504caef94535926552c194e6a509182f5182e4f88aecf2012d3e044a821b6c4c9a88945af1735ca900411c920f902763ad1323031e1 +DIST opencoarrays-2.10.3_p20251223.tar.gz 356351 BLAKE2B 7df0ae26d277a7472c9e6b4b9027dab975b53d168c2c575f56e666ec46cb0b7fe2efa4ccf0b942d13ab5fb632dabe9a649bd41ec7a86694a8fc5ac79f710cf86 SHA512 2e86cff19fdba91d94d61a33db1f14dfc7cf621636367d4b912ea63698ae1c8ab678ca06a673a702795698d4d0c56c7978b3cd30a1ae4b4293db509aa6991e90 diff --git a/sys-cluster/opencoarrays/files/opencoarrays-2.10.3_patch_01_Improve_teams_implementation.patch b/sys-cluster/opencoarrays/files/opencoarrays-2.10.3_patch_01_Improve_teams_implementation.patch deleted file mode 100644 index 48a594e03e..0000000000 --- a/sys-cluster/opencoarrays/files/opencoarrays-2.10.3_patch_01_Improve_teams_implementation.patch +++ /dev/null @@ -1,1300 +0,0 @@ -From 27a6a400958696d778f73adcdea13dd2b8a189ba Mon Sep 17 00:00:00 2001 -From: Andre Vehreschild -Date: Fri, 28 Mar 2025 14:59:24 +0100 -Subject: [PATCH] Improve teams implementation - -Improve the implementation of team's functions to adhere to the Fortran -2018 standard and gfortran from 16 on. ---- - CMakeLists.txt | 13 +- - src/application-binary-interface/libcaf.h | 43 +- - src/runtime-libraries/mpi/mpi_caf.c | 569 +++++++++++++++--- - src/tests/unit/teams/CMakeLists.txt | 7 +- - src/tests/unit/teams/team_number.f90 | 68 +++ - ...{team-number.f90 => team_number_pre15.f90} | 0 - src/tests/unit/teams/teams_num_images.f90 | 52 ++ - src/tests/unit/teams/teams_this_image.f90 | 108 ++++ - 8 files changed, 759 insertions(+), 101 deletions(-) - create mode 100644 src/tests/unit/teams/team_number.f90 - rename src/tests/unit/teams/{team-number.f90 => team_number_pre15.f90} (100%) - create mode 100644 src/tests/unit/teams/teams_num_images.f90 - create mode 100644 src/tests/unit/teams/teams_this_image.f90 - -diff --git a/CMakeLists.txt b/CMakeLists.txt -index 8f9a736d1..888613454 100644 ---- a/CMakeLists.txt -+++ b/CMakeLists.txt -@@ -233,9 +233,12 @@ endif() - if ( gfortran_compiler AND ( NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 8.0.0 ) ) - add_definitions(-DGCC_GE_8) # Tell library to build against GFortran 8.x bindings w/ descriptor change - endif() -- if ( gfortran_compiler AND ( NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 14.0.0 ) ) -+ if ( gfortran_compiler AND ( NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 15.0.0 ) ) - add_definitions(-DGCC_GE_15) # Tell library to build against GFortran 15.x bindings - endif() -+ if ( gfortran_compiler AND ( NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 16.0.0 ) ) -+ add_definitions(-DGCC_GE_16) # Tell library to build against GFortran 16.x bindings -+ endif() - - if(gfortran_compiler) - set(OLD_REQUIRED_FLAGS ${CMAKE_REQUIRED_FLAGS}) -@@ -803,7 +806,6 @@ if(opencoarrays_aware_compiler) - add_caf_test(comp_allocated_2 2 comp_allocated_2) - add_caf_test(alloc_comp_get_convert_nums 2 alloc_comp_get_convert_nums) - if(NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 8) -- add_caf_test(team_number 8 team_number) - add_caf_test(teams_subset 3 teams_subset) - add_caf_test(get_communicator 3 get_communicator) - add_caf_test(teams_coarray_get 5 teams_coarray_get) -@@ -815,6 +817,13 @@ if(opencoarrays_aware_compiler) - add_caf_test(alloc_comp_multidim_shape 2 alloc_comp_multidim_shape) - set_tests_properties(alloc_comp_multidim_shape PROPERTIES TIMEOUT 300) - endif() -+ if(NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 15) -+ add_caf_test(team_number 8 team_number) -+ add_caf_test(teams_this_image 8 teams_this_image) -+ add_caf_test(teams_num_images 8 teams_num_images) -+ else() -+ add_caf_test(team_number_pre15 8 team_number_pre15) -+ endif() - endif() - - if (gfortran_compiler) -diff --git a/src/application-binary-interface/libcaf.h b/src/application-binary-interface/libcaf.h -index 8add806df..66a93767d 100644 ---- a/src/application-binary-interface/libcaf.h -+++ b/src/application-binary-interface/libcaf.h -@@ -65,6 +65,17 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ - #define STAT_STOPPED_IMAGE 6000 - #define STAT_FAILED_IMAGE 6001 - -+#ifdef GCC_GE_16 -+/* Definitions of the Fortran 2018 standard; need to kept in sync with -+ ISO_FORTRAN_ENV, cf. gcc/fortran/libgfortran.h. */ -+typedef enum -+{ -+ CAF_INITIAL_TEAM = 0, -+ CAF_PARENT_TEAM, -+ CAF_CURRENT_TEAM -+} caf_team_level_t; -+#endif -+ - /* Describes what type of array we are registerring. Keep in sync with - gcc/fortran/trans.h. */ - typedef enum caf_register_t -@@ -88,24 +99,12 @@ typedef enum caf_deregister_t - CAF_DEREGTYPE_COARRAY_DEALLOCATE_ONLY - } caf_deregister_t; - -+/** The opaque type to represent a coarray token. */ - typedef void *caf_token_t; --/** Add a dummy type representing teams in coarrays. */ - -+/** The opaque type for teams. */ - typedef void *caf_team_t; - --typedef struct caf_teams_list --{ -- caf_team_t team; -- int team_id; -- struct caf_teams_list *prev; --} caf_teams_list; -- --typedef struct caf_used_teams_list --{ -- struct caf_teams_list *team_list_elem; -- struct caf_used_teams_list *prev; --} caf_used_teams_list; -- - /* When there is a vector subscript in this dimension, nvec == 0, otherwise, - lower_bound, upper_bound, stride contains the bounds relative to the declared - bounds; kind denotes the integer kind of the elements of vector[]. */ -@@ -238,8 +237,15 @@ bool PREFIX(is_contiguous)(gfc_descriptor_t *); - void PREFIX(init)(int *, char ***); - void PREFIX(finalize)(void); - -+#ifdef GCC_GE_16 -+int PREFIX(this_image)(caf_team_t); -+ -+int PREFIX(num_images)(caf_team_t, int32_t *); -+#else - int PREFIX(this_image)(int); -+ - int PREFIX(num_images)(int, int); -+#endif - - #ifdef GCC_GE_7 - void PREFIX(register)(size_t, caf_register_t, caf_token_t *, gfc_descriptor_t *, -@@ -359,11 +365,20 @@ void PREFIX(error_stop)(int QUIETARG) __attribute__((noreturn)); - - void PREFIX(fail_image)(void) __attribute__((noreturn)); - -+#ifdef GCC_GE_16 -+void PREFIX(form_team)(int, caf_team_t *, int *, int *, char *, charlen_t); -+void PREFIX(change_team)(caf_team_t, int *, char *, charlen_t); -+void PREFIX(end_team)(int *, char *, charlen_t); -+void PREFIX(sync_team)(caf_team_t, int *, char *, charlen_t); -+int PREFIX(team_number)(caf_team_t); -+caf_team_t PREFIX(get_team)(int32_t *); -+#else - void PREFIX(form_team)(int, caf_team_t *, int); - void PREFIX(change_team)(caf_team_t *, int); - void PREFIX(end_team)(caf_team_t *); - void PREFIX(sync_team)(caf_team_t *, int); - int PREFIX(team_number)(caf_team_t *); -+#endif - - int PREFIX(image_status)(int); - void PREFIX(failed_images)(gfc_descriptor_t *, int, int *); -diff --git a/src/runtime-libraries/mpi/mpi_caf.c b/src/runtime-libraries/mpi/mpi_caf.c -index 8de5ad84d..98d2a3060 100644 ---- a/src/runtime-libraries/mpi/mpi_caf.c -+++ b/src/runtime-libraries/mpi/mpi_caf.c -@@ -208,13 +208,17 @@ static win_sync *last_elem = NULL; - static win_sync *pending_puts = NULL; - #endif - -+#ifndef GCC_GE_16 - /* Linked list of static coarrays registered. Do not expose to public in the -- * header, because it is implementation specific. */ -+ * header, because it is implementation specific. -+ * -+ * From gcc-15 on, this list is contained in the teams handling. */ - struct caf_allocated_tokens_t - { - caf_token_t token; - struct caf_allocated_tokens_t *prev; - } *caf_allocated_tokens = NULL; -+#endif - - #ifdef GCC_GE_7 - /* Linked list of slave coarrays registered. */ -@@ -227,7 +231,7 @@ struct caf_allocated_slave_tokens_t - - /* Image status variable */ - static int img_status = 0; --static MPI_Win *stat_tok; -+static MPI_Win stat_tok; - - /* Active messages variables */ - char **buff_am; -@@ -340,12 +344,59 @@ typedef struct gfc_max_dim_descriptor_t - - char err_buffer[MPI_MAX_ERROR_STRING]; - -+#ifdef GCC_GE_16 -+/* All CAF runtime calls should use this comm instead of MPI_COMM_WORLD for -+ * interoperability purposes. */ -+MPI_Comm *CAF_COMM_WORLD_store; -+#define CAF_COMM_WORLD (*CAF_COMM_WORLD_store) -+ -+typedef struct caf_teams_list -+{ -+ /* The communicator having all team members. */ -+ MPI_Comm communicator; -+ /* The unique id (over all other formed teams) of this team. */ -+ int team_id; -+ /* The id of this image in this team. */ -+ int image_id; -+ struct caf_teams_list *prev; -+} caf_teams_list_t; -+ -+typedef struct caf_team_stack_node -+{ -+ struct caf_teams_list *team_list_elem; -+ /* The list of tokens allocated in the current team. Needed to free them -+ * when the team is left. */ -+ struct allocated_tokens_t -+ { -+ mpi_caf_token_t *token; -+ struct allocated_tokens_t *next; -+ } *allocated_tokens; -+ struct caf_team_stack_node *parent; -+} caf_team_stack_node_t; -+ -+static caf_teams_list_t *teams_list = NULL; -+static caf_team_stack_node_t *current_team = NULL, *initial_team; -+#else - /* All CAF runtime calls should use this comm instead of MPI_COMM_WORLD for - * interoperability purposes. */ - MPI_Comm CAF_COMM_WORLD; - -+typedef struct caf_teams_list -+{ -+ caf_team_t team; -+ int team_id; -+ struct caf_teams_list *prev; -+} caf_teams_list; -+ -+typedef struct caf_used_teams_list -+{ -+ struct caf_teams_list *team_list_elem; -+ struct caf_used_teams_list *prev; -+} caf_used_teams_list; -+ - static caf_teams_list *teams_list = NULL; - static caf_used_teams_list *used_teams = NULL; -+#endif - - /* Emitted when a theorectically unreachable part is reached. */ - const char unreachable[] = "Fatal error: unreachable alternative found.\n"; -@@ -773,7 +824,7 @@ handle_is_present_message(ct_msg_t *msg, void *baseptr) - += sizeof_desc_for_rank(GFC_DESCRIPTOR_RANK((gfc_descriptor_t *)ptr)); - } - else -- ptr = baseptr; -+ ptr = &baseptr; - - accessor_hash_table[msg->accessor_index].u.is_present( - add_data, &msg->dest_image, &result, ptr, &src_token, 0); -@@ -1462,6 +1513,10 @@ PREFIX(init)(int *argc, char ***argv) - /* Flag rc as unused, because conditional compilation. */ - int ierr = 0, i = 0, j = 0, rc __attribute__((unused)), prov_lev = 0; - int is_init = 0, prior_thread_level = MPI_THREAD_MULTIPLE; -+#ifdef GCC_GE_16 -+ MPI_Comm tmp_world; -+#endif -+ - ierr = MPI_Initialized(&is_init); - chk_err(ierr); - -@@ -1507,7 +1562,12 @@ PREFIX(init)(int *argc, char ***argv) - - /* Duplicate MPI_COMM_WORLD so that no CAF internal functions use it. - * This is critical for MPI-interoperability. */ -+#ifdef GCC_GE_16 -+ rc = MPI_Comm_dup(MPI_COMM_WORLD, &tmp_world); -+ CAF_COMM_WORLD_store = &tmp_world; -+#else - rc = MPI_Comm_dup(MPI_COMM_WORLD, &CAF_COMM_WORLD); -+#endif - #ifdef WITH_FAILED_IMAGES - flag = (MPI_SUCCESS == rc); - rc = MPIX_Comm_agree(MPI_COMM_WORLD, &flag); -@@ -1548,8 +1608,16 @@ PREFIX(init)(int *argc, char ***argv) - sync_handles = malloc(caf_num_images * sizeof(MPI_Request)); - /* END SYNC IMAGE preparation. */ - -- stat_tok = malloc(sizeof(MPI_Win)); -- -+ /* BEGIN teams preparations. */ -+#ifdef GCC_GE_16 -+ teams_list = (caf_teams_list_t *)malloc(sizeof(caf_teams_list_t)); -+ *teams_list = (struct caf_teams_list){tmp_world, -1, caf_this_image, NULL}; -+ CAF_COMM_WORLD_store = &teams_list->communicator; -+ current_team -+ = (caf_team_stack_node_t *)malloc(sizeof(caf_team_stack_node_t)); -+ *current_team = (struct caf_team_stack_node){teams_list, NULL}; -+ initial_team = current_team; -+#else - teams_list = (caf_teams_list *)calloc(1, sizeof(caf_teams_list)); - teams_list->team_id = -1; - MPI_Comm *tmp_comm = (MPI_Comm *)calloc(1, sizeof(MPI_Comm)); -@@ -1559,6 +1627,8 @@ PREFIX(init)(int *argc, char ***argv) - used_teams = (caf_used_teams_list *)calloc(1, sizeof(caf_used_teams_list)); - used_teams->team_list_elem = teams_list; - used_teams->prev = NULL; -+#endif -+ /* END teams preparations. */ - - #ifdef WITH_FAILED_IMAGES - MPI_Comm_dup(MPI_COMM_WORLD, &alive_comm); -@@ -1592,12 +1662,12 @@ PREFIX(init)(int *argc, char ***argv) - - /* Setting img_status */ - ierr = MPI_Win_create(&img_status, sizeof(int), 1, mpi_info_same_size, -- CAF_COMM_WORLD, stat_tok); -+ CAF_COMM_WORLD, &stat_tok); - chk_err(ierr); -- CAF_Win_lock_all(*stat_tok); -+ CAF_Win_lock_all(stat_tok); - #else - ierr = MPI_Win_create(&img_status, sizeof(int), 1, MPI_INFO_NULL, -- CAF_COMM_WORLD, stat_tok); -+ CAF_COMM_WORLD, &stat_tok); - chk_err(ierr); - #endif // MPI_VERSION - -@@ -1645,7 +1715,7 @@ finalize_internal(int status_code) - chk_err(ierr); - #endif - /* For future security enclose setting img_status in a lock. */ -- CAF_Win_lock(MPI_LOCK_EXCLUSIVE, mpi_this_image, *stat_tok); -+ CAF_Win_lock(MPI_LOCK_EXCLUSIVE, mpi_this_image, stat_tok); - if (status_code == 0) - { - img_status = STAT_STOPPED_IMAGE; -@@ -1660,7 +1730,7 @@ finalize_internal(int status_code) - image_stati[mpi_this_image] = status_code; - #endif - } -- CAF_Win_unlock(mpi_this_image, *stat_tok); -+ CAF_Win_unlock(mpi_this_image, stat_tok); - - /* Announce to all other images, that this one has changed its execution - * status. */ -@@ -1739,6 +1809,43 @@ finalize_internal(int status_code) - #endif - - dprint("Freed all slave tokens.\n"); -+ -+#ifdef GCC_GE_16 -+ for (caf_team_stack_node_t *node = current_team; node;) -+ { -+ caf_team_stack_node_t *pn = node->parent; -+ MPI_Win *p; -+ -+ for (struct allocated_tokens_t *t = node->allocated_tokens; t;) -+ { -+ struct allocated_tokens_t *nt = t->next; -+ -+ p = TOKEN(t->token); -+ if (p != NULL) -+ CAF_Win_unlock_all(*p); -+ /* Unregister the window to the descriptors when freeing the token. */ -+ ierr = MPI_Win_free(p); -+ chk_err(ierr); -+ free(t->token); -+ free(t); -+ t = nt; -+ } -+ free(node); -+ node = pn; -+ } -+ current_team = initial_team = NULL; -+ -+ for (caf_teams_list_t *node = teams_list; node;) -+ { -+ caf_teams_list_t *pn = node->prev; -+ -+ if (node->team_id != -1) -+ MPI_Comm_free(&node->communicator); -+ -+ free(node); -+ node = pn; -+ } -+#else - struct caf_allocated_tokens_t *cur_tok = caf_allocated_tokens, - *prev = caf_allocated_tokens; - MPI_Win *p; -@@ -1762,6 +1869,7 @@ finalize_internal(int status_code) - free(cur_tok); - cur_tok = prev; - } -+#endif - #if MPI_VERSION >= 3 - ierr = MPI_Info_free(&mpi_info_same_size); - chk_err(ierr); -@@ -1815,7 +1923,7 @@ finalize_internal(int status_code) - MPI_Status status; - do - { -- ierr = MPI_Iprobe(MPI_ANY_SOURCE, MPI_ANY_TAG, CAF_COMM_WORLD, -+ ierr = MPI_Iprobe(MPI_ANY_SOURCE, MPI_ANY_TAG, MPI_COMM_WORLD, - &probe_flag, &status); /* error is not of interest. */ - if (probe_flag) - { -@@ -1823,18 +1931,20 @@ finalize_internal(int status_code) - MPI_Get_count(&status, MPI_BYTE, &cnt); - void *buf = alloca(cnt); - ierr = MPI_Recv(buf, cnt, MPI_BYTE, status.MPI_SOURCE, status.MPI_TAG, -- CAF_COMM_WORLD, &status); -+ MPI_COMM_WORLD, &status); - chk_err(ierr); - } - } while (probe_flag); - } - #endif -+#ifndef GCC_GE_16 - dprint("freeing caf's communicator.\n"); - ierr = MPI_Comm_free(&CAF_COMM_WORLD); - chk_err(ierr); -+#endif - -- CAF_Win_unlock_all(*stat_tok); -- ierr = MPI_Win_free(stat_tok); -+ CAF_Win_unlock_all(stat_tok); -+ ierr = MPI_Win_free(&stat_tok); - chk_err(ierr); - - /* Only call Finalize if CAF runtime Initialized MPI. */ -@@ -1865,6 +1975,40 @@ PREFIX(finalize)(void) - finalize_internal(0); - } - -+#ifdef GCC_GE_16 -+int -+PREFIX(this_image)(caf_team_t team) -+{ -+ return team ? ((caf_teams_list_t *)team)->image_id : caf_this_image; -+} -+ -+int -+PREFIX(num_images)(caf_team_t team, int32_t *team_number) -+{ -+ if (team) -+ { -+ caf_teams_list_t *t = (caf_teams_list_t *)team; -+ int comm_size = 0, ierr; -+ ierr = MPI_Comm_size(t->communicator, &comm_size); -+ chk_err(ierr); -+ return comm_size; -+ } -+ if (team_number) -+ { -+ for (caf_teams_list_t *curr = teams_list; curr; curr = curr->prev) -+ if (curr->team_id == *team_number) -+ { -+ int comm_size = 0, ierr; -+ ierr = MPI_Comm_size(curr->communicator, &comm_size); -+ chk_err(ierr); -+ return comm_size; -+ } -+ -+ caf_runtime_error("NUM_IMAGES: Unknown team_number %d", *team_number); -+ } -+ return caf_num_images; -+} -+#else - /* TODO: This is interface is violating the F2015 standard, but not the gfortran - * API. Fix it (the fortran API). */ - int -@@ -1881,6 +2025,7 @@ PREFIX(num_images)(int distance __attribute__((unused)), - { - return caf_num_images; - } -+#endif - - #ifdef GCC_GE_7 - /* Register an object with the coarray library creating a token where -@@ -2031,11 +2176,19 @@ void PREFIX(register)(size_t size, caf_register_t type, caf_token_t *token, - free(init_array); - } - -+#ifdef GCC_GE_16 -+ struct allocated_tokens_t *allocated_token -+ = malloc(sizeof(struct allocated_tokens_t)); -+ allocated_token->next = current_team->allocated_tokens; -+ allocated_token->token = *token; -+ current_team->allocated_tokens = allocated_token; -+#else - struct caf_allocated_tokens_t *tmp - = malloc(sizeof(struct caf_allocated_tokens_t)); - tmp->prev = caf_allocated_tokens; - tmp->token = *token; - caf_allocated_tokens = tmp; -+#endif - - if (stat) - *stat = 0; -@@ -2220,6 +2373,40 @@ PREFIX(deregister)(caf_token_t *token, int *stat, char *errmsg, - #endif - } - #endif // GCC_GE_7 -+#ifdef GCC_GE_16 -+ { -+ struct allocated_tokens_t *cur = current_team->allocated_tokens, -+ *prev = current_team->allocated_tokens; -+ MPI_Win *p; -+ -+ while (cur) -+ { -+ if (cur->token == *token) -+ { -+ p = TOKEN(*token); -+#ifdef GCC_GE_7 -+ dprint("Found regular token %p for memptr_win: %d.\n", *token, -+ ((mpi_caf_token_t *)*token)->memptr_win); -+#endif -+ CAF_Win_unlock_all(*p); -+ ierr = MPI_Win_free(p); -+ chk_err(ierr); -+ -+ if (cur == current_team->allocated_tokens) -+ current_team->allocated_tokens = cur->next; -+ else -+ prev->next = cur->next; -+ -+ free(cur); -+ free(*token); -+ *token = NULL; -+ return; -+ } -+ prev = cur; -+ cur = cur->next; -+ } -+ } -+#else - { - struct caf_allocated_tokens_t *cur = caf_allocated_tokens, - *next = caf_allocated_tokens, *prev; -@@ -2247,12 +2434,14 @@ PREFIX(deregister)(caf_token_t *token, int *stat, char *errmsg, - - free(cur); - free(*token); -+ *token = NULL; - return; - } - next = cur; - cur = prev; - } - } -+#endif - - #ifdef GCC_GE_7 - /* Feel through: Has to be a component token. */ -@@ -2297,6 +2486,7 @@ PREFIX(deregister)(caf_token_t *token, int *stat, char *errmsg, - free(cur_stok); - ierr = MPI_Free_mem(*token); - chk_err(ierr); -+ *token = NULL; - return; - } - -@@ -5498,6 +5688,54 @@ get_from_self(caf_token_t token, const gfc_descriptor_t *opt_src_desc, - } - } - -+bool -+team_translate(int *remote_image, int *this_image, caf_token_t token, -+ int image_index, caf_team_t *team, int *team_number, int *stat) -+{ -+ MPI_Group current_team_group, win_group; -+ int ierr; -+ int trans_ranks[2]; -+ MPI_Comm comm = CAF_COMM_WORLD; -+ -+#ifdef GCC_GE_16 -+ if (team) -+ comm = (*(caf_teams_list_t **)team)->communicator; -+ else if (team_number) -+ { -+ bool found = false; -+ for (caf_team_stack_node_t *cur = current_team; cur; cur = cur->parent) -+ if (cur->team_list_elem->team_id == *team_number) -+ { -+ comm = cur->team_list_elem->communicator; -+ found = true; -+ break; -+ } -+ if (!found) -+ { -+ caf_internal_error("Team number %d not found", stat, NULL, 0, -+ *team_number); -+ return false; -+ } -+ } -+#endif -+ -+ ierr = MPI_Comm_group(comm, ¤t_team_group); -+ chk_err(ierr); -+ ierr = MPI_Win_get_group(*TOKEN(token), &win_group); -+ chk_err(ierr); -+ ierr = MPI_Group_translate_ranks(current_team_group, 2, -+ (int[]){image_index - 1, mpi_this_image}, -+ win_group, trans_ranks); -+ chk_err(ierr); -+ *remote_image = trans_ranks[0]; -+ *this_image = trans_ranks[1]; -+ ierr = MPI_Group_free(¤t_team_group); -+ chk_err(ierr); -+ ierr = MPI_Group_free(&win_group); -+ chk_err(ierr); -+ return true; -+} -+ - /* Get data from a remote image's memory pointed to by `token`. The image is - * given by `image_index`. When the source is descriptor array, then - * `opt_src_desc` gives its dimension as of the source image. On the remote -@@ -5525,12 +5763,9 @@ PREFIX(get_from_remote)(caf_token_t token, const gfc_descriptor_t *opt_src_desc, - 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 __attribute__((unused)), -- int *team_number __attribute__((unused))) -+ caf_team_t *team, int *team_number) - { -- MPI_Group current_team_group, win_group; - int ierr, this_image, remote_image; -- int trans_ranks[2]; - bool free_t_buff, free_msg; - void *t_buff; - ct_msg_t *msg; -@@ -5553,20 +5788,9 @@ PREFIX(get_from_remote)(caf_token_t token, const gfc_descriptor_t *opt_src_desc, - // Get mapped remote image - if (external_call) - { -- ierr = MPI_Comm_group(CAF_COMM_WORLD, ¤t_team_group); -- chk_err(ierr); -- ierr = MPI_Win_get_group(*TOKEN(token), &win_group); -- chk_err(ierr); -- ierr = MPI_Group_translate_ranks(current_team_group, 2, -- (int[]){image_index - 1, mpi_this_image}, -- win_group, trans_ranks); -- chk_err(ierr); -- remote_image = trans_ranks[0]; -- this_image = trans_ranks[1]; -- ierr = MPI_Group_free(¤t_team_group); -- chk_err(ierr); -- ierr = MPI_Group_free(&win_group); -- chk_err(ierr); -+ if (unlikely(!team_translate(&remote_image, &this_image, token, image_index, -+ team, team_number, stat))) -+ return; - } - else - { -@@ -5757,10 +5981,10 @@ PREFIX(is_present_on_remote)(caf_token_t token, const int image_index, - - check_image_health(remote_image, stat); - -- dprint( -- "Entering is_present_on_remote(), token = %p, win_rank = %d, this_rank = " -- "%d, is_present index = %d, sizeof(msg) = %ld.\n", -- token, remote_image, this_image, is_present_index, msg_size); -+ dprint("Entering is_present_on_remote(), token = %p, memptr = %p, win_rank = " -+ "%d, this_rank = %d, is_present index = %d, sizeof(msg) = %ld.\n", -+ token, ((mpi_caf_token_t *)token)->memptr, remote_image, this_image, -+ is_present_index, msg_size); - - if (this_image == remote_image) - { -@@ -5770,7 +5994,7 @@ PREFIX(is_present_on_remote)(caf_token_t token, const int image_index, - - dprint("Shortcutting due to self access on image %d.\n", image_index); - accessor_hash_table[is_present_index].u.is_present( -- add_data, &this_image, &result, src_ptr, &src_token, 0); -+ add_data, &this_image, &result, &src_ptr, &src_token, 0); - - return result; - } -@@ -5915,13 +6139,10 @@ PREFIX(send_to_remote)(caf_token_t token, gfc_descriptor_t *opt_dst_desc, - size_t *opt_src_charlen, - const gfc_descriptor_t *opt_src_desc, - const int setter_index, void *add_data, -- const size_t add_data_size, int *stat, -- caf_team_t *team __attribute__((unused)), -- int *team_number __attribute__((unused))) -+ const size_t add_data_size, int *stat, caf_team_t *team, -+ int *team_number) - { -- MPI_Group current_team_group, win_group; - int ierr, this_image, remote_image; -- int trans_ranks[2]; - bool free_msg; - ct_msg_t *msg; - const bool dst_incl_desc = opt_dst_desc, has_src_desc = opt_src_desc, -@@ -5944,20 +6165,9 @@ PREFIX(send_to_remote)(caf_token_t token, gfc_descriptor_t *opt_dst_desc, - // Get mapped remote image - if (external_call) - { -- ierr = MPI_Comm_group(CAF_COMM_WORLD, ¤t_team_group); -- chk_err(ierr); -- ierr = MPI_Win_get_group(*TOKEN(token), &win_group); -- chk_err(ierr); -- ierr = MPI_Group_translate_ranks(current_team_group, 2, -- (int[]){image_index - 1, mpi_this_image}, -- win_group, trans_ranks); -- chk_err(ierr); -- remote_image = trans_ranks[0]; -- this_image = trans_ranks[1]; -- ierr = MPI_Group_free(¤t_team_group); -- chk_err(ierr); -- ierr = MPI_Group_free(&win_group); -- chk_err(ierr); -+ if (unlikely(!team_translate(&remote_image, &this_image, token, image_index, -+ team, team_number, stat))) -+ return; - } - else - { -@@ -6106,10 +6316,8 @@ PREFIX(transfer_between_remotes)( - const int src_image_index, const int src_access_index, void *src_add_data, - const size_t src_add_data_size, const size_t in_src_size, - const bool scalar_transfer, int *dst_stat, int *src_stat, -- caf_team_t *dst_team __attribute__((unused)), -- int *dst_team_number __attribute__((unused)), -- caf_team_t *src_team __attribute__((unused)), -- int *src_team_number __attribute__((unused))) -+ caf_team_t *dst_team, int *dst_team_number, caf_team_t *src_team, -+ int *src_team_number) - { - MPI_Group current_team_group, win_group; - int ierr, this_image, src_remote_image, dst_remote_image; -@@ -6138,22 +6346,14 @@ PREFIX(transfer_between_remotes)( - *src_stat = 0; - - // Get mapped remote image -- ierr = MPI_Comm_group(CAF_COMM_WORLD, ¤t_team_group); -- chk_err(ierr); -- ierr = MPI_Win_get_group(*TOKEN(src_token), &win_group); -- chk_err(ierr); -- ierr = MPI_Group_translate_ranks( -- current_team_group, 3, -- (int[]){src_image_index - 1, dst_image_index - 1, mpi_this_image}, -- win_group, trans_ranks); -- chk_err(ierr); -- src_remote_image = trans_ranks[0]; -- dst_remote_image = trans_ranks[1]; -- this_image = trans_ranks[2]; -- ierr = MPI_Group_free(¤t_team_group); -- chk_err(ierr); -- ierr = MPI_Group_free(&win_group); -- chk_err(ierr); -+ if (unlikely(!team_translate(&src_remote_image, &this_image, src_token, -+ src_image_index, src_team, src_team_number, -+ src_stat))) -+ return; -+ if (unlikely(!team_translate(&dst_remote_image, &this_image, dst_token, -+ dst_image_index, dst_team, dst_team_number, -+ dst_stat))) -+ return; - - dprint("team-map: dst(in) %d -> %d, src(in) %d -> %d, this %d -> %d.\n", - dst_image_index, dst_remote_image, src_image_index, src_remote_image, -@@ -10152,6 +10352,55 @@ unsupported_fail_images_message(const char *functionname) - #endif - } - -+#ifdef GCC_GE_16 -+void -+PREFIX(form_team)(int team_id, caf_team_t *team, int *new_index, int *stat, -+ char *errmsg, charlen_t errmsg_len) -+{ -+ static const char *duplicate_team_id -+ = "FORM TEAM: Team ids have to be unique"; -+ static const char *negative_team_id -+ = "FORM TEAM: Team id shall be a positive unique integer"; -+ static const char *negative_new_index -+ = "FORM TEAM: NEW_INDEX= shall be a positive unique integer"; -+ caf_teams_list_t *new_team; -+ MPI_Comm current_comm = CAF_COMM_WORLD; -+ int ierr; -+ int key = new_index ? *new_index : caf_this_image; -+ -+ if (stat) -+ *stat = 0; -+ -+ for (caf_teams_list_t *cur = teams_list; cur; cur = cur->prev) -+ if (cur->team_id == team_id) -+ { -+ caf_internal_error(duplicate_team_id, stat, errmsg, errmsg_len); -+ return; -+ } -+ if (team_id < 0) -+ { -+ caf_internal_error(negative_team_id, stat, errmsg, errmsg_len); -+ return; -+ } -+ if (new_index && *new_index < 0) -+ { -+ caf_internal_error(negative_new_index, stat, errmsg, errmsg_len); -+ return; -+ } -+ -+ new_team = (caf_teams_list_t *)malloc(sizeof(struct caf_teams_list)); -+ new_team->team_id = team_id; -+ new_team->image_id = key; -+ new_team->prev = teams_list; -+ -+ ierr -+ = MPI_Comm_split(current_comm, team_id, key - 1, &new_team->communicator); -+ chk_err(ierr); -+ -+ teams_list = new_team; -+ *team = new_team; -+} -+#else - void - PREFIX(form_team)(int team_id, caf_team_t *team, - int index __attribute__((unused))) -@@ -10172,7 +10421,43 @@ PREFIX(form_team)(int team_id, caf_team_t *team, - teams_list->team = newcomm; - *team = tmp; - } -+#endif - -+#ifdef GCC_GE_16 -+void -+PREFIX(change_team)(caf_team_t team, int *stat, char *errmsg, -+ charlen_t errmsg_len) -+{ -+ caf_team_stack_node_t *new_current_team = NULL; -+ caf_teams_list_t *provisioned_team = (caf_teams_list_t *)team; -+ int ierr; -+ -+ if (stat) -+ *stat = 0; -+ -+ if (provisioned_team == NULL) -+ { -+ caf_internal_error("CHANGE TEAM: Called on a non-existing team", stat, -+ errmsg, errmsg_len); -+ return; -+ } -+ -+ new_current_team -+ = (caf_team_stack_node_t *)malloc(sizeof(caf_team_stack_node_t)); -+ *new_current_team -+ = (caf_team_stack_node_t){provisioned_team, NULL, current_team}; -+ -+ current_team = new_current_team; -+ CAF_COMM_WORLD_store = ¤t_team->team_list_elem->communicator; -+ ierr = MPI_Comm_rank(CAF_COMM_WORLD, &mpi_this_image); -+ chk_err(ierr); -+ caf_this_image = mpi_this_image + 1; -+ ierr = MPI_Comm_size(CAF_COMM_WORLD, &caf_num_images); -+ chk_err(ierr); -+ ierr = MPI_Barrier(CAF_COMM_WORLD); -+ chk_err(ierr); -+} -+#else - void - PREFIX(change_team)(caf_team_t *team, int coselector __attribute__((unused))) - { -@@ -10196,13 +10481,13 @@ PREFIX(change_team)(caf_team_t *team, int coselector __attribute__((unused))) - /* - tmp_list = teams_list; - -- while (tmp_list) -- { -- if (tmp_list->team == tmp_team) -- break; -- tmp_list = tmp_list->prev; -- } -- */ -+ while (tmp_list) -+ { -+ if (tmp_list->team == tmp_team) -+ break; -+ tmp_list = tmp_list->prev; -+ } -+ */ - - if (tmp_list == NULL) - caf_runtime_error("CHANGE TEAM called on a non-existing team"); -@@ -10220,7 +10505,49 @@ PREFIX(change_team)(caf_team_t *team, int coselector __attribute__((unused))) - ierr = MPI_Barrier(*tmp_comm); - chk_err(ierr); - } -+#endif - -+#ifdef GCC_GE_16 -+MPI_Fint -+PREFIX(get_communicator)(caf_team_t *team) -+{ -+ caf_teams_list_t *cur_team = team ? *team : current_team->team_list_elem; -+ -+ MPI_Fint ret = MPI_Comm_c2f(cur_team->communicator); -+ -+ return ret; -+} -+ -+int -+PREFIX(team_number)(caf_team_t team) -+{ -+ if (team != NULL) -+ return ((caf_teams_list_t *)team)->team_id; -+ else -+ return current_team->team_list_elem->team_id; /* current team */ -+} -+ -+caf_team_t -+PREFIX(get_team)(int32_t *level) -+{ -+ if (!level) -+ return current_team->team_list_elem; -+ -+ switch ((caf_team_level_t)*level) -+ { -+ case CAF_INITIAL_TEAM: -+ return initial_team->team_list_elem; -+ case CAF_PARENT_TEAM: -+ return current_team->parent ? current_team->parent->team_list_elem -+ : initial_team->team_list_elem; -+ case CAF_CURRENT_TEAM: -+ return current_team->team_list_elem; -+ default: -+ caf_runtime_error("Illegal value for GET_TEAM"); -+ } -+ return NULL; /* To prevent any warnings. */ -+} -+#else - MPI_Fint - PREFIX(get_communicator)(caf_team_t *team) - { -@@ -10232,7 +10559,6 @@ PREFIX(get_communicator)(caf_team_t *team) - MPI_Fint ret = MPI_Comm_c2f(*comm_ptr); - - return ret; -- // return *(int*)comm_ptr; - } - - int -@@ -10243,7 +10569,48 @@ PREFIX(team_number)(caf_team_t *team) - else - return used_teams->team_list_elem->team_id; /* current team */ - } -+#endif -+ -+#ifdef GCC_GE_16 -+void -+PREFIX(end_team)(int *stat, char *errmsg, charlen_t errmsg_len) -+{ -+ caf_team_stack_node_t *ending_team = current_team; -+ int ierr; -+ -+ if (stat) -+ *stat = 0; -+ -+ ierr = MPI_Barrier(CAF_COMM_WORLD); -+ chk_err(ierr); -+ if (current_team->parent == NULL) -+ { -+ caf_internal_error("END TEAM called on initial team", stat, errmsg, -+ errmsg_len); -+ return; -+ } - -+ for (struct allocated_tokens_t *ac = current_team->allocated_tokens; ac;) -+ { -+ struct allocated_tokens_t *nac = ac->next; -+ -+ PREFIX(deregister)((void **)&ac->token, -+ CAF_DEREGTYPE_COARRAY_DEALLOCATE_ONLY, stat, errmsg, -+ errmsg_len); -+ free(ac); -+ ac = nac; -+ } -+ current_team = current_team->parent; -+ -+ CAF_COMM_WORLD_store = ¤t_team->team_list_elem->communicator; -+ ierr = MPI_Comm_rank(CAF_COMM_WORLD, &mpi_this_image); -+ chk_err(ierr); -+ caf_this_image = mpi_this_image + 1; -+ ierr = MPI_Comm_size(CAF_COMM_WORLD, &caf_num_images); -+ chk_err(ierr); -+ free(ending_team); -+} -+#else - void - PREFIX(end_team)(caf_team_t *team __attribute__((unused))) - { -@@ -10271,7 +10638,40 @@ PREFIX(end_team)(caf_team_t *team __attribute__((unused))) - ierr = MPI_Comm_size(CAF_COMM_WORLD, &caf_num_images); - chk_err(ierr); - } -+#endif - -+#ifdef GCC_GE_16 -+void -+PREFIX(sync_team)(caf_team_t team, int *stat, char *errmsg, -+ charlen_t errmsg_len) -+{ -+ caf_teams_list_t *team_to_sync = (caf_teams_list_t *)team; -+ caf_team_stack_node_t *active_team = current_team; -+ -+ if (stat) -+ *stat = 0; -+ -+ /* Check if team to sync is a child of the current team, aka not changed to -+ * yet. -+ */ -+ if (team_to_sync->prev != active_team->team_list_elem) -+ /* if the team is not a child */ -+ for (; active_team && active_team->team_list_elem != team_to_sync; -+ active_team = active_team->parent) -+ ; -+ -+ if (!active_team) -+ { -+ caf_internal_error("SYNC TEAM: Called on team different from current, " -+ "or ancestor, or child", -+ stat, errmsg, errmsg_len); -+ return; -+ } -+ -+ int ierr = MPI_Barrier(team_to_sync->communicator); -+ chk_err(ierr); -+} -+#else - void - PREFIX(sync_team)(caf_team_t *team, int unused __attribute__((unused))) - { -@@ -10303,6 +10703,7 @@ PREFIX(sync_team)(caf_team_t *team, int unused __attribute__((unused))) - int ierr = MPI_Barrier(*tmp_comm); - chk_err(ierr); - } -+#endif - - extern void - _gfortran_random_seed_i4(int32_t *size, gfc_dim1_descriptor_t *put, -diff --git a/src/tests/unit/teams/CMakeLists.txt b/src/tests/unit/teams/CMakeLists.txt -index 2b72d8d35..e5d5eb9db 100644 ---- a/src/tests/unit/teams/CMakeLists.txt -+++ b/src/tests/unit/teams/CMakeLists.txt -@@ -1,4 +1,4 @@ --caf_compile_executable(team_number team-number.f90) -+caf_compile_executable(team_number_pre15 team_number_pre15.f90) - caf_compile_executable(teams_subset teams_subset.f90) - caf_compile_executable(get_communicator get-communicator.F90) - caf_compile_executable(teams_coarray_get teams_coarray_get.f90) -@@ -7,3 +7,8 @@ caf_compile_executable(teams_coarray_send teams_coarray_send.f90) - caf_compile_executable(teams_coarray_send_by_ref teams_coarray_send.f90) - caf_compile_executable(teams_coarray_sendget teams_coarray_sendget.f90) - caf_compile_executable(sync_team sync-team.f90) -+if (gfortran_compiler AND (NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 16.0.0)) -+ caf_compile_executable(team_number team_number.f90) -+ caf_compile_executable(teams_this_image teams_this_image.f90) -+ caf_compile_executable(teams_num_images teams_num_images.f90) -+endif() -diff --git a/src/tests/unit/teams/team_number.f90 b/src/tests/unit/teams/team_number.f90 -new file mode 100644 -index 000000000..e34b339d2 ---- /dev/null -+++ b/src/tests/unit/teams/team_number.f90 -@@ -0,0 +1,68 @@ -+! BSD 3-Clause License -+! -+! Copyright (c) 2018-2019, Sourcery Institute -+! All rights reserved. -+! -+! Redistribution and use in source and binary forms, with or without -+! modification, are permitted provided that the following conditions are met: -+! -+! * Redistributions of source code must retain the above copyright notice, this -+! list of conditions and the following disclaimer. -+! -+! * Redistributions in binary form must reproduce the above copyright notice, -+! this list of conditions and the following disclaimer in the documentation -+! and/or other materials provided with the distribution. -+! -+! * Neither the name of the copyright holder nor the names of its -+! contributors may be used to endorse or promote products derived from -+! this software without specific prior written permission. -+! -+! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -+! AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -+! IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -+! DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE -+! FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -+! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -+! SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER -+! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, -+! OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -+! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -+program main -+ !! summary: Test team_number intrinsic function -+ use iso_fortran_env, only : team_type, current_team -+ use iso_c_binding, only : c_loc -+ use oc_assertions_interface, only : assert -+ -+ implicit none -+ -+ integer, parameter :: standard_initial_value=-1 -+ -+ type(team_type) :: parent, child -+ -+ if (num_images() < 8) error stop "I need at least 8 images to function." -+ -+ call assert(team_number()==standard_initial_value,"initial team number conforms with Fortran standard before 'change team'") -+ -+ call assert(team_number(get_team(current_team))==standard_initial_value,"initial team number conforms with Fortran standard before 'change team'") -+ -+ after_change_team: block -+ associate(parent_team_number => 100 + (num_images()-1)/4, child_team_number => 1000 + mod(num_images()-1,4)/2) -+ !! Prepare for forming two teams: my_team = 1 for even image numbers in the initial team; 2 for odd image numbers -+ form team(parent_team_number,parent) -+ change team(parent) -+ call assert(team_number()==parent_team_number,"team number conforms with Fortran standard after 'change team'") -+ form team (child_team_number, child) -+ change team(child) -+ call assert(team_number()==child_team_number,"team number conforms with Fortran standard after 'change team'") -+ call assert(team_number(child)==child_team_number,"team_number(child) conforms with Fortran standard after 'change team'") -+ call assert(team_number(parent)==parent_team_number,"team_number(parent) conforms with Fortran standard") -+ end team -+ end team -+ call assert(team_number()==standard_initial_value,"initial team number conforms with Fortran standard") -+ end associate -+ end block after_change_team -+ -+ sync all -+ if (this_image()==1) print *,"Test passed." -+ -+end program -diff --git a/src/tests/unit/teams/team-number.f90 b/src/tests/unit/teams/team_number_pre15.f90 -similarity index 100% -rename from src/tests/unit/teams/team-number.f90 -rename to src/tests/unit/teams/team_number_pre15.f90 -diff --git a/src/tests/unit/teams/teams_num_images.f90 b/src/tests/unit/teams/teams_num_images.f90 -new file mode 100644 -index 000000000..b90a9105f ---- /dev/null -+++ b/src/tests/unit/teams/teams_num_images.f90 -@@ -0,0 +1,52 @@ -+! BSD 3-Clause License -+! -+! Copyright (c) 2018-2025, Sourcery Institute -+! All rights reserved. -+! -+! Redistribution and use in source and binary forms, with or without -+! modification, are permitted provided that the following conditions are met: -+! -+! * Redistributions of source code must retain the above copyright notice, this -+! list of conditions and the following disclaimer. -+! -+! * Redistributions in binary form must reproduce the above copyright notice, -+! this list of conditions and the following disclaimer in the documentation -+! and/or other materials provided with the distribution. -+! -+! * Neither the name of the copyright holder nor the names of its -+! contributors may be used to endorse or promote products derived from -+! this software without specific prior written permission. -+! -+! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -+! AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -+! IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -+! DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE -+! FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -+! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -+! SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER -+! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, -+! OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -+! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -+use, intrinsic :: iso_fortran_env, only: team_type -+ -+type(team_type) :: team -+ -+associate(me => this_image(), num => num_images()) -+ sync all -+ form team(MOD(me, 2) + 1, team) -+ -+ j1 = num_images() -+ if (j1 /= num) stop 1 -+ -+ j2 = num_images(team) -+ if (j2 /= num / 2) stop 2 -+ -+ j3 = num_images(MOD(me, 2) + 1) -+ if (j3 /= num / 2) stop 3 -+ -+ sync all -+ -+ if (me == 1) print *,"Test passed." -+end associate -+ -+end -diff --git a/src/tests/unit/teams/teams_this_image.f90 b/src/tests/unit/teams/teams_this_image.f90 -new file mode 100644 -index 000000000..4f683f1d1 ---- /dev/null -+++ b/src/tests/unit/teams/teams_this_image.f90 -@@ -0,0 +1,108 @@ -+! BSD 3-Clause License -+! -+! Copyright (c) 2018-2025, Sourcery Institute -+! All rights reserved. -+! -+! Redistribution and use in source and binary forms, with or without -+! modification, are permitted provided that the following conditions are met: -+! -+! * Redistributions of source code must retain the above copyright notice, this -+! list of conditions and the following disclaimer. -+! -+! * Redistributions in binary form must reproduce the above copyright notice, -+! this list of conditions and the following disclaimer in the documentation -+! and/or other materials provided with the distribution. -+! -+! * Neither the name of the copyright holder nor the names of its -+! contributors may be used to endorse or promote products derived from -+! this software without specific prior written permission. -+! -+! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -+! AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -+! IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -+! DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE -+! FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -+! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -+! SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER -+! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, -+! OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -+! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -+use, intrinsic :: iso_fortran_env, only: team_type -+ -+integer :: caf(2,2)[3,*], sub(2) -+integer, allocatable :: res(:) -+type(team_type) :: team -+ -+form team(1, team, new_index=MOD(this_image() + 43, num_images()) + 1) -+ -+associate(me => this_image(), num => num_images()) -+ associate(n_ind => MOD(me + 43, num) + 1) -+ -+ j1 = this_image() -+ if (j1 /= me) stop 1 -+ -+ sub = c_t_i(lcobound(caf), ucobound(caf), me) -+ res = this_image(caf) -+ if (any (res /= sub)) stop 2 -+ -+ j2 = this_image(caf, 1) -+ if (j2 /= sub(1)) stop 3 -+ -+ j3 = this_image(team) -+ if (j3 /= n_ind) stop 4 -+ -+ sub = c_t_i(lcobound(caf), ucobound(caf), n_ind) -+ res = this_image(caf, team) -+ if (any(res /= sub)) stop 5 -+ -+ j4 = this_image(caf, 1, team) -+ if (j4 /= sub(1)) stop 6 -+ -+ change team(team) -+ j5 = this_image() -+ if (j5 /= n_ind) stop 11 -+ -+ sub = c_t_i(lcobound(caf), ucobound(caf), n_ind) -+ res = this_image(caf) -+ if (any (res /= sub)) stop 12 -+ -+ j6 = this_image(caf, 1) -+ if (j6 /= sub(1)) stop 13 -+ -+ j7 = this_image(team) -+ if (j7 /= n_ind) stop 14 -+ -+ sub = c_t_i(lcobound(caf), ucobound(caf), n_ind) -+ res = this_image(caf, team) -+ if (any(res /= sub)) stop 15 -+ -+ j8 = this_image(caf, 1, team) -+ if (j8 /= sub(1)) stop 16 -+ -+ end team -+ sync all -+ -+ if (me == 1) print *,"Test passed." -+ end associate -+end associate -+ -+contains -+ -+function c_t_i(lco, uco, me) result(sub) -+ integer, intent(in) :: lco(:), uco(:) -+ integer, intent(in) :: me -+ integer :: i, n, m, ml, extend -+ integer :: sub(size(lco)) -+ -+ n = size(lco) -+ m = me - 1 -+ do i = 1, n - 1 -+ extend = uco(i) - lco(i) + 1 -+ ml = m -+ m = m / extend -+ sub(i) = ml - m * extend + lco(i) -+ end do -+ sub(n) = m + lco(n) -+ -+end function -+end diff --git a/sys-cluster/opencoarrays/files/opencoarrays-2.10.3_patch_02_Fix_team_number.patch b/sys-cluster/opencoarrays/files/opencoarrays-2.10.3_patch_02_Fix_team_number.patch deleted file mode 100644 index 8357195e16..0000000000 --- a/sys-cluster/opencoarrays/files/opencoarrays-2.10.3_patch_02_Fix_team_number.patch +++ /dev/null @@ -1,159 +0,0 @@ -From 9a82ef47e7d0d19fdc493506cb7197b4901f2070 Mon Sep 17 00:00:00 2001 -From: Andre Vehreschild -Date: Mon, 28 Apr 2025 09:00:46 +0200 -Subject: [PATCH] Fix team_number test. - ---- - CMakeLists.txt | 4 +- - src/tests/unit/teams/CMakeLists.txt | 3 +- - .../{team_number.f90 => team_number.F90} | 4 +- - src/tests/unit/teams/team_number_pre15.f90 | 71 ------------------- - 4 files changed, 5 insertions(+), 77 deletions(-) - rename src/tests/unit/teams/{team_number.f90 => team_number.F90} (98%) - delete mode 100644 src/tests/unit/teams/team_number_pre15.f90 - -diff --git a/CMakeLists.txt b/CMakeLists.txt -index 888613454..8f9ee35ae 100644 ---- a/CMakeLists.txt -+++ b/CMakeLists.txt -@@ -806,6 +806,7 @@ if(opencoarrays_aware_compiler) - add_caf_test(comp_allocated_2 2 comp_allocated_2) - add_caf_test(alloc_comp_get_convert_nums 2 alloc_comp_get_convert_nums) - if(NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 8) -+ add_caf_test(team_number 8 team_number) - add_caf_test(teams_subset 3 teams_subset) - add_caf_test(get_communicator 3 get_communicator) - add_caf_test(teams_coarray_get 5 teams_coarray_get) -@@ -818,11 +819,8 @@ if(opencoarrays_aware_compiler) - set_tests_properties(alloc_comp_multidim_shape PROPERTIES TIMEOUT 300) - endif() - if(NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 15) -- add_caf_test(team_number 8 team_number) - add_caf_test(teams_this_image 8 teams_this_image) - add_caf_test(teams_num_images 8 teams_num_images) -- else() -- add_caf_test(team_number_pre15 8 team_number_pre15) - endif() - endif() - -diff --git a/src/tests/unit/teams/CMakeLists.txt b/src/tests/unit/teams/CMakeLists.txt -index e5d5eb9db..8307b0788 100644 ---- a/src/tests/unit/teams/CMakeLists.txt -+++ b/src/tests/unit/teams/CMakeLists.txt -@@ -1,4 +1,4 @@ --caf_compile_executable(team_number_pre15 team_number_pre15.f90) -+caf_compile_executable(team_number team_number.F90) - caf_compile_executable(teams_subset teams_subset.f90) - caf_compile_executable(get_communicator get-communicator.F90) - caf_compile_executable(teams_coarray_get teams_coarray_get.f90) -@@ -8,7 +8,6 @@ caf_compile_executable(teams_coarray_send_by_ref teams_coarray_send.f90) - caf_compile_executable(teams_coarray_sendget teams_coarray_sendget.f90) - caf_compile_executable(sync_team sync-team.f90) - if (gfortran_compiler AND (NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 16.0.0)) -- caf_compile_executable(team_number team_number.f90) - caf_compile_executable(teams_this_image teams_this_image.f90) - caf_compile_executable(teams_num_images teams_num_images.f90) - endif() -diff --git a/src/tests/unit/teams/team_number.f90 b/src/tests/unit/teams/team_number.F90 -similarity index 98% -rename from src/tests/unit/teams/team_number.f90 -rename to src/tests/unit/teams/team_number.F90 -index e34b339d2..a50ebd676 100644 ---- a/src/tests/unit/teams/team_number.f90 -+++ b/src/tests/unit/teams/team_number.F90 -@@ -29,7 +29,7 @@ - ! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - program main - !! summary: Test team_number intrinsic function -- use iso_fortran_env, only : team_type, current_team -+ use, intrinsic :: iso_fortran_env - use iso_c_binding, only : c_loc - use oc_assertions_interface, only : assert - -@@ -43,7 +43,9 @@ program main - - call assert(team_number()==standard_initial_value,"initial team number conforms with Fortran standard before 'change team'") - -+#ifdef GCC_GE_15 - call assert(team_number(get_team(current_team))==standard_initial_value,"initial team number conforms with Fortran standard before 'change team'") -+#endif - - after_change_team: block - associate(parent_team_number => 100 + (num_images()-1)/4, child_team_number => 1000 + mod(num_images()-1,4)/2) -diff --git a/src/tests/unit/teams/team_number_pre15.f90 b/src/tests/unit/teams/team_number_pre15.f90 -deleted file mode 100644 -index 7cc1a8758..000000000 ---- a/src/tests/unit/teams/team_number_pre15.f90 -+++ /dev/null -@@ -1,71 +0,0 @@ --! BSD 3-Clause License --! --! Copyright (c) 2018-2019, Sourcery Institute --! All rights reserved. --! --! Redistribution and use in source and binary forms, with or without --! modification, are permitted provided that the following conditions are met: --! --! * Redistributions of source code must retain the above copyright notice, this --! list of conditions and the following disclaimer. --! --! * Redistributions in binary form must reproduce the above copyright notice, --! this list of conditions and the following disclaimer in the documentation --! and/or other materials provided with the distribution. --! --! * Neither the name of the copyright holder nor the names of its --! contributors may be used to endorse or promote products derived from --! this software without specific prior written permission. --! --! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" --! AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE --! IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE --! DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE --! FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL --! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR --! SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER --! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, --! OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE --! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. --program main -- !! summary: Test team_number intrinsic function -- use iso_fortran_env, only : team_type -- use iso_c_binding, only : c_loc -- use oc_assertions_interface, only : assert -- -- implicit none -- -- integer, parameter :: standard_initial_value=-1 -- -- type(team_type) :: parent, child -- -- if (num_images() < 8) error stop "I need at least 8 images to function." -- -- call assert(team_number()==standard_initial_value,"initial team number conforms with Fortran standard before 'change team'") -- -- !call assert( -- ! team_number(c_loc(home))==standard_initial_value,"initial team number conforms with Fortran standard before 'change team'" -- !) -- !! TODO: uncomment the above assertion after implementing support for team_number's optional argument: -- -- after_change_team: block -- associate(parent_team_number => 100 + (num_images()-1)/4, child_team_number => 1000 + mod(num_images()-1,4)/2) -- !! Prepare for forming two teams: my_team = 1 for even image numbers in the initial team; 2 for odd image numbers -- form team(parent_team_number,parent) -- change team(parent) -- call assert(team_number()==parent_team_number,"team number conforms with Fortran standard after 'change team'") -- form team (child_team_number, child) -- change team(child) -- call assert(team_number()==child_team_number,"team number conforms with Fortran standard after 'change team'") -- call assert(team_number(child)==child_team_number,"team_number(child) conforms with Fortran standard after 'change team'") -- call assert(team_number(parent)==parent_team_number,"team_number(parent) conforms with Fortran standard") -- end team -- end team -- call assert(team_number()==standard_initial_value,"initial team number conforms with Fortran standard") -- end associate -- end block after_change_team -- -- sync all -- if (this_image()==1) print *,"Test passed." -- --end program diff --git a/sys-cluster/opencoarrays/files/opencoarrays-2.10.3_patch_03_Remove_wrong_error.patch b/sys-cluster/opencoarrays/files/opencoarrays-2.10.3_patch_03_Remove_wrong_error.patch deleted file mode 100644 index 3cd9127147..0000000000 --- a/sys-cluster/opencoarrays/files/opencoarrays-2.10.3_patch_03_Remove_wrong_error.patch +++ /dev/null @@ -1,36 +0,0 @@ -From c49237b2319016bfbd0acdf50de607339005c378 Mon Sep 17 00:00:00 2001 -From: Andre Vehreschild -Date: Mon, 14 Apr 2025 10:54:16 +0200 -Subject: [PATCH] Remove wrong error. - -Issuing this error was a misinterpretation of the standard. ---- - src/runtime-libraries/mpi/mpi_caf.c | 8 -------- - 1 file changed, 8 deletions(-) - -diff --git a/src/runtime-libraries/mpi/mpi_caf.c b/src/runtime-libraries/mpi/mpi_caf.c -index 98d2a306..39dadf7d 100644 ---- a/src/runtime-libraries/mpi/mpi_caf.c -+++ b/src/runtime-libraries/mpi/mpi_caf.c -@@ -10357,8 +10357,6 @@ void - PREFIX(form_team)(int team_id, caf_team_t *team, int *new_index, int *stat, - char *errmsg, charlen_t errmsg_len) - { -- static const char *duplicate_team_id -- = "FORM TEAM: Team ids have to be unique"; - static const char *negative_team_id - = "FORM TEAM: Team id shall be a positive unique integer"; - static const char *negative_new_index -@@ -10371,12 +10369,6 @@ PREFIX(form_team)(int team_id, caf_team_t *team, int *new_index, int *stat, - if (stat) - *stat = 0; - -- for (caf_teams_list_t *cur = teams_list; cur; cur = cur->prev) -- if (cur->team_id == team_id) -- { -- caf_internal_error(duplicate_team_id, stat, errmsg, errmsg_len); -- return; -- } - if (team_id < 0) - { - caf_internal_error(negative_team_id, stat, errmsg, errmsg_len); diff --git a/sys-cluster/opencoarrays/files/opencoarrays-2.10.3_patch_04_Enchance_debug_logging.patch b/sys-cluster/opencoarrays/files/opencoarrays-2.10.3_patch_04_Enchance_debug_logging.patch deleted file mode 100644 index 19886e3565..0000000000 --- a/sys-cluster/opencoarrays/files/opencoarrays-2.10.3_patch_04_Enchance_debug_logging.patch +++ /dev/null @@ -1,100 +0,0 @@ -From e24b96abe083753dc5595ea5a1b4b26e6104280c Mon Sep 17 00:00:00 2001 -From: Andre Vehreschild -Date: Wed, 16 Apr 2025 13:38:57 +0200 -Subject: [PATCH] Enhance debug logging. - ---- - src/runtime-libraries/mpi/mpi_caf.c | 30 +++++++++++++++++++++++------ - 1 file changed, 24 insertions(+), 6 deletions(-) - -diff --git a/src/runtime-libraries/mpi/mpi_caf.c b/src/runtime-libraries/mpi/mpi_caf.c -index 39dadf7d..90b5c952 100644 ---- a/src/runtime-libraries/mpi/mpi_caf.c -+++ b/src/runtime-libraries/mpi/mpi_caf.c -@@ -69,10 +69,19 @@ static char *caf_ref_type_str[] = { - #define dprint(...) - #define chk_err(...) - #else -+#ifdef GCC_GE_16 -+#define dprint(format, ...) \ -+ fprintf(stderr, "%d/%d (t(%d):%d/%d): %s(%d) " format, \ -+ global_this_image + 1, global_num_images, \ -+ current_team ? current_team->team_list_elem->team_id : -99, \ -+ caf_this_image, caf_num_images, __FUNCTION__, __LINE__, \ -+ ##__VA_ARGS__) -+#else - #define dprint(format, ...) \ -- fprintf(stderr, "%d/%d (t:%d/%d): %s(%d) " format, global_this_image + 1, \ -+ fprintf(stderr, "%d/%d (%d/%d): %s(%d) " format, global_this_image + 1, \ - global_num_images, caf_this_image, caf_num_images, __FUNCTION__, \ - __LINE__, ##__VA_ARGS__) -+#endif - #define chk_err(ierr) \ - do \ - { \ -@@ -2384,13 +2393,11 @@ PREFIX(deregister)(caf_token_t *token, int *stat, char *errmsg, - if (cur->token == *token) - { - p = TOKEN(*token); --#ifdef GCC_GE_7 -- dprint("Found regular token %p for memptr_win: %d.\n", *token, -- ((mpi_caf_token_t *)*token)->memptr_win); --#endif -+ dprint("Found regular token %p for memptr_win: %d.\n", *token, *p); - CAF_Win_unlock_all(*p); - ierr = MPI_Win_free(p); - chk_err(ierr); -+ dprint("Window destroyed.\n"); - - if (cur == current_team->allocated_tokens) - current_team->allocated_tokens = cur->next; -@@ -2536,7 +2543,13 @@ PREFIX(sync_all)(int *stat, char *errmsg, charlen_t errmsg_len) - ierr = MPI_Barrier(CAF_COMM_WORLD); - chk_err(ierr); - #endif -- dprint("MPI_Barrier = %d.\n", err); -+ dprint("Sync all on team %d, MPI_Barrier = %d.\n", -+#ifdef GCC_GE_16 -+ current_team->team_list_elem->team_id, -+#else -+ -1, -+#endif -+ err); - if (ierr == STAT_FAILED_IMAGE) - err = STAT_FAILED_IMAGE; - else if (ierr != 0) -@@ -10448,6 +10461,7 @@ PREFIX(change_team)(caf_team_t team, int *stat, char *errmsg, - chk_err(ierr); - ierr = MPI_Barrier(CAF_COMM_WORLD); - chk_err(ierr); -+ dprint("changed to team %d.\n", current_team->team_list_elem->team_id); - } - #else - void -@@ -10582,6 +10596,7 @@ PREFIX(end_team)(int *stat, char *errmsg, charlen_t errmsg_len) - return; - } - -+ dprint("ending team %d.\n", ending_team->team_list_elem->team_id); - for (struct allocated_tokens_t *ac = current_team->allocated_tokens; ac;) - { - struct allocated_tokens_t *nac = ac->next; -@@ -10601,6 +10616,7 @@ PREFIX(end_team)(int *stat, char *errmsg, charlen_t errmsg_len) - ierr = MPI_Comm_size(CAF_COMM_WORLD, &caf_num_images); - chk_err(ierr); - free(ending_team); -+ dprint("switched to team %d.\n", current_team->team_list_elem->team_id); - } - #else - void -@@ -10660,8 +10676,10 @@ PREFIX(sync_team)(caf_team_t team, int *stat, char *errmsg, - return; - } - -+ dprint("syncing team %d.\n", current_team->team_list_elem->team_id); - int ierr = MPI_Barrier(team_to_sync->communicator); - chk_err(ierr); -+ dprint("synced team %d.\n", current_team->team_list_elem->team_id); - } - #else - void diff --git a/sys-cluster/opencoarrays/files/opencoarrays-2.10.3_patch_05_Add_owning_memory_flag.patch b/sys-cluster/opencoarrays/files/opencoarrays-2.10.3_patch_05_Add_owning_memory_flag.patch deleted file mode 100644 index da3f2aab9d..0000000000 --- a/sys-cluster/opencoarrays/files/opencoarrays-2.10.3_patch_05_Add_owning_memory_flag.patch +++ /dev/null @@ -1,115 +0,0 @@ -From 2431ff99e0dcd01ae98e598a7c96d26b62b7bc41 Mon Sep 17 00:00:00 2001 -From: Andre Vehreschild -Date: Wed, 16 Apr 2025 13:41:56 +0200 -Subject: [PATCH] Add owning memory flag. - ---- - src/application-binary-interface/libcaf.h | 5 +- - src/runtime-libraries/mpi/mpi_caf.c | 57 +++++++++++++++++++++-- - 2 files changed, 58 insertions(+), 4 deletions(-) - -diff --git a/src/application-binary-interface/libcaf.h b/src/application-binary-interface/libcaf.h -index 66a93767..bd22d5eb 100644 ---- a/src/application-binary-interface/libcaf.h -+++ b/src/application-binary-interface/libcaf.h -@@ -88,7 +88,10 @@ typedef enum caf_register_t - CAF_REGTYPE_EVENT_STATIC, - CAF_REGTYPE_EVENT_ALLOC, - CAF_REGTYPE_COARRAY_ALLOC_REGISTER_ONLY, -- CAF_REGTYPE_COARRAY_ALLOC_ALLOCATE_ONLY -+ CAF_REGTYPE_COARRAY_ALLOC_ALLOCATE_ONLY, -+#ifdef GCC_GE_16 -+ CAF_REGTYPE_COARRAY_MAP_EXISTING, -+#endif - } caf_register_t; - - /* Describes the action to take on _caf_deregister. Keep in sync with -diff --git a/src/runtime-libraries/mpi/mpi_caf.c b/src/runtime-libraries/mpi/mpi_caf.c -index 90b5c952..1d6075b5 100644 ---- a/src/runtime-libraries/mpi/mpi_caf.c -+++ b/src/runtime-libraries/mpi/mpi_caf.c -@@ -121,6 +121,11 @@ typedef struct mpi_caf_token_t - /* The pointer to the primary array, i.e., to coarrays that are arrays and - * not a derived type. */ - gfc_descriptor_t *desc; -+#ifdef GCC_GE_16 -+ /* Only set to false, when this token maps memory into another token's -+ * memory segment. This only happens when in an associate or a change team. */ -+ int owning_memory; -+#endif - } mpi_caf_token_t; - - /* For components of derived type coarrays a slave_token is needed when the -@@ -2147,6 +2152,38 @@ void PREFIX(register)(size_t size, caf_register_t type, caf_token_t *token, - slave_token, slave_token->memptr, slave_token->desc); - } - break; -+#ifdef GCC_GE_16 -+ case CAF_REGTYPE_COARRAY_MAP_EXISTING: -+ { -+ mpi_caf_token_t *mpi_token; -+ MPI_Win *p; -+ -+ *token = calloc(1, sizeof(mpi_caf_token_t)); -+ mpi_token = (mpi_caf_token_t *)(*token); -+ p = TOKEN(mpi_token); -+ mem = desc->base_addr; -+ ierr = MPI_Win_create(mem, actual_size, 1, MPI_INFO_NULL, -+ CAF_COMM_WORLD, p); -+ chk_err(ierr); -+ CAF_Win_lock_all(*p); -+ mpi_token->owning_memory = 0; -+ -+ struct allocated_tokens_t *allocated_token -+ = malloc(sizeof(struct allocated_tokens_t)); -+ allocated_token->next = current_team->allocated_tokens; -+ allocated_token->token = *token; -+ current_team->allocated_tokens = allocated_token; -+ -+ if (stat) -+ *stat = 0; -+ -+ mpi_token->memptr = mem; -+ dprint("Token %p on exit of mapping: mpi_caf_token_t " -+ "{ (local_)memptr: %p (size: %zd), memptr_win: %d }\n", -+ mpi_token, mpi_token->memptr, size, mpi_token->memptr_win); -+ break; -+ } -+#endif - default: - { - mpi_caf_token_t *mpi_token; -@@ -2168,6 +2205,9 @@ void PREFIX(register)(size_t size, caf_register_t type, caf_token_t *token, - CAF_COMM_WORLD, p); - chk_err(ierr); - #endif // MPI_VERSION -+#ifdef GCC_GE_16 -+ mpi_token->owning_memory = 1; -+#endif - - #ifndef GCC_GE_8 - if (GFC_DESCRIPTOR_RANK(desc) != 0) -@@ -10601,9 +10641,20 @@ PREFIX(end_team)(int *stat, char *errmsg, charlen_t errmsg_len) - { - struct allocated_tokens_t *nac = ac->next; - -- PREFIX(deregister)((void **)&ac->token, -- CAF_DEREGTYPE_COARRAY_DEALLOCATE_ONLY, stat, errmsg, -- errmsg_len); -+ if (((mpi_caf_token_t *)ac->token)->owning_memory) -+ PREFIX(deregister)((void **)&ac->token, -+ CAF_DEREGTYPE_COARRAY_DEALLOCATE_ONLY, stat, errmsg, -+ errmsg_len); -+ else -+ { -+ MPI_Win *p = TOKEN(ac->token); -+ -+ CAF_Win_unlock_all(*p); -+ ierr = MPI_Win_free(p); -+ chk_err(ierr); -+ -+ free(ac->token); -+ } - free(ac); - ac = nac; - } diff --git a/sys-cluster/opencoarrays/files/opencoarrays-2.10.3_patch_06_Keep_team_translate_rework.patch b/sys-cluster/opencoarrays/files/opencoarrays-2.10.3_patch_06_Keep_team_translate_rework.patch deleted file mode 100644 index 147d203f25..0000000000 --- a/sys-cluster/opencoarrays/files/opencoarrays-2.10.3_patch_06_Keep_team_translate_rework.patch +++ /dev/null @@ -1,32 +0,0 @@ -From d1ab79d2459f10ca2b239bfeb03aa6e0e30c236b Mon Sep 17 00:00:00 2001 -From: Andre Vehreschild -Date: Wed, 16 Apr 2025 13:55:46 +0200 -Subject: [PATCH] Keep team_translate rework. - ---- - src/runtime-libraries/mpi/mpi_caf.c | 11 +++++++++++ - 1 file changed, 11 insertions(+) - -diff --git a/src/runtime-libraries/mpi/mpi_caf.c b/src/runtime-libraries/mpi/mpi_caf.c -index 1d6075b5..500a4316 100644 ---- a/src/runtime-libraries/mpi/mpi_caf.c -+++ b/src/runtime-libraries/mpi/mpi_caf.c -@@ -5752,7 +5752,18 @@ team_translate(int *remote_image, int *this_image, caf_token_t token, - - #ifdef GCC_GE_16 - if (team) -+ { -+ caf_team_stack_node_t *cur = current_team; -+ while (cur && cur->team_list_elem != *team) -+ cur = cur->parent; -+ if (!cur) -+ { -+ caf_internal_error("Team %d is not active", stat, NULL, 0, -+ (*(caf_teams_list_t **)team)->team_id); -+ return false; -+ } - comm = (*(caf_teams_list_t **)team)->communicator; -+ } - else if (team_number) - { - bool found = false; diff --git a/sys-cluster/opencoarrays/files/opencoarrays-2.10.3_patch_07_Use_COMM_TEAM_instead_of_COMM_WORLD.patch b/sys-cluster/opencoarrays/files/opencoarrays-2.10.3_patch_07_Use_COMM_TEAM_instead_of_COMM_WORLD.patch deleted file mode 100644 index 9ae4912c37..0000000000 --- a/sys-cluster/opencoarrays/files/opencoarrays-2.10.3_patch_07_Use_COMM_TEAM_instead_of_COMM_WORLD.patch +++ /dev/null @@ -1,430 +0,0 @@ -From 85914915f543ee3ccf1ea0f826f3af0c1d59789f Mon Sep 17 00:00:00 2001 -From: Andre Vehreschild -Date: Mon, 28 Apr 2025 09:08:06 +0200 -Subject: [PATCH] Use COMM_TEAM instead of COMM_WORLD. - -Revert changes to CAF_COMM_WORLD and introduce CAF_COMM_TEAM. -Let all communication happen on CAF_COMM_WORLD and map the -image indexes accordingly. Use CAF_COMM_TEAM for all collective -ops. ---- - src/runtime-libraries/mpi/mpi_caf.c | 155 ++++++++++++++-------------- - 1 file changed, 78 insertions(+), 77 deletions(-) - -diff --git a/src/runtime-libraries/mpi/mpi_caf.c b/src/runtime-libraries/mpi/mpi_caf.c -index 500a4316..c1599af3 100644 ---- a/src/runtime-libraries/mpi/mpi_caf.c -+++ b/src/runtime-libraries/mpi/mpi_caf.c -@@ -358,11 +358,12 @@ typedef struct gfc_max_dim_descriptor_t - - char err_buffer[MPI_MAX_ERROR_STRING]; - --#ifdef GCC_GE_16 - /* All CAF runtime calls should use this comm instead of MPI_COMM_WORLD for - * interoperability purposes. */ --MPI_Comm *CAF_COMM_WORLD_store; --#define CAF_COMM_WORLD (*CAF_COMM_WORLD_store) -+MPI_Comm CAF_COMM_WORLD; -+ -+#ifdef GCC_GE_16 -+#define CAF_COMM_TEAM current_team->team_list_elem->communicator - - typedef struct caf_teams_list - { -@@ -390,10 +391,10 @@ typedef struct caf_team_stack_node - - static caf_teams_list_t *teams_list = NULL; - static caf_team_stack_node_t *current_team = NULL, *initial_team; -+ - #else --/* All CAF runtime calls should use this comm instead of MPI_COMM_WORLD for -- * interoperability purposes. */ --MPI_Comm CAF_COMM_WORLD; -+ -+#define CAF_COMM_TEAM CAF_COMM_WORLD - - typedef struct caf_teams_list - { -@@ -1527,9 +1528,6 @@ PREFIX(init)(int *argc, char ***argv) - /* Flag rc as unused, because conditional compilation. */ - int ierr = 0, i = 0, j = 0, rc __attribute__((unused)), prov_lev = 0; - int is_init = 0, prior_thread_level = MPI_THREAD_MULTIPLE; --#ifdef GCC_GE_16 -- MPI_Comm tmp_world; --#endif - - ierr = MPI_Initialized(&is_init); - chk_err(ierr); -@@ -1576,12 +1574,8 @@ PREFIX(init)(int *argc, char ***argv) - - /* Duplicate MPI_COMM_WORLD so that no CAF internal functions use it. - * This is critical for MPI-interoperability. */ --#ifdef GCC_GE_16 -- rc = MPI_Comm_dup(MPI_COMM_WORLD, &tmp_world); -- CAF_COMM_WORLD_store = &tmp_world; --#else - rc = MPI_Comm_dup(MPI_COMM_WORLD, &CAF_COMM_WORLD); --#endif -+ - #ifdef WITH_FAILED_IMAGES - flag = (MPI_SUCCESS == rc); - rc = MPIX_Comm_agree(MPI_COMM_WORLD, &flag); -@@ -1625,8 +1619,8 @@ PREFIX(init)(int *argc, char ***argv) - /* BEGIN teams preparations. */ - #ifdef GCC_GE_16 - teams_list = (caf_teams_list_t *)malloc(sizeof(caf_teams_list_t)); -- *teams_list = (struct caf_teams_list){tmp_world, -1, caf_this_image, NULL}; -- CAF_COMM_WORLD_store = &teams_list->communicator; -+ *teams_list -+ = (struct caf_teams_list){CAF_COMM_WORLD, -1, caf_this_image, NULL}; - current_team - = (caf_team_stack_node_t *)malloc(sizeof(caf_team_stack_node_t)); - *current_team = (struct caf_team_stack_node){teams_list, NULL}; -@@ -2162,8 +2156,8 @@ void PREFIX(register)(size_t size, caf_register_t type, caf_token_t *token, - mpi_token = (mpi_caf_token_t *)(*token); - p = TOKEN(mpi_token); - mem = desc->base_addr; -- ierr = MPI_Win_create(mem, actual_size, 1, MPI_INFO_NULL, -- CAF_COMM_WORLD, p); -+ ierr = MPI_Win_create(mem, actual_size, 1, MPI_INFO_NULL, CAF_COMM_TEAM, -+ p); - chk_err(ierr); - CAF_Win_lock_all(*p); - mpi_token->owning_memory = 0; -@@ -2194,15 +2188,15 @@ void PREFIX(register)(size_t size, caf_register_t type, caf_token_t *token, - p = TOKEN(mpi_token); - - #if MPI_VERSION >= 3 -- ierr = MPI_Win_allocate(actual_size, 1, MPI_INFO_NULL, CAF_COMM_WORLD, -+ ierr = MPI_Win_allocate(actual_size, 1, MPI_INFO_NULL, CAF_COMM_TEAM, - &mem, p); - chk_err(ierr); - CAF_Win_lock_all(*p); - #else - ierr = MPI_Alloc_mem(actual_size, MPI_INFO_NULL, &mem); - chk_err(ierr); -- ierr = MPI_Win_create(mem, actual_size, 1, MPI_INFO_NULL, -- CAF_COMM_WORLD, p); -+ ierr = MPI_Win_create(mem, actual_size, 1, MPI_INFO_NULL, CAF_COMM_TEAM, -+ p); - chk_err(ierr); - #endif // MPI_VERSION - #ifdef GCC_GE_16 -@@ -2415,7 +2409,7 @@ PREFIX(deregister)(caf_token_t *token, int *stat, char *errmsg, - /* Sync all images only, when deregistering the token. Just freeing the - * memory needs no sync. */ - #ifdef WITH_FAILED_IMAGES -- ierr = MPI_Barrier(CAF_COMM_WORLD); -+ ierr = MPI_Barrier(CAF_COMM_TEAM); - chk_err(ierr); - #else - PREFIX(sync_all)(NULL, NULL, 0); -@@ -5742,13 +5736,13 @@ get_from_self(caf_token_t token, const gfc_descriptor_t *opt_src_desc, - } - - bool --team_translate(int *remote_image, int *this_image, caf_token_t token, -- int image_index, caf_team_t *team, int *team_number, int *stat) -+team_translate(int *remote_image, int *this_image, -+ caf_token_t token __attribute__((unused)), int image_index, -+ caf_team_t *team, int *team_number, int *stat) - { -- MPI_Group current_team_group, win_group; -- int ierr; -- int trans_ranks[2]; -- MPI_Comm comm = CAF_COMM_WORLD; -+ MPI_Group world_group, team_group, remote_group; -+ int ierr, trans, team_id = current_team->team_list_elem->team_id; -+ MPI_Comm remote_comm = MPI_COMM_NULL; - - #ifdef GCC_GE_16 - if (team) -@@ -5762,7 +5756,8 @@ team_translate(int *remote_image, int *this_image, caf_token_t token, - (*(caf_teams_list_t **)team)->team_id); - return false; - } -- comm = (*(caf_teams_list_t **)team)->communicator; -+ remote_comm = (*(caf_teams_list_t **)team)->communicator; -+ team_id = (*(caf_teams_list_t **)team)->team_id; - } - else if (team_number) - { -@@ -5770,7 +5765,8 @@ team_translate(int *remote_image, int *this_image, caf_token_t token, - for (caf_team_stack_node_t *cur = current_team; cur; cur = cur->parent) - if (cur->team_list_elem->team_id == *team_number) - { -- comm = cur->team_list_elem->communicator; -+ remote_comm = cur->team_list_elem->communicator; -+ team_id = cur->team_list_elem->team_id; - found = true; - break; - } -@@ -5783,20 +5779,30 @@ team_translate(int *remote_image, int *this_image, caf_token_t token, - } - #endif - -- ierr = MPI_Comm_group(comm, ¤t_team_group); -+ ierr = MPI_Comm_group(CAF_COMM_WORLD, &world_group); - chk_err(ierr); -- ierr = MPI_Win_get_group(*TOKEN(token), &win_group); -+ if (remote_comm == MPI_COMM_NULL) -+ ierr = MPI_Comm_group(CAF_COMM_TEAM, &remote_group); -+ else -+ ierr = MPI_Comm_group(remote_comm, &remote_group); - chk_err(ierr); -- ierr = MPI_Group_translate_ranks(current_team_group, 2, -- (int[]){image_index - 1, mpi_this_image}, -- win_group, trans_ranks); -+ ierr = MPI_Comm_group(CAF_COMM_TEAM, &team_group); - chk_err(ierr); -- *remote_image = trans_ranks[0]; -- *this_image = trans_ranks[1]; -- ierr = MPI_Group_free(¤t_team_group); -+ trans = image_index - 1; -+ ierr = MPI_Group_translate_ranks(team_group, 1, &mpi_this_image, world_group, -+ this_image); - chk_err(ierr); -- ierr = MPI_Group_free(&win_group); -+ ierr = MPI_Group_translate_ranks(remote_group, 1, &trans, world_group, -+ remote_image); -+ chk_err(ierr); -+ ierr = MPI_Group_free(&remote_group); -+ chk_err(ierr); -+ ierr = MPI_Group_free(&team_group); - chk_err(ierr); -+ ierr = MPI_Group_free(&world_group); -+ chk_err(ierr); -+ dprint("this: %d -> %d, rmt: %d -> %d on team %d.\n", caf_this_image, -+ *this_image + 1, image_index, *remote_image + 1, team_id); - return true; - } - -@@ -5889,7 +5895,7 @@ PREFIX(get_from_remote)(caf_token_t token, const gfc_descriptor_t *opt_src_desc, - msg->transfer_size = dst_size; - msg->opt_charlen = opt_src_charlen ? *opt_src_charlen : 0; - msg->win = *TOKEN(token); -- msg->dest_image = mpi_this_image; -+ msg->dest_image = this_image; - msg->dest_tag = CAF_CT_TAG + 1; - msg->dest_opt_charlen = opt_dst_charlen ? *opt_dst_charlen : 1; - msg->flags = (opt_dst_desc ? CT_DST_HAS_DESC : 0) -@@ -5932,13 +5938,12 @@ PREFIX(get_from_remote)(caf_token_t token, const gfc_descriptor_t *opt_src_desc, - caf_runtime_error("Unable to allocate memory " - "for internal buffer in get_from_remote()."); - } -- dprint("waiting to receive %zd bytes from %d.\n", dst_size, -- image_index - 1); -- ierr = MPI_Recv(t_buff, dst_size, MPI_BYTE, image_index - 1, msg->dest_tag, -+ dprint("waiting to receive %zd bytes from %d.\n", dst_size, remote_image); -+ ierr = MPI_Recv(t_buff, dst_size, MPI_BYTE, remote_image, msg->dest_tag, - CAF_COMM_WORLD, MPI_STATUS_IGNORE); - chk_err(ierr); - dprint("received %zd bytes as requested from %d.\n", dst_size, -- image_index - 1); -+ remote_image); - // dump_mem("get_from_remote", t_buff, dst_size); - memcpy(*dst_data, t_buff, dst_size); - -@@ -6276,7 +6281,7 @@ PREFIX(send_to_remote)(caf_token_t token, gfc_descriptor_t *opt_dst_desc, - msg->transfer_size = src_size; - msg->opt_charlen = opt_src_charlen ? *opt_src_charlen : 0; - msg->win = *TOKEN(token); -- msg->dest_image = mpi_this_image; -+ msg->dest_image = this_image; - msg->dest_tag = CAF_CT_TAG + 1; - msg->dest_opt_charlen = opt_dst_charlen ? *opt_dst_charlen : 1; - msg->flags = (opt_dst_desc ? CT_DST_HAS_DESC : 0) -@@ -6317,13 +6322,13 @@ PREFIX(send_to_remote)(caf_token_t token, gfc_descriptor_t *opt_dst_desc, - - { - char c; -- dprint("waiting to receive %d bytes from %d on tag %d.\n", 1, image_index, -+ dprint("waiting to receive 1 byte from %d on tag %d.\n", remote_image, - msg->dest_tag); -- ierr = MPI_Recv(&c, 1, MPI_BYTE, image_index - 1, msg->dest_tag, -+ ierr = MPI_Recv(&c, 1, MPI_BYTE, remote_image, msg->dest_tag, - CAF_COMM_WORLD, MPI_STATUS_IGNORE); - chk_err(ierr); -- dprint("received %d bytes as requested from %d on tag %d.\n", 1, -- image_index, msg->dest_tag); -+ dprint("received 1 byte as requested from %d on tag %d.\n", remote_image, -+ msg->dest_tag); - } - - if (running_accesses == rat) -@@ -6383,9 +6388,7 @@ PREFIX(transfer_between_remotes)( - caf_team_t *dst_team, int *dst_team_number, caf_team_t *src_team, - int *src_team_number) - { -- MPI_Group current_team_group, win_group; - int ierr, this_image, src_remote_image, dst_remote_image; -- int trans_ranks[3]; - bool free_msg; - ct_msg_t *full_msg, *dst_msg; - struct transfer_msg_data_t *tmd; -@@ -6545,7 +6548,7 @@ PREFIX(transfer_between_remotes)( - dst_msg->transfer_size = src_size; - dst_msg->opt_charlen = opt_src_charlen ? *opt_src_charlen : 0; - dst_msg->win = *TOKEN(dst_token); -- dst_msg->dest_image = mpi_this_image; -+ dst_msg->dest_image = this_image; - dst_msg->dest_tag = CAF_CT_TAG + 1; - dst_msg->dest_opt_charlen = opt_dst_charlen ? *opt_dst_charlen : 1; - dst_msg->flags -@@ -6588,15 +6591,15 @@ PREFIX(transfer_between_remotes)( - - { - char c; -- dprint("waiting to receive %d bytes from %d on tag %d.\n", 1, -- dst_image_index, dst_msg->dest_tag); -- ierr = MPI_Recv(&c, 1, MPI_BYTE, dst_image_index - 1, dst_msg->dest_tag, -+ dprint("waiting to receive 1 byte from %d on tag %d.\n", dst_remote_image, -+ dst_msg->dest_tag); -+ ierr = MPI_Recv(&c, 1, MPI_BYTE, dst_remote_image, dst_msg->dest_tag, - CAF_COMM_WORLD, MPI_STATUS_IGNORE); - chk_err(ierr); - if (dst_stat) - *dst_stat = c; -- dprint("received %d bytes as requested from %d on tag %d.\n", 1, -- dst_image_index, dst_msg->dest_tag); -+ dprint("received 1 byte as requested from %d on tag %d.\n", -+ dst_remote_image, dst_msg->dest_tag); - } - - if (running_accesses == rat) -@@ -9509,19 +9512,19 @@ internal_co_reduce(MPI_Op op, gfc_descriptor_t *source, int result_image, - if (result_image == 0) - { - ierr = MPI_Allreduce(MPI_IN_PLACE, source->base_addr, size, datatype, op, -- CAF_COMM_WORLD); -+ CAF_COMM_TEAM); - chk_err(ierr); - } - else if (result_image == caf_this_image) - { - ierr = MPI_Reduce(MPI_IN_PLACE, source->base_addr, size, datatype, op, -- result_image - 1, CAF_COMM_WORLD); -+ result_image - 1, CAF_COMM_TEAM); - chk_err(ierr); - } - else - { - ierr = MPI_Reduce(source->base_addr, NULL, size, datatype, op, -- result_image - 1, CAF_COMM_WORLD); -+ result_image - 1, CAF_COMM_TEAM); - chk_err(ierr); - } - if (ierr) -@@ -9543,19 +9546,19 @@ internal_co_reduce(MPI_Op op, gfc_descriptor_t *source, int result_image, - + array_offset_sr * GFC_DESCRIPTOR_SIZE(source)); - if (result_image == 0) - { -- ierr = MPI_Allreduce(MPI_IN_PLACE, sr, 1, datatype, op, CAF_COMM_WORLD); -+ ierr = MPI_Allreduce(MPI_IN_PLACE, sr, 1, datatype, op, CAF_COMM_TEAM); - chk_err(ierr); - } - else if (result_image == caf_this_image) - { - ierr = MPI_Reduce(MPI_IN_PLACE, sr, 1, datatype, op, result_image - 1, -- CAF_COMM_WORLD); -+ CAF_COMM_TEAM); - chk_err(ierr); - } - else - { - ierr = MPI_Reduce(sr, NULL, 1, datatype, op, result_image - 1, -- CAF_COMM_WORLD); -+ CAF_COMM_TEAM); - chk_err(ierr); - } - if (ierr) -@@ -9618,13 +9621,13 @@ PREFIX(co_broadcast)(gfc_descriptor_t *a, int source_image, int *stat, - if (datatype == MPI_BYTE) - { - ierr = MPI_Bcast(a->base_addr, size * GFC_DESCRIPTOR_SIZE(a), datatype, -- source_image - 1, CAF_COMM_WORLD); -+ source_image - 1, CAF_COMM_TEAM); - chk_err(ierr); - } - else if (datatype != MPI_CHARACTER) - { - ierr = MPI_Bcast(a->base_addr, size, datatype, source_image - 1, -- CAF_COMM_WORLD); -+ CAF_COMM_TEAM); - chk_err(ierr); - } - else -@@ -9633,13 +9636,13 @@ PREFIX(co_broadcast)(gfc_descriptor_t *a, int source_image, int *stat, - if (caf_this_image == source_image) - a_length = strlen(a->base_addr); - /* Broadcast the string lenth */ -- ierr = MPI_Bcast(&a_length, 1, MPI_INT, source_image - 1, CAF_COMM_WORLD); -+ ierr = MPI_Bcast(&a_length, 1, MPI_INT, source_image - 1, CAF_COMM_TEAM); - chk_err(ierr); - if (ierr) - goto error; - /* Broadcast the string itself */ - ierr = MPI_Bcast(a->base_addr, a_length, datatype, source_image - 1, -- CAF_COMM_WORLD); -+ CAF_COMM_TEAM); - chk_err(ierr); - } - -@@ -9668,7 +9671,7 @@ PREFIX(co_broadcast)(gfc_descriptor_t *a, int source_image, int *stat, - void *sr = (void *)((char *)a->base_addr - + array_offset * GFC_DESCRIPTOR_SIZE(a)); - -- ierr = MPI_Bcast(sr, 1, datatype, source_image - 1, CAF_COMM_WORLD); -+ ierr = MPI_Bcast(sr, 1, datatype, source_image - 1, CAF_COMM_TEAM); - chk_err(ierr); - - if (ierr) -@@ -10426,7 +10429,7 @@ PREFIX(form_team)(int team_id, caf_team_t *team, int *new_index, int *stat, - static const char *negative_new_index - = "FORM TEAM: NEW_INDEX= shall be a positive unique integer"; - caf_teams_list_t *new_team; -- MPI_Comm current_comm = CAF_COMM_WORLD; -+ MPI_Comm current_comm = CAF_COMM_TEAM; - int ierr; - int key = new_index ? *new_index : caf_this_image; - -@@ -10504,13 +10507,12 @@ PREFIX(change_team)(caf_team_t team, int *stat, char *errmsg, - = (caf_team_stack_node_t){provisioned_team, NULL, current_team}; - - current_team = new_current_team; -- CAF_COMM_WORLD_store = ¤t_team->team_list_elem->communicator; -- ierr = MPI_Comm_rank(CAF_COMM_WORLD, &mpi_this_image); -+ ierr = MPI_Comm_rank(CAF_COMM_TEAM, &mpi_this_image); - chk_err(ierr); - caf_this_image = mpi_this_image + 1; -- ierr = MPI_Comm_size(CAF_COMM_WORLD, &caf_num_images); -+ ierr = MPI_Comm_size(CAF_COMM_TEAM, &caf_num_images); - chk_err(ierr); -- ierr = MPI_Barrier(CAF_COMM_WORLD); -+ ierr = MPI_Barrier(CAF_COMM_TEAM); - chk_err(ierr); - dprint("changed to team %d.\n", current_team->team_list_elem->team_id); - } -@@ -10638,7 +10640,7 @@ PREFIX(end_team)(int *stat, char *errmsg, charlen_t errmsg_len) - if (stat) - *stat = 0; - -- ierr = MPI_Barrier(CAF_COMM_WORLD); -+ ierr = MPI_Barrier(CAF_COMM_TEAM); - chk_err(ierr); - if (current_team->parent == NULL) - { -@@ -10671,11 +10673,10 @@ PREFIX(end_team)(int *stat, char *errmsg, charlen_t errmsg_len) - } - current_team = current_team->parent; - -- CAF_COMM_WORLD_store = ¤t_team->team_list_elem->communicator; -- ierr = MPI_Comm_rank(CAF_COMM_WORLD, &mpi_this_image); -+ ierr = MPI_Comm_rank(CAF_COMM_TEAM, &mpi_this_image); - chk_err(ierr); - caf_this_image = mpi_this_image + 1; -- ierr = MPI_Comm_size(CAF_COMM_WORLD, &caf_num_images); -+ ierr = MPI_Comm_size(CAF_COMM_TEAM, &caf_num_images); - chk_err(ierr); - free(ending_team); - dprint("switched to team %d.\n", current_team->team_list_elem->team_id); diff --git a/sys-cluster/opencoarrays/files/opencoarrays-2.10.3_patch_08_Add_more_beefy_tests.patch b/sys-cluster/opencoarrays/files/opencoarrays-2.10.3_patch_08_Add_more_beefy_tests.patch deleted file mode 100644 index 267359ed83..0000000000 --- a/sys-cluster/opencoarrays/files/opencoarrays-2.10.3_patch_08_Add_more_beefy_tests.patch +++ /dev/null @@ -1,232 +0,0 @@ -From a13970883e7b9cc7989efd7877534252c0317f06 Mon Sep 17 00:00:00 2001 -From: Andre Vehreschild -Date: Thu, 17 Apr 2025 11:57:47 +0200 -Subject: [PATCH] Add more "beefy" tests. - -Add tests that really make use of teams and not only a smoke test. ---- - CMakeLists.txt | 4 +- - src/tests/unit/teams/CMakeLists.txt | 2 + - src/tests/unit/teams/teams_coindexed.f90 | 111 +++++++++++++++++++++++ - src/tests/unit/teams/test_teams_1.f90 | 66 ++++++++++++++ - 4 files changed, 182 insertions(+), 1 deletion(-) - create mode 100644 src/tests/unit/teams/teams_coindexed.f90 - create mode 100644 src/tests/unit/teams/test_teams_1.f90 - -diff --git a/CMakeLists.txt b/CMakeLists.txt -index 8f9ee35a..0dbb85a0 100644 ---- a/CMakeLists.txt -+++ b/CMakeLists.txt -@@ -818,9 +818,11 @@ if(opencoarrays_aware_compiler) - add_caf_test(alloc_comp_multidim_shape 2 alloc_comp_multidim_shape) - set_tests_properties(alloc_comp_multidim_shape PROPERTIES TIMEOUT 300) - endif() -- if(NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 15) -+ if(NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 16) - add_caf_test(teams_this_image 8 teams_this_image) - add_caf_test(teams_num_images 8 teams_num_images) -+ add_caf_test(test_teams_1 9 test_teams_1) -+ add_caf_test(teams_coindexed 2 teams_coindexed) - endif() - endif() - -diff --git a/src/tests/unit/teams/CMakeLists.txt b/src/tests/unit/teams/CMakeLists.txt -index 8307b078..2ef2ee8e 100644 ---- a/src/tests/unit/teams/CMakeLists.txt -+++ b/src/tests/unit/teams/CMakeLists.txt -@@ -10,4 +10,6 @@ caf_compile_executable(sync_team sync-team.f90) - if (gfortran_compiler AND (NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 16.0.0)) - caf_compile_executable(teams_this_image teams_this_image.f90) - caf_compile_executable(teams_num_images teams_num_images.f90) -+ caf_compile_executable(test_teams_1 test_teams_1.f90) -+ caf_compile_executable(teams_coindexed teams_coindexed.f90) - endif() -diff --git a/src/tests/unit/teams/teams_coindexed.f90 b/src/tests/unit/teams/teams_coindexed.f90 -new file mode 100644 -index 00000000..5c3fab91 ---- /dev/null -+++ b/src/tests/unit/teams/teams_coindexed.f90 -@@ -0,0 +1,111 @@ -+! BSD 3-Clause License -+! -+! Copyright (c) 2018-2025, Sourcery Institute -+! All rights reserved. -+! -+! Redistribution and use in source and binary forms, with or without -+! modification, are permitted provided that the following conditions are met: -+! -+! * Redistributions of source code must retain the above copyright notice, this -+! list of conditions and the following disclaimer. -+! -+! * Redistributions in binary form must reproduce the above copyright notice, -+! this list of conditions and the following disclaimer in the documentation -+! and/or other materials provided with the distribution. -+! -+! * Neither the name of the copyright holder nor the names of its -+! contributors may be used to endorse or promote products derived from -+! this software without specific prior written permission. -+! -+! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -+! AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -+! IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -+! DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE -+! FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -+! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -+! SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER -+! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, -+! OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -+! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -+ -+program teams_coindexed -+ use, intrinsic :: iso_fortran_env -+ -+ type(team_type) :: parentteam, team, formed_team -+ integer :: t_num= 42, stat = 42, lhs -+ integer(kind=2) :: st_num=42 -+ integer :: caf(2)[*] -+ -+ parentteam = get_team() -+ -+ caf = [23, 32] -+ form team(t_num, team) -+ form team(t_num, formed_team) -+ -+ associate(me => this_image()) -+ change team(team, cell[*] => caf(2)) -+ ! for get_from_remote -+ ! Checking against caf_single is very limitted. -+ if (cell[me, team_number=t_num] /= 32) stop 1 -+ if (cell[me, team_number=st_num] /= 32) stop 2 -+ if (cell[me, team=parentteam] /= 32) stop 3 -+ -+ ! Check that team_number is validated -+ lhs = cell[me, team_number=5, stat=stat] -+ if (stat /= 1) stop 4 -+ -+ ! Check that only access to active teams is valid -+ stat = 42 -+ lhs = cell[me, team=formed_team, stat=stat] -+ if (stat /= 1) stop 5 -+ -+ ! for send_to_remote -+ ! Checking against caf_single is very limitted. -+ cell[me, team_number=t_num] = 45 -+ if (cell /= 45) stop 11 -+ cell[me, team_number=st_num] = 46 -+ if (cell /= 46) stop 12 -+ cell[me, team=parentteam] = 47 -+ if (cell /= 47) stop 13 -+ -+ ! Check that team_number is validated -+ stat = -1 -+ cell[me, team_number=5, stat=stat] = 0 -+ if (stat /= 1) stop 14 -+ -+ ! Check that only access to active teams is valid -+ stat = 42 -+ cell[me, team=formed_team, stat=stat] = -1 -+ if (stat /= 1) stop 15 -+ -+ ! for transfer_between_remotes -+ ! Checking against caf_single is very limitted. -+ cell[me, team_number=t_num] = caf(1)[me, team_number=-1] -+ if (cell /= 23) stop 21 -+ cell[me, team_number=st_num] = caf(2)[me, team_number=-1] -+ ! cell is an alias for caf(2) and has been overwritten by caf(1)! -+ if (cell /= 23) stop 22 -+ cell[me, team=parentteam] = caf(1)[me, team= team] -+ if (cell /= 23) stop 23 -+ -+ ! Check that team_number is validated -+ stat = -1 -+ cell[me, team_number=5, stat=stat] = caf(1)[me, team_number= -1] -+ if (stat /= 1) stop 24 -+ stat = -1 -+ cell[me, team_number=t_num] = caf(1)[me, team_number= -2, stat=stat] -+ if (stat /= 1) stop 25 -+ -+ ! Check that only access to active teams is valid -+ stat = 42 -+ cell[me, team=formed_team, stat=stat] = caf(1)[me] -+ if (stat /= 1) stop 26 -+ stat = 42 -+ cell[me] = caf(1)[me, team=formed_team, stat=stat] -+ if (stat /= 1) stop 27 -+ end team -+ -+ sync all -+ if (me == 1) print *, "Test passed." -+ end associate -+end program teams_coindexed -diff --git a/src/tests/unit/teams/test_teams_1.f90 b/src/tests/unit/teams/test_teams_1.f90 -new file mode 100644 -index 00000000..3d94c535 ---- /dev/null -+++ b/src/tests/unit/teams/test_teams_1.f90 -@@ -0,0 +1,66 @@ -+! BSD 3-Clause License -+! -+! Copyright (c) 2018-2025, Sourcery Institute -+! All rights reserved. -+! -+! Redistribution and use in source and binary forms, with or without -+! modification, are permitted provided that the following conditions are met: -+! -+! * Redistributions of source code must retain the above copyright notice, this -+! list of conditions and the following disclaimer. -+! -+! * Redistributions in binary form must reproduce the above copyright notice, -+! this list of conditions and the following disclaimer in the documentation -+! and/or other materials provided with the distribution. -+! -+! * Neither the name of the copyright holder nor the names of its -+! contributors may be used to endorse or promote products derived from -+! this software without specific prior written permission. -+! -+! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -+! AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -+! IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -+! DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE -+! FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -+! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -+! SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER -+! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, -+! OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -+! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -+ -+program test_teams_1 -+ use, intrinsic :: iso_fortran_env -+ use oc_assertions_interface, only : assert -+ -+ integer :: caf(3,3)[*] != 42 -+ type(team_type) :: row_team, column_team -+ -+ caf = reshape((/(-i, i = 1, 9 )/), [3,3]) -+ associate(me => this_image(), np => num_images()) -+ call assert(np == 9, "I need exactly 9 teams.") -+ -+ ! Form a row team -+ form team((me - 1) / 3 + 1, row_team, new_index=mod(me - 1, 3) + 1) -+ row_t: change team(row_team, row[*] => caf(:, team_number(row_team))) -+ ! Form column teams; each team has only one image -+ form team (team_number(), column_team) -+ col_t: change team(column_team, cell[*] => row(this_image())) -+ cell = team_number() -+ if (this_image() /= 1) row(this_image())[1] = cell -+ end team col_t -+ sync team(row_team) -+ if (this_image() == 1) caf(:, team_number(row_team))[1, team_number = -1] = row -+ end team row_t -+ sync all -+ if (me == 1) then -+ if (all(caf == reshape([1,1,1,2,2,2,3,3,3], [3, 3]))) then -+ print *, "Test passed." -+ else -+ print *, "Test failed." -+ print *, "Expected:", reshape([1,1,1,2,2,2,3,3,3], [3, 3]) -+ print *, "Got :", caf -+ end if -+ end if -+ end associate -+ -+end program test_teams_1 diff --git a/sys-cluster/opencoarrays/files/opencoarrays-2.10.3_patch_09_Add_comments_to_teams_num_images_test.patch b/sys-cluster/opencoarrays/files/opencoarrays-2.10.3_patch_09_Add_comments_to_teams_num_images_test.patch deleted file mode 100644 index 6658bc9df9..0000000000 --- a/sys-cluster/opencoarrays/files/opencoarrays-2.10.3_patch_09_Add_comments_to_teams_num_images_test.patch +++ /dev/null @@ -1,29 +0,0 @@ -From 9c740b95f62bf1fc5bffed475e8f2bd2f471d830 Mon Sep 17 00:00:00 2001 -From: Andre Vehreschild -Date: Thu, 17 Apr 2025 15:42:36 +0200 -Subject: [PATCH] Add comments to teams_num_images test. - ---- - src/tests/unit/teams/teams_num_images.f90 | 3 +++ - 1 file changed, 3 insertions(+) - -diff --git a/src/tests/unit/teams/teams_num_images.f90 b/src/tests/unit/teams/teams_num_images.f90 -index b90a9105..9f539676 100644 ---- a/src/tests/unit/teams/teams_num_images.f90 -+++ b/src/tests/unit/teams/teams_num_images.f90 -@@ -35,12 +35,15 @@ - sync all - form team(MOD(me, 2) + 1, team) - -+ ! Test no parameter gives all images in curren team. - j1 = num_images() - if (j1 /= num) stop 1 - -+ ! Test that a team_type parameter gives the #images in that team. - j2 = num_images(team) - if (j2 /= num / 2) stop 2 - -+ ! Same but using the number of the team. - j3 = num_images(MOD(me, 2) + 1) - if (j3 /= num / 2) stop 3 - diff --git a/sys-cluster/opencoarrays/files/opencoarrays-2.10.3_patch_10_Fixes_for_use_with_gcc_lt_16.patch b/sys-cluster/opencoarrays/files/opencoarrays-2.10.3_patch_10_Fixes_for_use_with_gcc_lt_16.patch deleted file mode 100644 index 8e56b93307..0000000000 --- a/sys-cluster/opencoarrays/files/opencoarrays-2.10.3_patch_10_Fixes_for_use_with_gcc_lt_16.patch +++ /dev/null @@ -1,224 +0,0 @@ -From 3d5c515ae0ff4636a5d3272ce838c2873d117b98 Mon Sep 17 00:00:00 2001 -From: Andre Vehreschild -Date: Mon, 28 Apr 2025 09:42:27 +0200 -Subject: [PATCH] Fixes for use with gcc<16. - ---- - CMakeLists.txt | 4 +- - src/runtime-libraries/mpi/mpi_caf.c | 72 ++++++++++++++++++++++++++-- - src/tests/unit/teams/team_number.F90 | 2 +- - 3 files changed, 70 insertions(+), 8 deletions(-) - -diff --git a/CMakeLists.txt b/CMakeLists.txt -index 0dbb85a0..e9694b4e 100644 ---- a/CMakeLists.txt -+++ b/CMakeLists.txt -@@ -233,10 +233,10 @@ endif() - if ( gfortran_compiler AND ( NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 8.0.0 ) ) - add_definitions(-DGCC_GE_8) # Tell library to build against GFortran 8.x bindings w/ descriptor change - endif() -- if ( gfortran_compiler AND ( NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 15.0.0 ) ) -+ if ( gfortran_compiler AND ( NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS_EQUAL 15.0.0 ) ) - add_definitions(-DGCC_GE_15) # Tell library to build against GFortran 15.x bindings - endif() -- if ( gfortran_compiler AND ( NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 16.0.0 ) ) -+ if ( gfortran_compiler AND ( CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 16.0.0 ) ) - add_definitions(-DGCC_GE_16) # Tell library to build against GFortran 16.x bindings - endif() - -diff --git a/src/runtime-libraries/mpi/mpi_caf.c b/src/runtime-libraries/mpi/mpi_caf.c -index c1599af3..91784a52 100644 ---- a/src/runtime-libraries/mpi/mpi_caf.c -+++ b/src/runtime-libraries/mpi/mpi_caf.c -@@ -226,7 +226,7 @@ static win_sync *pending_puts = NULL; - /* Linked list of static coarrays registered. Do not expose to public in the - * header, because it is implementation specific. - * -- * From gcc-15 on, this list is contained in the teams handling. */ -+ * From gcc-16 on, this list is contained in the teams handling. */ - struct caf_allocated_tokens_t - { - caf_token_t token; -@@ -839,7 +839,11 @@ handle_is_present_message(ct_msg_t *msg, void *baseptr) - += sizeof_desc_for_rank(GFC_DESCRIPTOR_RANK((gfc_descriptor_t *)ptr)); - } - else -+#ifdef GCC_GE_16 - ptr = &baseptr; -+#else -+ ptr = baseptr; -+#endif - - accessor_hash_table[msg->accessor_index].u.is_present( - add_data, &msg->dest_image, &result, ptr, &src_token, 0); -@@ -5740,11 +5744,11 @@ team_translate(int *remote_image, int *this_image, - caf_token_t token __attribute__((unused)), int image_index, - caf_team_t *team, int *team_number, int *stat) - { -+#ifdef GCC_GE_16 - MPI_Group world_group, team_group, remote_group; - int ierr, trans, team_id = current_team->team_list_elem->team_id; - MPI_Comm remote_comm = MPI_COMM_NULL; - --#ifdef GCC_GE_16 - if (team) - { - caf_team_stack_node_t *cur = current_team; -@@ -5777,7 +5781,6 @@ team_translate(int *remote_image, int *this_image, - return false; - } - } --#endif - - ierr = MPI_Comm_group(CAF_COMM_WORLD, &world_group); - chk_err(ierr); -@@ -5803,6 +5806,27 @@ team_translate(int *remote_image, int *this_image, - chk_err(ierr); - dprint("this: %d -> %d, rmt: %d -> %d on team %d.\n", caf_this_image, - *this_image + 1, image_index, *remote_image + 1, team_id); -+#else -+ MPI_Group current_team_group, win_group; -+ int ierr, trans_ranks[2]; -+ -+ ierr = MPI_Comm_group(CAF_COMM_WORLD, ¤t_team_group); -+ chk_err(ierr); -+ ierr = MPI_Win_get_group(*TOKEN(token), &win_group); -+ chk_err(ierr); -+ ierr = MPI_Group_translate_ranks(current_team_group, 2, -+ (int[]){image_index - 1, mpi_this_image}, -+ win_group, trans_ranks); -+ chk_err(ierr); -+ *remote_image = trans_ranks[0]; -+ *this_image = trans_ranks[1]; -+ ierr = MPI_Group_free(¤t_team_group); -+ chk_err(ierr); -+ ierr = MPI_Group_free(&win_group); -+ chk_err(ierr); -+ dprint("this: %d -> %d, rmt: %d -> %d.\n", caf_this_image, *this_image + 1, -+ image_index, *remote_image + 1); -+#endif - return true; - } - -@@ -5895,7 +5919,11 @@ PREFIX(get_from_remote)(caf_token_t token, const gfc_descriptor_t *opt_src_desc, - msg->transfer_size = dst_size; - msg->opt_charlen = opt_src_charlen ? *opt_src_charlen : 0; - msg->win = *TOKEN(token); -+#ifdef GCC_GE_16 - msg->dest_image = this_image; -+#else -+ msg->dest_image = mpi_this_image; -+#endif - msg->dest_tag = CAF_CT_TAG + 1; - msg->dest_opt_charlen = opt_dst_charlen ? *opt_dst_charlen : 1; - msg->flags = (opt_dst_desc ? CT_DST_HAS_DESC : 0) -@@ -5939,8 +5967,13 @@ PREFIX(get_from_remote)(caf_token_t token, const gfc_descriptor_t *opt_src_desc, - "for internal buffer in get_from_remote()."); - } - dprint("waiting to receive %zd bytes from %d.\n", dst_size, remote_image); -+#ifdef GCC_GE_16 - ierr = MPI_Recv(t_buff, dst_size, MPI_BYTE, remote_image, msg->dest_tag, - CAF_COMM_WORLD, MPI_STATUS_IGNORE); -+#else -+ ierr = MPI_Recv(t_buff, dst_size, MPI_BYTE, image_index - 1, msg->dest_tag, -+ CAF_COMM_WORLD, MPI_STATUS_IGNORE); -+#endif - chk_err(ierr); - dprint("received %zd bytes as requested from %d.\n", dst_size, - remote_image); -@@ -5958,8 +5991,13 @@ PREFIX(get_from_remote)(caf_token_t token, const gfc_descriptor_t *opt_src_desc, - - dprint("probing for incoming message from %d, tag %d.\n", image_index - 1, - msg->dest_tag); -+#ifdef GCC_GE_16 -+ ierr = MPI_Mprobe(remote_image, msg->dest_tag, CAF_COMM_WORLD, &msg_han, -+ &status); -+#else - ierr = MPI_Mprobe(image_index - 1, msg->dest_tag, CAF_COMM_WORLD, &msg_han, - &status); -+#endif - chk_err(ierr); - if (ierr == MPI_SUCCESS) - { -@@ -6062,8 +6100,14 @@ PREFIX(is_present_on_remote)(caf_token_t token, const int image_index, - void *src_ptr = ((mpi_caf_token_t *)token)->memptr; - - dprint("Shortcutting due to self access on image %d.\n", image_index); -- accessor_hash_table[is_present_index].u.is_present( -- add_data, &this_image, &result, &src_ptr, &src_token, 0); -+ accessor_hash_table[is_present_index].u.is_present(add_data, &this_image, -+ &result, -+#ifdef GCC_GE_16 -+ &src_ptr, -+#else -+ src_ptr, -+#endif -+ &src_token, 0); - - return result; - } -@@ -6281,7 +6325,11 @@ PREFIX(send_to_remote)(caf_token_t token, gfc_descriptor_t *opt_dst_desc, - msg->transfer_size = src_size; - msg->opt_charlen = opt_src_charlen ? *opt_src_charlen : 0; - msg->win = *TOKEN(token); -+#ifdef GCC_GE_16 - msg->dest_image = this_image; -+#else -+ msg->dest_image = mpi_this_image; -+#endif - msg->dest_tag = CAF_CT_TAG + 1; - msg->dest_opt_charlen = opt_dst_charlen ? *opt_dst_charlen : 1; - msg->flags = (opt_dst_desc ? CT_DST_HAS_DESC : 0) -@@ -6324,8 +6372,13 @@ PREFIX(send_to_remote)(caf_token_t token, gfc_descriptor_t *opt_dst_desc, - char c; - dprint("waiting to receive 1 byte from %d on tag %d.\n", remote_image, - msg->dest_tag); -+#ifdef GCC_GE_16 - ierr = MPI_Recv(&c, 1, MPI_BYTE, remote_image, msg->dest_tag, - CAF_COMM_WORLD, MPI_STATUS_IGNORE); -+#else -+ ierr = MPI_Recv(&c, 1, MPI_BYTE, image_index - 1, msg->dest_tag, -+ CAF_COMM_WORLD, MPI_STATUS_IGNORE); -+#endif - chk_err(ierr); - dprint("received 1 byte as requested from %d on tag %d.\n", remote_image, - msg->dest_tag); -@@ -6548,7 +6601,11 @@ PREFIX(transfer_between_remotes)( - dst_msg->transfer_size = src_size; - dst_msg->opt_charlen = opt_src_charlen ? *opt_src_charlen : 0; - dst_msg->win = *TOKEN(dst_token); -+#ifdef GCC_GE_16 - dst_msg->dest_image = this_image; -+#else -+ dst_msg->dest_image = mpi_this_image; -+#endif - dst_msg->dest_tag = CAF_CT_TAG + 1; - dst_msg->dest_opt_charlen = opt_dst_charlen ? *opt_dst_charlen : 1; - dst_msg->flags -@@ -6593,8 +6650,13 @@ PREFIX(transfer_between_remotes)( - char c; - dprint("waiting to receive 1 byte from %d on tag %d.\n", dst_remote_image, - dst_msg->dest_tag); -+#ifdef GCC_GE_16 - ierr = MPI_Recv(&c, 1, MPI_BYTE, dst_remote_image, dst_msg->dest_tag, - CAF_COMM_WORLD, MPI_STATUS_IGNORE); -+#else -+ ierr = MPI_Recv(&c, 1, MPI_BYTE, dst_image_index - 1, dst_msg->dest_tag, -+ CAF_COMM_WORLD, MPI_STATUS_IGNORE); -+#endif - chk_err(ierr); - if (dst_stat) - *dst_stat = c; -diff --git a/src/tests/unit/teams/team_number.F90 b/src/tests/unit/teams/team_number.F90 -index a50ebd67..07d15778 100644 ---- a/src/tests/unit/teams/team_number.F90 -+++ b/src/tests/unit/teams/team_number.F90 -@@ -43,7 +43,7 @@ program main - - call assert(team_number()==standard_initial_value,"initial team number conforms with Fortran standard before 'change team'") - --#ifdef GCC_GE_15 -+#ifdef GCC_GE_16 - call assert(team_number(get_team(current_team))==standard_initial_value,"initial team number conforms with Fortran standard before 'change team'") - #endif - diff --git a/sys-cluster/opencoarrays/files/opencoarrays-2.10.3_patch_11_Ensure_gcc-16_compatibility.patch b/sys-cluster/opencoarrays/files/opencoarrays-2.10.3_patch_11_Ensure_gcc-16_compatibility.patch deleted file mode 100644 index eb1b182b14..0000000000 --- a/sys-cluster/opencoarrays/files/opencoarrays-2.10.3_patch_11_Ensure_gcc-16_compatibility.patch +++ /dev/null @@ -1,71 +0,0 @@ -From 8d19ac523d137d6738eb6091cd1695b4d798c044 Mon Sep 17 00:00:00 2001 -From: Andre Vehreschild -Date: Fri, 4 Jul 2025 13:53:18 +0200 -Subject: [PATCH] Ensure gcc-16 compatibility. - -Fix is_present for descriptor arrays in gcc-16. -Remove compiling warning from test_case. ---- - src/runtime-libraries/mpi/mpi_caf.c | 16 ++++++++-------- - src/tests/unit/collectives/co_reduce_string.f90 | 5 ++--- - 2 files changed, 10 insertions(+), 11 deletions(-) - -diff --git a/src/runtime-libraries/mpi/mpi_caf.c b/src/runtime-libraries/mpi/mpi_caf.c -index 91784a529..f235ae792 100644 ---- a/src/runtime-libraries/mpi/mpi_caf.c -+++ b/src/runtime-libraries/mpi/mpi_caf.c -@@ -6095,19 +6095,19 @@ PREFIX(is_present_on_remote)(caf_token_t token, const int image_index, - - if (this_image == remote_image) - { -+ mpi_caf_token_t *mpi_token = (mpi_caf_token_t *)token; - int32_t result = 0; - mpi_caf_token_t src_token = {get_data, MPI_WIN_NULL, NULL}; -- void *src_ptr = ((mpi_caf_token_t *)token)->memptr; -- -- dprint("Shortcutting due to self access on image %d.\n", image_index); -- accessor_hash_table[is_present_index].u.is_present(add_data, &this_image, -- &result, - #ifdef GCC_GE_16 -- &src_ptr, -+ void *src_ptr -+ = mpi_token->desc ? mpi_token->desc : (void *)&mpi_token->memptr; - #else -- src_ptr, -+ void *src_ptr = mpi_token->memptr; - #endif -- &src_token, 0); -+ -+ dprint("Shortcutting due to self access on image %d.\n", image_index); -+ accessor_hash_table[is_present_index].u.is_present( -+ add_data, &this_image, &result, src_ptr, &src_token, 0); - - return result; - } -diff --git a/src/tests/unit/collectives/co_reduce_string.f90 b/src/tests/unit/collectives/co_reduce_string.f90 -index ad094f92a..7b7dad797 100644 ---- a/src/tests/unit/collectives/co_reduce_string.f90 -+++ b/src/tests/unit/collectives/co_reduce_string.f90 -@@ -40,7 +40,7 @@ program co_reduce_strings - associate (me => this_image()) - allocate(strarr(numstrings)[*]) - do i = 1, numstrings -- write(strarr(i), "('foo'I02)") i * me -+ write(strarr(i), "('foo',I02)") i * me - end do - ! Collectively reduce the maximum string. - call co_reduce(strarr, strmax) -@@ -50,7 +50,7 @@ program co_reduce_strings - ! implicitly synchronizes. - associate (np => num_images()) - do i = 1, np -- write (expect, "('foo'I02)") i * np -+ write (expect, "('foo',I02)") i * np - if (strarr(i) /= expect) then - ! On errror print what we got and what we expected. - print *, "Got: ", strarr(i), ", expected: ", expect -@@ -77,4 +77,3 @@ pure function strmax(lhs, rhs) result(maxstr) bind(C,name="strmax") - end function - - end program co_reduce_strings -- diff --git a/sys-cluster/opencoarrays/files/opencoarrays-2.10.3_patch_12_Fix_teams_testcase.patch b/sys-cluster/opencoarrays/files/opencoarrays-2.10.3_patch_12_Fix_teams_testcase.patch deleted file mode 100644 index eb9db28ef1..0000000000 --- a/sys-cluster/opencoarrays/files/opencoarrays-2.10.3_patch_12_Fix_teams_testcase.patch +++ /dev/null @@ -1,27 +0,0 @@ -From 74a5d0ac3f2d6ee5f985a13478a87f309a444b07 Mon Sep 17 00:00:00 2001 -From: Andre Vehreschild -Date: Wed, 9 Jul 2025 13:33:13 +0200 -Subject: [PATCH] Fix team's testcase. - ---- - src/tests/unit/teams/test_teams_1.f90 | 6 +++--- - 1 file changed, 3 insertions(+), 3 deletions(-) - -diff --git a/src/tests/unit/teams/test_teams_1.f90 b/src/tests/unit/teams/test_teams_1.f90 -index 3d94c535..b3f6523d 100644 ---- a/src/tests/unit/teams/test_teams_1.f90 -+++ b/src/tests/unit/teams/test_teams_1.f90 -@@ -43,10 +43,10 @@ program test_teams_1 - form team((me - 1) / 3 + 1, row_team, new_index=mod(me - 1, 3) + 1) - row_t: change team(row_team, row[*] => caf(:, team_number(row_team))) - ! Form column teams; each team has only one image -- form team (team_number(), column_team) -+ form team (this_image(), column_team) - col_t: change team(column_team, cell[*] => row(this_image())) -- cell = team_number() -- if (this_image() /= 1) row(this_image())[1] = cell -+ cell = team_number(row_team) -+ if (this_image(row_team) /= 1) row(this_image(row_team))[1, team=row_team] = cell - end team col_t - sync team(row_team) - if (this_image() == 1) caf(:, team_number(row_team))[1, team_number = -1] = row diff --git a/sys-cluster/opencoarrays/opencoarrays-2.10.3_p20251223.ebuild b/sys-cluster/opencoarrays/opencoarrays-2.10.3_p20251223.ebuild index 653d74e852..27d9f8aa53 100644 --- a/sys-cluster/opencoarrays/opencoarrays-2.10.3_p20251223.ebuild +++ b/sys-cluster/opencoarrays/opencoarrays-2.10.3_p20251223.ebuild @@ -9,13 +9,13 @@ FORTRAN_STANDARD="2003" inherit cmake flag-o-matic fortran-2 MY_PN="OpenCoarrays" -MY_PV="${PV%_*}" +COMMIT="74a5d0ac3f2d6ee5f985a13478a87f309a444b07" DESCRIPTION="A parallel application binary interface for Fortran 2018 compilers" HOMEPAGE="http://www.opencoarrays.org/" -SRC_URI="https://github.com/sourceryinstitute/${MY_PN}/archive/refs/tags/${MY_PV}.tar.gz -> ${MY_PN}-${PV}.tar.gz" +SRC_URI="https://github.com/sourceryinstitute/${MY_PN}/archive/${COMMIT}.tar.gz -> ${P}.tar.gz" -S="${WORKDIR}/${MY_PN}-${MY_PV}" +S="${WORKDIR}/${MY_PN}-${COMMIT}" LICENSE="BSD" SLOT="0" @@ -38,21 +38,6 @@ DEPEND=" ${RDEPEND} " -PATCHES=( - "${FILESDIR}/${PN}-${MY_PV}_patch_01_Improve_teams_implementation.patch" - "${FILESDIR}/${PN}-${MY_PV}_patch_02_Fix_team_number.patch" - "${FILESDIR}/${PN}-${MY_PV}_patch_03_Remove_wrong_error.patch" - "${FILESDIR}/${PN}-${MY_PV}_patch_04_Enchance_debug_logging.patch" - "${FILESDIR}/${PN}-${MY_PV}_patch_05_Add_owning_memory_flag.patch" - "${FILESDIR}/${PN}-${MY_PV}_patch_06_Keep_team_translate_rework.patch" - "${FILESDIR}/${PN}-${MY_PV}_patch_07_Use_COMM_TEAM_instead_of_COMM_WORLD.patch" - "${FILESDIR}/${PN}-${MY_PV}_patch_08_Add_more_beefy_tests.patch" - "${FILESDIR}/${PN}-${MY_PV}_patch_09_Add_comments_to_teams_num_images_test.patch" - "${FILESDIR}/${PN}-${MY_PV}_patch_10_Fixes_for_use_with_gcc_lt_16.patch" - "${FILESDIR}/${PN}-${MY_PV}_patch_11_Ensure_gcc-16_compatibility.patch" - "${FILESDIR}/${PN}-${MY_PV}_patch_12_Fix_teams_testcase.patch" -) - src_configure() { filter-lto # Bug 860765