Make exchanger selectable via environment variable.

* Setting XT_CONFIG_DEFAULT_EXCHANGE_METHOD allows for an adjusted default.

src/xt/xt_config.h

@@ -94,6 +94,18 @@ void xt_config_set_exchange_method(Xt_config config, int method);
  */
 int xt_config_get_exchange_method(Xt_config config);
 
+/**
+ * map exchanger name string to method id from \a Xt_exchangers
+ * @param[in] name string that is supposed to match the part of the
+ * corresponding enum after xt_exchanger_
+ * @return for the string "irecv_send", the value of
+ * xt_exchanger_irecv_send will be returned, for strings matching no
+ * known exchanger, -1 will be returned
+ */
+int
+xt_exchanger_id_by_name(const char *name);
+
+
 #endif
 
 /*

src/xt_config.c

@@ -48,6 +48,8 @@
 #include <config.h>
 #endif
 
+#include <string.h>
+
 #include <mpi.h>
 
 #include <xt/xt_config.h>
@@ -60,7 +62,7 @@
 #include "core/core.h"
 #include "core/ppm_xfuncs.h"
 
-const struct Xt_config_ xt_default_config = {
+struct Xt_config_ xt_default_config = {
   .exchanger_new = xt_exchanger_mix_isend_irecv_new,
 };
 
@@ -76,22 +78,35 @@ void xt_config_delete(Xt_config config)
   free(config);
 }
 
-static struct {
+static const struct {
+  char name[20];
   Xt_exchanger_new f;
   int code;
 } exchanger_table[] = {
-  { xt_exchanger_irecv_send_new, xt_exchanger_irecv_send },
-  { xt_exchanger_irecv_isend_new, xt_exchanger_irecv_isend },
-  { xt_exchanger_irecv_isend_packed_new, xt_exchanger_irecv_isend_packed },
-  { xt_exchanger_mix_isend_irecv_new, xt_exchanger_mix_isend_irecv },
-  { xt_exchanger_neigh_alltoall_new, xt_exchanger_neigh_alltoall },
+  { "irecv_send",
+    xt_exchanger_irecv_send_new, xt_exchanger_irecv_send },
+  { "irecv_isend",
+    xt_exchanger_irecv_isend_new, xt_exchanger_irecv_isend },
+  { "irecv_isend_packed",
+    xt_exchanger_irecv_isend_packed_new, xt_exchanger_irecv_isend_packed },
+  { "mix_irecv_isend",
+    xt_exchanger_mix_isend_irecv_new, xt_exchanger_mix_isend_irecv },
+  { "neigh_alltoall",
+    xt_exchanger_neigh_alltoall_new, xt_exchanger_neigh_alltoall },
 };
 
 enum {
   num_exchanger = sizeof (exchanger_table) / sizeof (exchanger_table[0]),
 };
 
-
+int
+xt_exchanger_id_by_name(const char *name)
+{
+  for (size_t i = 0; i < num_exchanger; ++i)
+    if (!strcmp(name, exchanger_table[i].name))
+      return exchanger_table[i].code;
+  return -1;
+}
 
 int xt_config_get_exchange_method(Xt_config config)
 {
@@ -121,7 +136,16 @@ void xt_config_set_exchange_method(Xt_config config, int method)
   Xt_abort(Xt_default_comm, buf, "xt_config.c", __LINE__);
 }
 
-
+void
+xt_config_defaults_init(void)
+{
+  const char *config_env = getenv("XT_CONFIG_DEFAULT_EXCHANGE_METHOD");
+  if (config_env) {
+    int exchanger_id = xt_exchanger_id_by_name(config_env);
+    if (exchanger_id != -1)
+      xt_config_set_exchange_method(&xt_default_config, exchanger_id);
+  }
+}
 
 /*
  * Local Variables:

src/xt_config_f.f90

@@ -46,7 +46,8 @@
 ! SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 !
 MODULE xt_config_f
-  USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_ptr, c_null_ptr, c_int
+  USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_ptr, c_null_ptr, c_int, &
+       c_char, c_null_char
   IMPLICIT NONE
   PRIVATE
   ! note: this type must not be extended to contain any other
@@ -72,6 +73,7 @@ MODULE xt_config_f
 
   PUBLIC :: xt_config_new, xt_config_delete
   PUBLIC :: xt_config_f2c
+  PUBLIC :: xt_exchanger_id_by_name
   PUBLIC :: xt_config_get_exchange_method, xt_config_set_exchange_method
   INTEGER, PUBLIC, PARAMETER :: &
        xt_exchanger_irecv_send = 0, &
@@ -137,6 +139,29 @@ CONTAINS
     method = INT(xt_config_get_exchange_method_c(config%cptr))
   END FUNCTION xt_config_get_exchange_method
 
+  FUNCTION xt_exchanger_id_by_name(name) RESULT(exchanger_id)
+    CHARACTER(len=*), INTENT(in) :: name
+    INTEGER :: exchanger_id
+    INTERFACE
+      FUNCTION xt_exchanger_id_by_name_c(name) RESULT(exchanger_id) &
+           BIND(c, name='xt_exchanger_id_by_name')
+        IMPORT :: c_char, c_int
+        CHARACTER(len=1, kind=c_char), INTENT(in) :: name(*)
+        INTEGER(c_int) :: exchanger_id
+      END FUNCTION xt_exchanger_id_by_name_c
+    END INTERFACE
+    INTEGER(c_int) :: c_id
+    CHARACTER(len=1) :: name_c(LEN(name)+1)
+    INTEGER :: i, nlen
+    nlen = LEN(name)
+    DO i = 1, nlen
+      name_c(i) = name(i:i)
+    END DO
+    name_c(nlen+1) = c_null_char
+    c_id = xt_exchanger_id_by_name_c(name_c)
+    exchanger_id = INT(c_id)
+  END FUNCTION xt_exchanger_id_by_name
+
 END MODULE xt_config_f
 !
 ! Local Variables:

src/xt_config_internal.h

@@ -58,7 +58,10 @@ struct Xt_config_ {
   Xt_exchanger_new exchanger_new;
 };
 
-extern const struct Xt_config_ xt_default_config;
+extern struct Xt_config_ xt_default_config;
+
+void
+xt_config_defaults_init(void);
 
 /*
  * Local Variables:

src/xt_init.c

@@ -49,6 +49,7 @@
 
 #include <stdlib.h>
 #include "core/core.h"
+#include "xt_config_internal.h"
 #include "xt_idxlist_internal.h"
 #include "xt_idxstripes_internal.h"
 #include "xt_idxsection_internal.h"
@@ -70,6 +71,7 @@ xt_initialize(MPI_Comm default_comm)
 {
   Xt_default_comm = default_comm;
   xt_mpi_init();
+  xt_config_defaults_init();
   xt_idxempty_init();
   xt_idxstripes_initialize();
   xt_idxsection_initialize();

src/yaxt.f90

@@ -56,6 +56,7 @@ MODULE yaxt
        xt_pos_ext, OPERATOR(/=), OPERATOR(==), &
        xt_set_abort_handler => set_abort_handler, xt_restore_default_abort_hndl
   USE xt_config_f, ONLY: xt_config, xt_config_new, xt_config_delete, &
+       xt_exchanger_id_by_name, &
        xt_config_get_exchange_method, xt_config_set_exchange_method, &
        xt_exchanger_irecv_send, xt_exchanger_irecv_isend, &
        xt_exchanger_irecv_isend_packed, xt_exchanger_mix_isend_irecv, &
@@ -179,6 +180,7 @@ MODULE yaxt
        xt_redist_a_exchange
 
   PUBLIC :: xt_config, xt_config_new, xt_config_delete, &
+       xt_exchanger_id_by_name, &
        xt_config_get_exchange_method, xt_config_set_exchange_method, &
        xt_exchanger_irecv_send, xt_exchanger_irecv_isend, &
        xt_exchanger_irecv_isend_packed, xt_exchanger_mix_isend_irecv, &

tests/test_exchanger_parallel.c

@@ -144,7 +144,7 @@ static Xt_exchanger_new *parse_options(int *argc, char ***argv)
     switch (opt) {
     case 'm':
       {
-        int exchanger_new_id = exchanger_id_by_name(optarg);
+        int exchanger_new_id = xt_exchanger_id_by_name(optarg);
         if (exchanger_new_id == -1)
         {
           fprintf(stderr, "Unknown exchanger constructor requested: %s\n",

tests/test_redist_common.c

@@ -258,26 +258,6 @@ wrap_a_exchange1(Xt_redist redist, const void *src_data_p, void *dst_data_p)
   check_wait_request(&request);
 }
 
-
-int
-exchanger_id_by_name(const char *name)
-{
-  int exchanger_new;
-  if (!strcmp(name, "irecv_isend"))
-    exchanger_new = xt_exchanger_irecv_isend;
-  else if (!strcmp(name, "irecv_isend_packed"))
-    exchanger_new = xt_exchanger_irecv_isend_packed;
-  else if (!strcmp(name, "irecv_send"))
-    exchanger_new = xt_exchanger_irecv_send;
-  else if (!strcmp(name, "mix_irecv_isend"))
-    exchanger_new = xt_exchanger_mix_isend_irecv;
-  else if (!strcmp(name, "neigh_alltoall"))
-    exchanger_new = xt_exchanger_neigh_alltoall;
-  else
-    exchanger_new = -1;
-  return exchanger_new;
-}
-
 Xt_config
 redist_exchanger_option(int *argc, char ***argv)
 {
@@ -287,7 +267,7 @@ redist_exchanger_option(int *argc, char ***argv)
     switch (opt) {
     case 'm':
       {
-        int exchanger_id = exchanger_id_by_name(optarg);
+        int exchanger_id = xt_exchanger_id_by_name(optarg);
         if (exchanger_id != -1)
           xt_config_set_exchange_method(config, exchanger_id);
         else {

tests/test_redist_common.h

@@ -167,9 +167,6 @@ check_wait_request_(Xt_request *request, const char *file, int line);
 #define check_wait_request(request) \
   check_wait_request_(request, __FILE__, __LINE__)
 
-int
-exchanger_id_by_name(const char *name);
-
 Xt_config
 redist_exchanger_option(int *argc, char ***argv);
 

tests/test_redist_common_f.f90

@@ -57,7 +57,7 @@ MODULE test_redist_common
        xt_request, xt_request_wait, xt_request_test, xt_is_null, &
        xt_redist_get_num_recv_msg, xt_redist_get_num_send_msg, &
        xi => xt_int_kind, xt_config, xt_config_new, &
-       xt_config_set_exchange_method
+       xt_config_set_exchange_method, xt_exchanger_id_by_name
 #ifdef __PGI
   ! PGI up to at least 15.4 has a bug that prevents proper import of
   ! multiply extended generics. This is a separate bug from the one exhibited
@@ -579,19 +579,10 @@ CONTAINS
 
   FUNCTION redist_exchanger_option() RESULT(config)
     TYPE(xt_config) :: config
-    INTEGER :: i, j, num_cmd_args, arg_len
-    INTEGER(c_int) :: exchanger_id
+    INTEGER :: i, num_cmd_args, arg_len
+    INTEGER :: exchanger_id
     INTEGER, PARAMETER :: max_opt_arg_len = 80
     CHARACTER(max_opt_arg_len) :: optarg
-    CHARACTER(len=1, kind=c_char) :: optarg_c(max_opt_arg_len+1)
-    INTERFACE
-      FUNCTION exchanger_id_by_name(name) RESULT(exchanger_id) &
-           BIND(c, name='exchanger_id_by_name')
-        IMPORT :: c_char, c_int
-        CHARACTER(len=1, kind=c_char), INTENT(in) :: name(*)
-        INTEGER(c_int) :: exchanger_id
-      END FUNCTION exchanger_id_by_name
-    END INTERFACE
     config = xt_config_new()
     num_cmd_args = COMMAND_ARGUMENT_COUNT()
     i = 1
@@ -602,17 +593,13 @@ CONTAINS
         IF (arg_len > max_opt_arg_len) &
              CALL test_abort('incorrect argument to command-line option -s', &
              filename, __LINE__)
-        DO j = 1, arg_len
-          optarg_c(j) = optarg(j:j)
-        END DO
-        optarg_c(arg_len+1) = c_null_char
-        exchanger_id = exchanger_id_by_name(optarg_c)
-        IF (exchanger_id == -1_c_int) THEN
+        exchanger_id = xt_exchanger_id_by_name(optarg)
+        IF (exchanger_id == -1) THEN
           WRITE (0, *) 'arg to -m: ', optarg(1:arg_len)
           CALL test_abort('incorrect argument to command-line option -m', &
                filename, __LINE__)
         END IF
-        CALL xt_config_set_exchange_method(config, INT(exchanger_id))
+        CALL xt_config_set_exchange_method(config, exchanger_id)
         i = i + 2
       ELSE
         WRITE (0, *) 'unexpected command-line argument parsing error: ', &