From: degomme Date: Fri, 5 Apr 2019 13:09:12 +0000 (+0200) Subject: Spring cleaning : remove manual privatization from 2010. X-Git-Tag: v3.22.2~164^2~7 X-Git-Url: http://info.iut-bm.univ-fcomte.fr/pub/gitweb/simgrid.git/commitdiff_plain/3a90102759eb860fd96bc294542d3aa38f5b208d?ds=sidebyside Spring cleaning : remove manual privatization from 2010. It's 2019, dlopen and mmap are supported everywhere we want it to be. So long, and thanks for all the fish. --- diff --git a/include/smpi/smpi.h b/include/smpi/smpi.h index ad5117115a..cc9755f3bd 100644 --- a/include/smpi/smpi.h +++ b/include/smpi/smpi.h @@ -1055,68 +1055,6 @@ XBT_PUBLIC void SMPI_app_instance_register(const char* name, xbt_main_func_t cod XBT_PUBLIC void SMPI_init(); XBT_PUBLIC void SMPI_finalize(); -/* Manual global privatization fallback */ -XBT_PUBLIC void smpi_register_static(void* arg, void_f_pvoid_t free_fn); -XBT_PUBLIC void smpi_free_static(); - -#define SMPI_VARINIT_GLOBAL(name,type) \ -type *name = NULL; \ -static void __attribute__((constructor)) __preinit_##name(void) { \ - if(!name) \ - name = (type*)calloc(smpi_global_size(), sizeof(type)); \ -} \ -static void __attribute__((destructor)) __postfini_##name(void) { \ - free(name); \ - name = NULL; \ -} - -#define SMPI_VARINIT_GLOBAL_AND_SET(name,type,expr) \ -type *name = NULL; \ -static void __attribute__((constructor)) __preinit_##name(void) { \ - size_t size = smpi_global_size(); \ - size_t i; \ - type value = expr; \ - if(!name) { \ - name = (type*)malloc(size * sizeof(type)); \ - for(i = 0; i < size; i++) { \ - name[i] = value; \ - } \ - } \ -} \ -static void __attribute__((destructor)) __postfini_##name(void) { \ - free(name); \ - name = NULL; \ -} - -#define SMPI_VARGET_GLOBAL(name) name[SIMIX_process_self()->pid] - -/** - * This is used for the old privatization method, i.e., on old - * machines that do not yet support privatization via mmap - */ -#define SMPI_VARINIT_STATIC(name,type) \ -static type *name = NULL; \ -if(!name) { \ - name = (type*)calloc(smpi_global_size(), sizeof(type)); \ - smpi_register_static(name, xbt_free_f); \ -} - -#define SMPI_VARINIT_STATIC_AND_SET(name,type,expr) \ -static type *name = NULL; \ -if(!name) { \ - size_t size = smpi_global_size(); \ - size_t i; \ - type value = expr; \ - name = (type*)malloc(size * sizeof(type)); \ - for(i = 0; i < size; i++) { \ - name[i] = value; \ - } \ - smpi_register_static(name, xbt_free_f); \ -} - -#define SMPI_VARGET_STATIC(name) name[SIMIX_process_self()->pid] - - SG_END_DECL() /* C++ declarations for shared_malloc */ diff --git a/src/smpi/internals/smpi_global.cpp b/src/smpi/internals/smpi_global.cpp index 408be49dbd..425d737af4 100644 --- a/src/smpi/internals/smpi_global.cpp +++ b/src/smpi/internals/smpi_global.cpp @@ -139,15 +139,6 @@ void smpi_process_set_user_data(void *data){ simgrid::s4u::Actor::self()->get_impl()->set_user_data(data); } - -int smpi_global_size() -{ - char *value = getenv("SMPI_GLOBAL_SIZE"); - xbt_assert(value,"Please set env var SMPI_GLOBAL_SIZE to the expected number of processes."); - - return xbt_str_parse_int(value, "SMPI_GLOBAL_SIZE contains a non-numerical value: %s"); -} - void smpi_comm_set_copy_data_callback(void (*callback) (smx_activity_t, void*, size_t)) { static void (*saved_callback)(smx_activity_t, void*, size_t); @@ -366,7 +357,6 @@ void smpi_global_destroy() if (smpi_privatize_global_variables == SmpiPrivStrategies::MMAP) smpi_destroy_global_memory_segments(); - smpi_free_static(); if(simgrid::smpi::F2C::lookup() != nullptr) simgrid::smpi::F2C::delete_lookup(); } diff --git a/src/smpi/internals/smpi_static_variables.cpp b/src/smpi/internals/smpi_static_variables.cpp deleted file mode 100644 index c7edae08de..0000000000 --- a/src/smpi/internals/smpi_static_variables.cpp +++ /dev/null @@ -1,32 +0,0 @@ -/* Copyright (c) 2011-2019. The SimGrid Team. All rights reserved. */ - -/* This program is free software; you can redistribute it and/or modify it - * under the terms of the license (GNU LGPL) which comes with this package. */ - -#include "private.hpp" -#include - -struct s_smpi_static_t { - void *ptr; - void_f_pvoid_t free_fn; -}; - -/** - * @brief Holds a reference to all static variables that were registered - * via smpi_register_static(). This helps to free them when - * SMPI shuts down. - */ -static std::stack registered_static_variables_stack; - -void smpi_register_static(void* arg, void_f_pvoid_t free_fn) { - s_smpi_static_t elm { arg, free_fn }; - registered_static_variables_stack.push(elm); -} - -void smpi_free_static() { - while (not registered_static_variables_stack.empty()) { - s_smpi_static_t elm = registered_static_variables_stack.top(); - elm.free_fn(elm.ptr); - registered_static_variables_stack.pop(); - } -} diff --git a/src/smpi/smpirun.in b/src/smpi/smpirun.in index 03c626466b..bf1646c33d 100755 --- a/src/smpi/smpirun.in +++ b/src/smpi/smpirun.in @@ -505,7 +505,6 @@ if [ -n "${TRACE_ACTIVE}" ]; then fi ##---------------------- end SMPI TRACING OPTIONS --------------------------------- -export SMPI_GLOBAL_SIZE=${NUMPROCS} if [ -n "${KEEP}" ] ; then echo ${EXEC} ${PRIVATIZE} ${TRACEOPTIONS} ${SIMOPTS} ${PLATFORMTMP} ${APPLICATIONTMP} if [ ${HOSTFILETMP} = 1 ] ; then diff --git a/teshsuite/smpi/mpich3-test/CMakeLists.txt b/teshsuite/smpi/mpich3-test/CMakeLists.txt index 140fedbf8d..b8c8967a96 100644 --- a/teshsuite/smpi/mpich3-test/CMakeLists.txt +++ b/teshsuite/smpi/mpich3-test/CMakeLists.txt @@ -21,9 +21,6 @@ set(txt_files ${txt_files} ${CMAKE_CURRENT_SOURCE_DIR}/README ${CMAKE_CURRENT_SOURCE_DIR}/util/mtestcheck.c ${CMAKE_CURRENT_SOURCE_DIR}/util/mtest_datatype.c ${CMAKE_CURRENT_SOURCE_DIR}/util/mtest_datatype_gen.c - ${CMAKE_CURRENT_SOURCE_DIR}/util/mtest_manual.c - ${CMAKE_CURRENT_SOURCE_DIR}/util/mtest_datatype_gen_manual.c - ${CMAKE_CURRENT_SOURCE_DIR}/util/dtypes_manual.c ${CMAKE_CURRENT_SOURCE_DIR}/f77/testlist ${CMAKE_CURRENT_SOURCE_DIR}/f90/testlist ${CMAKE_CURRENT_SOURCE_DIR}/include/dtypes.h @@ -47,11 +44,10 @@ include_directories("${CMAKE_HOME_DIRECTORY}/include/smpi") include_directories("${CMAKE_CURRENT_SOURCE_DIR}/include/") if(enable_smpi AND enable_smpi_MPICH3_testsuite) -#C version - use automatic privatization if mmap is supported, manual through SMPI macros if not if(HAVE_PRIVATIZATION) add_library(mtest_c STATIC util/dtypes.c util/mtest.c util/mtestcheck.c util/mtest_datatype.c util/mtest_datatype_gen.c) else() - add_library(mtest_c STATIC util/mtest_manual.c util/dtypes_manual.c util/mtestcheck.c util/mtest_datatype.c util/mtest_datatype_gen_manual.c) + message(FATAL_ERROR "MPICH testsuite needs privatization. Use a modern OS.") endif() endif() diff --git a/teshsuite/smpi/mpich3-test/coll/CMakeLists.txt b/teshsuite/smpi/mpich3-test/coll/CMakeLists.txt index 31c0a0d21f..3fd1c540f9 100644 --- a/teshsuite/smpi/mpich3-test/coll/CMakeLists.txt +++ b/teshsuite/smpi/mpich3-test/coll/CMakeLists.txt @@ -21,7 +21,7 @@ if(enable_smpi AND enable_smpi_MPICH3_testsuite) # opband opbor opbxor opland oplor oplxor opmax opmaxloc # opmin opminloc opprod opsum nonblocking3 op_commutative red3 red4 redscat2 redscat3 redscatbkinter redscatblk3 - redscat red_scat_block red_scat_block2 + redscat red_scat_block red_scat_block2 allgatherv4 allred # redscatinter reduce_local scantst scatter2 scatter3 scattern scatterv # uoplong @@ -31,15 +31,6 @@ if(enable_smpi AND enable_smpi_MPICH3_testsuite) target_link_libraries(${test} simgrid mtest_c) endforeach() - foreach(test allgatherv4 allred) - if(HAVE_PRIVATIZATION) - add_executable(${test} EXCLUDE_FROM_ALL ${test}.c) - else() - add_executable(${test} EXCLUDE_FROM_ALL ${test}_manual.c) - endif() - add_dependencies(tests ${test}) - target_link_libraries(${test} simgrid mtest_c) - endforeach() set_target_properties(allred PROPERTIES COMPILE_FLAGS "-O0" LINK_FLAGS "-O0") foreach(test bcast_full bcast_min_datatypes bcast_comm_world) @@ -98,14 +89,12 @@ set(examples_src ${examples_src} ${CMAKE_CURRENT_SOURCE_DIR}/allgatherv2.c ${CMAKE_CURRENT_SOURCE_DIR}/allgatherv3.c ${CMAKE_CURRENT_SOURCE_DIR}/allgatherv4.c - ${CMAKE_CURRENT_SOURCE_DIR}/allgatherv4_manual.c ${CMAKE_CURRENT_SOURCE_DIR}/allred2.c ${CMAKE_CURRENT_SOURCE_DIR}/allred3.c ${CMAKE_CURRENT_SOURCE_DIR}/allred4.c ${CMAKE_CURRENT_SOURCE_DIR}/allred5.c ${CMAKE_CURRENT_SOURCE_DIR}/allred6.c ${CMAKE_CURRENT_SOURCE_DIR}/allred.c - ${CMAKE_CURRENT_SOURCE_DIR}/allred_manual.c ${CMAKE_CURRENT_SOURCE_DIR}/allredmany.c ${CMAKE_CURRENT_SOURCE_DIR}/alltoall1.c ${CMAKE_CURRENT_SOURCE_DIR}/alltoallv0.c diff --git a/teshsuite/smpi/mpich3-test/coll/allgatherv4_manual.c b/teshsuite/smpi/mpich3-test/coll/allgatherv4_manual.c deleted file mode 100644 index ff76581de6..0000000000 --- a/teshsuite/smpi/mpich3-test/coll/allgatherv4_manual.c +++ /dev/null @@ -1,254 +0,0 @@ -/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ -/* - * - * (C) 2003 by Argonne National Laboratory. - * See COPYRIGHT in top-level directory. - */ - -#include "mpi.h" -#include "mpitest.h" -#include -#include -#ifdef HAVE_SYS_TIME_H -#include -#endif -#include -#include -#include - -/* FIXME: What is this test supposed to accomplish? */ - -#define START_BUF (1) -#define LARGE_BUF (256 * 1024) - -/* FIXME: MAX_BUF is too large */ -#define MAX_BUF (32 * 1024 * 1024) -#define LOOPS 10 - -SMPI_VARINIT_GLOBAL(sbuf, char*); -SMPI_VARINIT_GLOBAL(rbuf, char*); -SMPI_VARINIT_GLOBAL(recvcounts, int*); -SMPI_VARINIT_GLOBAL(displs, int*); -SMPI_VARINIT_GLOBAL_AND_SET(errs, int, 0); - -/* #define dprintf printf */ -#define dprintf(...) - -typedef enum { - REGULAR, - BCAST, - SPIKE, - HALF_FULL, - LINEAR_DECREASE, - BELL_CURVE -} test_t; - -void comm_tests(MPI_Comm comm); -double run_test(long long msg_size, MPI_Comm comm, test_t test_type, double * max_time); - -int main(int argc, char ** argv) -{ - int comm_size, comm_rank; - MPI_Comm comm; - - MTest_Init(&argc, &argv); - MPI_Comm_size(MPI_COMM_WORLD, &comm_size); - MPI_Comm_rank(MPI_COMM_WORLD, &comm_rank); - - if (LARGE_BUF * comm_size > MAX_BUF) - goto fn_exit; - - SMPI_VARGET_GLOBAL(sbuf) = (void *) calloc(MAX_BUF, 1); - SMPI_VARGET_GLOBAL(rbuf) = (void *) calloc(MAX_BUF, 1); - - srand(time(NULL)); - - SMPI_VARGET_GLOBAL(recvcounts) = (void *) malloc(comm_size * sizeof(int)); - SMPI_VARGET_GLOBAL(displs) = (void *) malloc(comm_size * sizeof(int)); - if (!SMPI_VARGET_GLOBAL(recvcounts) || !SMPI_VARGET_GLOBAL(displs) || !SMPI_VARGET_GLOBAL(sbuf) || !SMPI_VARGET_GLOBAL(rbuf)) { - fprintf(stderr, "Unable to allocate memory:\n"); - if (!SMPI_VARGET_GLOBAL(sbuf)) - fprintf(stderr,"\tsbuf of %d bytes\n", MAX_BUF ); - if (!SMPI_VARGET_GLOBAL(rbuf)) - fprintf(stderr,"\trbuf of %d bytes\n", MAX_BUF ); - if (!SMPI_VARGET_GLOBAL(recvcounts)) - fprintf(stderr,"\trecvcounts of %zu bytes\n", comm_size * sizeof(int)); - if (!SMPI_VARGET_GLOBAL(displs)) - fprintf(stderr,"\tdispls of %zu bytes\n", comm_size * sizeof(int)); - fflush(stderr); - MPI_Abort(MPI_COMM_WORLD, -1); - exit(-1); - } - - if (!comm_rank) { - dprintf("Message Range: (%d, %d); System size: %d\n", START_BUF, LARGE_BUF, comm_size); - fflush(stdout); - } - - - /* COMM_WORLD tests */ - if (!comm_rank) { - dprintf("\n\n==========================================================\n"); - dprintf(" MPI_COMM_WORLD\n"); - dprintf("==========================================================\n"); - } - comm_tests(MPI_COMM_WORLD); - - /* non-COMM_WORLD tests */ - if (!comm_rank) { - dprintf("\n\n==========================================================\n"); - dprintf(" non-COMM_WORLD\n"); - dprintf("==========================================================\n"); - } - MPI_Comm_split(MPI_COMM_WORLD, (comm_rank == comm_size - 1) ? 0 : 1, 0, &comm); - if (comm_rank < comm_size - 1) - comm_tests(comm); - MPI_Comm_free(&comm); - - /* Randomized communicator tests */ - if (!comm_rank) { - dprintf("\n\n==========================================================\n"); - dprintf(" Randomized Communicator\n"); - dprintf("==========================================================\n"); - } - MPI_Comm_split(MPI_COMM_WORLD, 0, rand(), &comm); - comm_tests(comm); - MPI_Comm_free(&comm); - - //free(SMPI_VARGET_GLOBAL(sbuf)); - //free(SMPI_VARGET_GLOBAL(rbuf)); - free(SMPI_VARGET_GLOBAL(recvcounts)); - free(SMPI_VARGET_GLOBAL(displs)); - -fn_exit: - MTest_Finalize(SMPI_VARGET_GLOBAL(errs)); - MPI_Finalize(); - - return 0; -} - -void comm_tests(MPI_Comm comm) -{ - int comm_size, comm_rank; - double rtime = rtime; /* stop warning about unused variable */ - double max_time; - long long msg_size; - - MPI_Comm_size(comm, &comm_size); - MPI_Comm_rank(comm, &comm_rank); - - for (msg_size = START_BUF; msg_size <= LARGE_BUF; msg_size *= 2) { - if (!comm_rank) { - dprintf("\n====> MSG_SIZE: %d\n", (int) msg_size); - fflush(stdout); - } - - rtime = run_test(msg_size, comm, REGULAR, &max_time); - if (!comm_rank) { - dprintf("REGULAR:\tAVG: %.3f\tMAX: %.3f\n", rtime, max_time); - fflush(stdout); - } - - rtime = run_test(msg_size, comm, BCAST, &max_time); - if (!comm_rank) { - dprintf("BCAST:\tAVG: %.3f\tMAX: %.3f\n", rtime, max_time); - fflush(stdout); - } - - rtime = run_test(msg_size, comm, SPIKE, &max_time); - if (!comm_rank) { - dprintf("SPIKE:\tAVG: %.3f\tMAX: %.3f\n", rtime, max_time); - fflush(stdout); - } - - rtime = run_test(msg_size, comm, HALF_FULL, &max_time); - if (!comm_rank) { - dprintf("HALF_FULL:\tAVG: %.3f\tMAX: %.3f\n", rtime, max_time); - fflush(stdout); - } - - rtime = run_test(msg_size, comm, LINEAR_DECREASE, &max_time); - if (!comm_rank) { - dprintf("LINEAR_DECREASE:\tAVG: %.3f\tMAX: %.3f\n", rtime, max_time); - fflush(stdout); - } - - rtime = run_test(msg_size, comm, BELL_CURVE, &max_time); - if (!comm_rank) { - dprintf("BELL_CURVE:\tAVG: %.3f\tMAX: %.3f\n", rtime, max_time); - fflush(stdout); - } - } -} - -double run_test(long long msg_size, MPI_Comm comm, test_t test_type, - double * max_time) -{ - int i, j; - int comm_size, comm_rank; - double start, end; - double total_time, avg_time; - MPI_Aint tmp; - - MPI_Comm_size(comm, &comm_size); - MPI_Comm_rank(comm, &comm_rank); - - SMPI_VARGET_GLOBAL(displs)[0] = 0; - for (i = 0; i < comm_size; i++) { - if (test_type == REGULAR) - SMPI_VARGET_GLOBAL(recvcounts)[i] = msg_size; - else if (test_type == BCAST) - SMPI_VARGET_GLOBAL(recvcounts)[i] = (!i) ? msg_size : 0; - else if (test_type == SPIKE) - SMPI_VARGET_GLOBAL(recvcounts)[i] = (!i) ? (msg_size / 2) : (msg_size / (2 * (comm_size - 1))); - else if (test_type == HALF_FULL) - SMPI_VARGET_GLOBAL(recvcounts)[i] = (i < (comm_size / 2)) ? (2 * msg_size) : 0; - else if (test_type == LINEAR_DECREASE) { - tmp = 2 * msg_size * (comm_size - 1 - i) / (comm_size - 1); - if (tmp != (int)tmp) { - fprintf( stderr, "Integer overflow in variable tmp\n" ); - MPI_Abort( MPI_COMM_WORLD, 1 ); - exit(1); - } - SMPI_VARGET_GLOBAL(recvcounts)[i] = (int) tmp; - - /* If the maximum message size is too large, don't run */ - if (tmp > MAX_BUF) return 0; - } - else if (test_type == BELL_CURVE) { - for (j = 0; j < i; j++) { - if (i - 1 + j >= comm_size) continue; - tmp = msg_size * comm_size / (log(comm_size) * i); - SMPI_VARGET_GLOBAL(recvcounts)[i - 1 + j] = (int) tmp; - SMPI_VARGET_GLOBAL(displs)[i - 1 + j] = 0; - - /* If the maximum message size is too large, don't run */ - if (tmp > MAX_BUF) return 0; - } - } - - if (i < comm_size - 1) - SMPI_VARGET_GLOBAL(displs)[i+1] = SMPI_VARGET_GLOBAL(displs)[i] + SMPI_VARGET_GLOBAL(recvcounts)[i]; - } - - /* Test that: - 1: sbuf is large enough - 2: rbuf is large enough - 3: There were no failures (e.g., tmp nowhere > rbuf size - */ - MPI_Barrier(comm); - start = MPI_Wtime(); - for (i = 0; i < LOOPS; i++) { - MPI_Allgatherv(SMPI_VARGET_GLOBAL(sbuf), SMPI_VARGET_GLOBAL(recvcounts)[comm_rank], MPI_CHAR, - SMPI_VARGET_GLOBAL(rbuf), SMPI_VARGET_GLOBAL(recvcounts), SMPI_VARGET_GLOBAL(displs), MPI_CHAR, comm); - } - end = MPI_Wtime(); - MPI_Barrier(comm); - - /* Convert to microseconds (why?) */ - total_time = 1.0e6 * (end - start); - MPI_Reduce(&total_time, &avg_time, 1, MPI_DOUBLE, MPI_SUM, 0, comm); - MPI_Reduce(&total_time, max_time, 1, MPI_DOUBLE, MPI_MAX, 0, comm); - - return (avg_time / (LOOPS * comm_size)); -} diff --git a/teshsuite/smpi/mpich3-test/coll/allred_manual.c b/teshsuite/smpi/mpich3-test/coll/allred_manual.c deleted file mode 100644 index ee57daaa92..0000000000 --- a/teshsuite/smpi/mpich3-test/coll/allred_manual.c +++ /dev/null @@ -1,466 +0,0 @@ -/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ -/* - * (C) 2001 by Argonne National Laboratory. - * See COPYRIGHT in top-level directory. - */ -/* Warning - this test will fail for MPI_PROD & maybe MPI_SUM - * if more than 10 MPI processes are used. Loss of precision - * will occur as the number of processors is increased. - */ - -#include "mpi.h" -#include "mpitest.h" -#include -#include -#include -#ifdef HAVE_STDINT_H -#include -#endif - - -SMPI_VARINIT_GLOBAL(count, int); -SMPI_VARINIT_GLOBAL(size, int); -SMPI_VARINIT_GLOBAL(rank, int); -SMPI_VARINIT_GLOBAL(cerrcnt, int); - - -struct int_test { - int a; - int b; -}; -struct long_test { - long a; - int b; -}; -struct short_test { - short a; - int b; -}; -struct float_test { - float a; - int b; -}; -struct double_test { - double a; - int b; -}; - -#define mpi_op2str(op) \ - ((op == MPI_SUM) ? "MPI_SUM" : \ - (op == MPI_PROD) ? "MPI_PROD" : \ - (op == MPI_MAX) ? "MPI_MAX" : \ - (op == MPI_MIN) ? "MPI_MIN" : \ - (op == MPI_LOR) ? "MPI_LOR" : \ - (op == MPI_LXOR) ? "MPI_LXOR" : \ - (op == MPI_LAND) ? "MPI_LAND" : \ - (op == MPI_BOR) ? "MPI_BOR" : \ - (op == MPI_BAND) ? "MPI_BAND" : \ - (op == MPI_BXOR) ? "MPI_BXOR" : \ - (op == MPI_MAXLOC) ? "MPI_MAXLOC" : \ - (op == MPI_MINLOC) ? "MPI_MINLOC" : \ - "MPI_NO_OP") - -/* calloc to avoid spurious valgrind warnings when "type" has padding bytes */ -#define DECL_MALLOC_IN_OUT_SOL(type) \ - type *in, *out, *sol; \ - in = (type *) calloc(SMPI_VARGET_GLOBAL(count), sizeof(type)); \ - out = (type *) calloc(SMPI_VARGET_GLOBAL(count), sizeof(type)); \ - sol = (type *) calloc(SMPI_VARGET_GLOBAL(count), sizeof(type)); - -#define SET_INDEX_CONST(arr, val) \ - { \ - int i; \ - for (i = 0; i < SMPI_VARGET_GLOBAL(count); i++) \ - arr[i] = val; \ - } - -#define SET_INDEX_SUM(arr, val) \ - { \ - int i; \ - for (i = 0; i < SMPI_VARGET_GLOBAL(count); i++) \ - arr[i] = i + val; \ - } - -#define SET_INDEX_FACTOR(arr, val) \ - { \ - int i; \ - for (i = 0; i < SMPI_VARGET_GLOBAL(count); i++) \ - arr[i] = i * (val); \ - } - -#define SET_INDEX_POWER(arr, val) \ - { \ - int i, j; \ - for (i = 0; i < SMPI_VARGET_GLOBAL(count); i++) { \ - (arr)[i] = 1; \ - for (j = 0; j < (val); j++) \ - arr[i] *= i; \ - } \ - } - -#define ERROR_CHECK_AND_FREE(lerrcnt, mpi_type, mpi_op) \ - do { \ - char name[MPI_MAX_OBJECT_NAME] = {0}; \ - int len = 0; \ - if (lerrcnt) { \ - MPI_Type_get_name(mpi_type, name, &len); \ - fprintf(stderr, "(%d) Error for type %s and op %s\n", \ - SMPI_VARGET_GLOBAL(rank), name, mpi_op2str(mpi_op)); \ - } \ - free(in); free(out); free(sol); \ - } while (0) - -/* The logic on the error check on MPI_Allreduce assumes that all - MPI_Allreduce routines return a failure if any do - this is sufficient - for MPI implementations that reject some of the valid op/datatype pairs - (and motivated this addition, as some versions of the IBM MPI - failed in just this way). -*/ -#define ALLREDUCE_AND_FREE(mpi_type, mpi_op, in, out, sol) \ - { \ - int i, rc, lerrcnt = 0; \ - rc = MPI_Allreduce(in, out, SMPI_VARGET_GLOBAL(count), mpi_type, mpi_op, MPI_COMM_WORLD); \ - if (rc) { lerrcnt++; SMPI_VARGET_GLOBAL(cerrcnt)++; MTestPrintError(rc); } \ - else { \ - for (i = 0; i < SMPI_VARGET_GLOBAL(count); i++) { \ - if (out[i] != sol[i]) { \ - SMPI_VARGET_GLOBAL(cerrcnt)++; \ - lerrcnt++; \ - } \ - } \ - } \ - ERROR_CHECK_AND_FREE(lerrcnt, mpi_type, mpi_op); \ - } - -#define STRUCT_ALLREDUCE_AND_FREE(mpi_type, mpi_op, in, out, sol) \ - { \ - int i, rc, lerrcnt = 0; \ - rc = MPI_Allreduce(in, out, SMPI_VARGET_GLOBAL(count), mpi_type, mpi_op, MPI_COMM_WORLD); \ - if (rc) { lerrcnt++; SMPI_VARGET_GLOBAL(cerrcnt)++; MTestPrintError(rc); } \ - else { \ - for (i = 0; i < SMPI_VARGET_GLOBAL(count); i++) { \ - if ((out[i].a != sol[i].a) || (out[i].b != sol[i].b)) { \ - SMPI_VARGET_GLOBAL(cerrcnt)++; \ - lerrcnt++; \ - } \ - } \ - } \ - ERROR_CHECK_AND_FREE(lerrcnt, mpi_type, mpi_op); \ - } - -#define SET_INDEX_STRUCT_CONST(arr, val, el) \ - { \ - int i; \ - for (i = 0; i < SMPI_VARGET_GLOBAL(count); i++) \ - arr[i].el = val; \ - } - -#define SET_INDEX_STRUCT_SUM(arr, val, el) \ - { \ - int i; \ - for (i = 0; i < SMPI_VARGET_GLOBAL(count); i++) \ - arr[i].el = i + (val); \ - } - -#define sum_test1(type, mpi_type) \ - { \ - DECL_MALLOC_IN_OUT_SOL(type); \ - SET_INDEX_SUM(in, 0); \ - SET_INDEX_FACTOR(sol, SMPI_VARGET_GLOBAL(size)); \ - SET_INDEX_CONST(out, 0); \ - ALLREDUCE_AND_FREE(mpi_type, MPI_SUM, in, out, sol); \ - } - -#define prod_test1(type, mpi_type) \ - { \ - DECL_MALLOC_IN_OUT_SOL(type); \ - SET_INDEX_SUM(in, 0); \ - SET_INDEX_POWER(sol, SMPI_VARGET_GLOBAL(size)); \ - SET_INDEX_CONST(out, 0); \ - ALLREDUCE_AND_FREE(mpi_type, MPI_PROD, in, out, sol); \ - } - -#define max_test1(type, mpi_type) \ - { \ - DECL_MALLOC_IN_OUT_SOL(type); \ - SET_INDEX_SUM(in, SMPI_VARGET_GLOBAL(rank)); \ - SET_INDEX_SUM(sol, SMPI_VARGET_GLOBAL(size) - 1); \ - SET_INDEX_CONST(out, 0); \ - ALLREDUCE_AND_FREE(mpi_type, MPI_MAX, in, out, sol); \ - } - -#define min_test1(type, mpi_type) \ - { \ - DECL_MALLOC_IN_OUT_SOL(type); \ - SET_INDEX_SUM(in, SMPI_VARGET_GLOBAL(rank)); \ - SET_INDEX_SUM(sol, 0); \ - SET_INDEX_CONST(out, 0); \ - ALLREDUCE_AND_FREE(mpi_type, MPI_MIN, in, out, sol); \ - } - -#define const_test(type, mpi_type, mpi_op, val1, val2, val3) \ - { \ - DECL_MALLOC_IN_OUT_SOL(type); \ - SET_INDEX_CONST(in, (val1)); \ - SET_INDEX_CONST(sol, (val2)); \ - SET_INDEX_CONST(out, (val3)); \ - ALLREDUCE_AND_FREE(mpi_type, mpi_op, in, out, sol); \ - } - -#define lor_test1(type, mpi_type) \ - const_test(type, mpi_type, MPI_LOR, (SMPI_VARGET_GLOBAL(rank) & 0x1), (SMPI_VARGET_GLOBAL(size) > 1), 0) -#define lor_test2(type, mpi_type) \ - const_test(type, mpi_type, MPI_LOR, 0, 0, 0) -#define lxor_test1(type, mpi_type) \ - const_test(type, mpi_type, MPI_LXOR, (SMPI_VARGET_GLOBAL(rank) == 1), (SMPI_VARGET_GLOBAL(size) > 1), 0) -#define lxor_test2(type, mpi_type) \ - const_test(type, mpi_type, MPI_LXOR, 0, 0, 0) -#define lxor_test3(type, mpi_type) \ - const_test(type, mpi_type, MPI_LXOR, 1, (SMPI_VARGET_GLOBAL(size) & 0x1), 0) -#define land_test1(type, mpi_type) \ - const_test(type, mpi_type, MPI_LAND, (SMPI_VARGET_GLOBAL(rank) & 0x1), 0, 0) -#define land_test2(type, mpi_type) \ - const_test(type, mpi_type, MPI_LAND, 1, 1, 0) -#define bor_test1(type, mpi_type) \ - const_test(type, mpi_type, MPI_BOR, (SMPI_VARGET_GLOBAL(rank) & 0x3), ((SMPI_VARGET_GLOBAL(size) < 3) ? SMPI_VARGET_GLOBAL(size) - 1 : 0x3), 0) -#define bxor_test1(type, mpi_type) \ - const_test(type, mpi_type, MPI_BXOR, (SMPI_VARGET_GLOBAL(rank) == 1) * 0xf0, (SMPI_VARGET_GLOBAL(size) > 1) * 0xf0, 0) -#define bxor_test2(type, mpi_type) \ - const_test(type, mpi_type, MPI_BXOR, 0, 0, 0) -#define bxor_test3(type, mpi_type) \ - const_test(type, mpi_type, MPI_BXOR, ~0, (SMPI_VARGET_GLOBAL(size) &0x1) ? ~0 : 0, 0) - -#define band_test1(type, mpi_type) \ - { \ - DECL_MALLOC_IN_OUT_SOL(type); \ - if (SMPI_VARGET_GLOBAL(rank) == SMPI_VARGET_GLOBAL(size)-1) { \ - SET_INDEX_SUM(in, 0); \ - } \ - else { \ - SET_INDEX_CONST(in, ~0); \ - } \ - SET_INDEX_SUM(sol, 0); \ - SET_INDEX_CONST(out, 0); \ - ALLREDUCE_AND_FREE(mpi_type, MPI_BAND, in, out, sol); \ - } - -#define band_test2(type, mpi_type) \ - { \ - DECL_MALLOC_IN_OUT_SOL(type); \ - if (SMPI_VARGET_GLOBAL(rank) == SMPI_VARGET_GLOBAL(size)-1) { \ - SET_INDEX_SUM(in, 0); \ - } \ - else { \ - SET_INDEX_CONST(in, 0); \ - } \ - SET_INDEX_CONST(sol, 0); \ - SET_INDEX_CONST(out, 0); \ - ALLREDUCE_AND_FREE(mpi_type, MPI_BAND, in, out, sol); \ - } - -#define maxloc_test(type, mpi_type) \ - { \ - DECL_MALLOC_IN_OUT_SOL(type); \ - SET_INDEX_STRUCT_SUM(in, SMPI_VARGET_GLOBAL(rank), a); \ - SET_INDEX_STRUCT_CONST(in, SMPI_VARGET_GLOBAL(rank), b); \ - SET_INDEX_STRUCT_SUM(sol, SMPI_VARGET_GLOBAL(size) - 1, a); \ - SET_INDEX_STRUCT_CONST(sol, SMPI_VARGET_GLOBAL(size) - 1, b); \ - SET_INDEX_STRUCT_CONST(out, 0, a); \ - SET_INDEX_STRUCT_CONST(out, -1, b); \ - STRUCT_ALLREDUCE_AND_FREE(mpi_type, MPI_MAXLOC, in, out, sol); \ - } - -#define minloc_test(type, mpi_type) \ - { \ - DECL_MALLOC_IN_OUT_SOL(type); \ - SET_INDEX_STRUCT_SUM(in, SMPI_VARGET_GLOBAL(rank), a); \ - SET_INDEX_STRUCT_CONST(in, SMPI_VARGET_GLOBAL(rank), b); \ - SET_INDEX_STRUCT_SUM(sol, 0, a); \ - SET_INDEX_STRUCT_CONST(sol, 0, b); \ - SET_INDEX_STRUCT_CONST(out, 0, a); \ - SET_INDEX_STRUCT_CONST(out, -1, b); \ - STRUCT_ALLREDUCE_AND_FREE(mpi_type, MPI_MINLOC, in, out, sol); \ - } - -#if MTEST_HAVE_MIN_MPI_VERSION(2,2) -#define test_types_set_mpi_2_2_integer(op,post) do { \ - op##_test##post(int8_t, MPI_INT8_T); \ - op##_test##post(int16_t, MPI_INT16_T); \ - op##_test##post(int32_t, MPI_INT32_T); \ - op##_test##post(int64_t, MPI_INT64_T); \ - op##_test##post(uint8_t, MPI_UINT8_T); \ - op##_test##post(uint16_t, MPI_UINT16_T); \ - op##_test##post(uint32_t, MPI_UINT32_T); \ - op##_test##post(uint64_t, MPI_UINT64_T); \ - op##_test##post(MPI_Aint, MPI_AINT); \ - op##_test##post(MPI_Offset, MPI_OFFSET); \ - } while (0) -#else -#define test_types_set_mpi_2_2_integer(op,post) do { } while (0) -#endif - -#if MTEST_HAVE_MIN_MPI_VERSION(3,0) -#define test_types_set_mpi_3_0_integer(op,post) do { \ - op##_test##post(MPI_Count, MPI_COUNT); \ - } while (0) -#else -#define test_types_set_mpi_3_0_integer(op,post) do { } while (0) -#endif - -#define test_types_set1(op, post) \ - { \ - op##_test##post(int, MPI_INT); \ - op##_test##post(long, MPI_LONG); \ - op##_test##post(short, MPI_SHORT); \ - op##_test##post(unsigned short, MPI_UNSIGNED_SHORT); \ - op##_test##post(unsigned, MPI_UNSIGNED); \ - op##_test##post(unsigned long, MPI_UNSIGNED_LONG); \ - op##_test##post(unsigned char, MPI_UNSIGNED_CHAR); \ - test_types_set_mpi_2_2_integer(op,post); \ - test_types_set_mpi_3_0_integer(op,post); \ - } - -#define test_types_set2(op, post) \ - { \ - test_types_set1(op, post); \ - op##_test##post(float, MPI_FLOAT); \ - op##_test##post(double, MPI_DOUBLE); \ - } - -#define test_types_set3(op, post) \ - { \ - op##_test##post(unsigned char, MPI_BYTE); \ - } - -/* Make sure that we test complex and double complex, even if long - double complex is not available */ -#if defined(USE_LONG_DOUBLE_COMPLEX) - -#if MTEST_HAVE_MIN_MPI_VERSION(2,2) && defined(HAVE_FLOAT__COMPLEX) \ - && defined(HAVE_DOUBLE__COMPLEX) \ - && defined(HAVE_LONG_DOUBLE__COMPLEX) -#define test_types_set4(op, post) \ - do { \ - op##_test##post(float _Complex, MPI_C_FLOAT_COMPLEX); \ - op##_test##post(double _Complex, MPI_C_DOUBLE_COMPLEX); \ - if (MPI_C_LONG_DOUBLE_COMPLEX != MPI_DATATYPE_NULL) { \ - op##_test##post(long double _Complex, MPI_C_LONG_DOUBLE_COMPLEX); \ - } \ - } while (0) - -#else -#define test_types_set4(op, post) do { } while (0) -#endif -#else - -#if MTEST_HAVE_MIN_MPI_VERSION(2,2) && defined(HAVE_FLOAT__COMPLEX) \ - && defined(HAVE_DOUBLE__COMPLEX) -#define test_types_set4(op, post) \ - do { \ - op##_test##post(float _Complex, MPI_C_FLOAT_COMPLEX); \ - op##_test##post(double _Complex, MPI_C_DOUBLE_COMPLEX); \ - } while (0) - -#else -#define test_types_set4(op, post) do { } while (0) -#endif - -#endif /* defined(USE_LONG_DOUBLE_COMPLEX) */ - -#if MTEST_HAVE_MIN_MPI_VERSION(2,2) && defined(HAVE__BOOL) -#define test_types_set5(op, post) \ - do { \ - op##_test##post(_Bool, MPI_C_BOOL); \ - } while (0) - -#else -#define test_types_set5(op, post) do { } while (0) -#endif - -int main(int argc, char **argv) -{ - MTest_Init(&argc, &argv); - - MPI_Comm_size(MPI_COMM_WORLD, &SMPI_VARGET_GLOBAL(size)); - MPI_Comm_rank(MPI_COMM_WORLD, &SMPI_VARGET_GLOBAL(rank)); - - if (SMPI_VARGET_GLOBAL(size) < 2) { - fprintf(stderr, "At least 2 processes required\n"); - MPI_Abort(MPI_COMM_WORLD, 1); - } - - /* Set errors return so that we can provide better information - * should a routine reject one of the operand/datatype pairs */ - MPI_Errhandler_set(MPI_COMM_WORLD, MPI_ERRORS_RETURN); - - SMPI_VARGET_GLOBAL(count) = 10; - /* Allow an argument to override the count. - * Note that the product tests may fail if the count is very large. - */ - if (argc >= 2) { - SMPI_VARGET_GLOBAL(count) = atoi(argv[1]); - if (SMPI_VARGET_GLOBAL(count) <= 0) { - fprintf(stderr, "Invalid count argument %s\n", argv[1]); - MPI_Abort(MPI_COMM_WORLD, 1); - } - } - - test_types_set2(sum, 1); - test_types_set2(prod, 1); - test_types_set2(max, 1); - test_types_set2(min, 1); - - test_types_set1(lor, 1); - test_types_set1(lor, 2); - - test_types_set1(lxor, 1); - test_types_set1(lxor, 2); - test_types_set1(lxor, 3); - - test_types_set1(land, 1); - test_types_set1(land, 2); - - test_types_set1(bor, 1); - test_types_set1(band, 1); - test_types_set1(band, 2); - - test_types_set1(bxor, 1); - test_types_set1(bxor, 2); - test_types_set1(bxor, 3); - - test_types_set3(bor, 1); - test_types_set3(band, 1); - test_types_set3(band, 2); - - test_types_set3(bxor, 1); - test_types_set3(bxor, 2); - test_types_set3(bxor, 3); - - test_types_set4(sum, 1); - test_types_set4(prod, 1); - - test_types_set5(lor, 1); - test_types_set5(lor, 2); - test_types_set5(lxor, 1); - test_types_set5(lxor, 2); - test_types_set5(lxor, 3); - test_types_set5(land, 1); - test_types_set5(land, 2); - - maxloc_test(struct int_test, MPI_2INT); - maxloc_test(struct long_test, MPI_LONG_INT); - maxloc_test(struct short_test, MPI_SHORT_INT); - maxloc_test(struct float_test, MPI_FLOAT_INT); - maxloc_test(struct double_test, MPI_DOUBLE_INT); - - minloc_test(struct int_test, MPI_2INT); - minloc_test(struct long_test, MPI_LONG_INT); - minloc_test(struct short_test, MPI_SHORT_INT); - minloc_test(struct float_test, MPI_FLOAT_INT); - minloc_test(struct double_test, MPI_DOUBLE_INT); - - MPI_Errhandler_set(MPI_COMM_WORLD, MPI_ERRORS_ARE_FATAL); - MTest_Finalize(SMPI_VARGET_GLOBAL(cerrcnt)); - MPI_Finalize(); - return 0; -} diff --git a/teshsuite/smpi/mpich3-test/util/dtypes_manual.c b/teshsuite/smpi/mpich3-test/util/dtypes_manual.c deleted file mode 100644 index 48bc3091c7..0000000000 --- a/teshsuite/smpi/mpich3-test/util/dtypes_manual.c +++ /dev/null @@ -1,387 +0,0 @@ -/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ -/* - * - * (C) 2014 by Argonne National Laboratory. - * See COPYRIGHT in top-level directory. - */ -#include "mpi.h" -#include "mpitestconf.h" -#include "mpitest.h" -#include "dtypes.h" -#if defined(HAVE_STDIO_H) || defined(STDC_HEADERS) -#include -#endif -#if defined(HAVE_STDLIB_H) || defined(STDC_HEADERS) -#include -#endif -#if defined(HAVE_STRING_H) || defined(STDC_HEADERS) -#include -#endif -#ifdef HAVE_STDARG_H -#include -#endif - -/* This file contains code to generate a variety of MPI datatypes for testing - the various MPI routines. - - To simplify the test code, this generates an array of datatypes, buffers with - data and buffers with no data (0 bits) for use in send and receive - routines of various types. - - In addition, this doesn't even test all of the possibilities. For example, - there is currently no test of sending more than one item defined with - MPI_Type_contiguous . - - Note also that this test assumes that the sending and receive types are - the same. MPI requires only that the type signatures match, which is - a weaker requirement. - - This code was drawn from the MPICH-1 test suite and modified to fit the - new MPICH test suite. It provides an alternative set of datatype tests - to the ones in mtest.c. - - */ - -/* Change this to test only the basic, predefined types */ -SMPI_VARINIT_GLOBAL_AND_SET(basic_only, int, 0); - -/* - Arrays types, inbufs, outbufs, and counts are allocated by the - CALLER. n on input is the maximum number; on output, it is the - number defined. - - See MTestDatatype2Allocate below for a routine to allocate these arrays. - - We may want to add a routine to call to check that the proper data - has been received. - */ - -/* - Add a predefined MPI type to the tests. _count instances of the - type will be sent. -*/ -#define SETUPBASICTYPE(_mpitype,_ctype,_count) { \ - int i; _ctype *a; \ - if (cnt > *n) {*n = cnt; return; } \ - types[cnt] = _mpitype; \ - inbufs[cnt] = (void *)calloc(_count,sizeof(_ctype)); \ - outbufs[cnt] = (void *)malloc(sizeof(_ctype) * (_count)); \ - a = (_ctype *)inbufs[cnt]; for (i=0; i<(_count); i++) a[i] = i; \ - a = (_ctype *)outbufs[cnt]; for (i=0; i<(_count); i++) a[i] = 0; \ - counts[cnt] = _count; bytesize[cnt] = sizeof(_ctype) * (_count); cnt++; } - -/* - Add a contiguous version of a predefined type. Send one instance of - the type which contains _count copies of the predefined type. - */ -#define SETUPCONTIGTYPE(_mpitype,_ctype,_count) { \ - int i; _ctype *a; char*myname; \ - char _basename[MPI_MAX_OBJECT_NAME]; int _basenamelen;\ - if (cnt > *n) {*n = cnt; return; }\ - MPI_Type_contiguous(_count, _mpitype, types + cnt);\ - MPI_Type_commit(types + cnt);\ - inbufs[cnt] = (void *)calloc(_count, sizeof(_ctype)); \ - outbufs[cnt] = (void *)malloc(sizeof(_ctype) * (_count)); \ - a = (_ctype *)inbufs[cnt]; for (i=0; i<(_count); i++) a[i] = i; \ - a = (_ctype *)outbufs[cnt]; for (i=0; i<(_count); i++) a[i] = 0; \ - myname = (char *)malloc(100);\ - MPI_Type_get_name(_mpitype, _basename, &_basenamelen); \ - snprintf(myname, 100, "Contig type %s", _basename); \ - MPI_Type_set_name(types[cnt], myname); \ - free(myname); \ - counts[cnt] = 1; bytesize[cnt] = sizeof(_ctype) * (_count); cnt++; } - -/* - Create a vector with _count elements, separated by stride _stride, - of _mpitype. Each block has a single element. - */ -#define SETUPVECTORTYPE(_mpitype,_ctype,_count,_stride,_name) { \ - int i; _ctype *a; char *myname; \ - char _basename[MPI_MAX_OBJECT_NAME]; int _basenamelen;\ - if (cnt > *n) {*n = cnt; return; }\ - MPI_Type_vector(_count, 1, _stride, _mpitype, types + cnt); \ - MPI_Type_commit(types + cnt);\ - inbufs[cnt] = (void *)calloc(sizeof(_ctype) * (_count) * (_stride),1); \ - outbufs[cnt] = (void *)calloc(sizeof(_ctype) * (_count) * (_stride),1); \ - a = (_ctype *)inbufs[cnt]; for (i=0; i<(_count); i++) a[i*(_stride)] = i; \ - a = (_ctype *)outbufs[cnt]; for (i=0; i<(_count); i++) a[i*(_stride)] = 0; \ - myname = (char *)malloc(100);\ - MPI_Type_get_name(_mpitype, _basename, &_basenamelen); \ - snprintf(myname, 100, "Vector type %s", _basename); \ - MPI_Type_set_name(types[cnt], myname); \ - free(myname); \ - counts[cnt] = 1; bytesize[cnt] = sizeof(_ctype) * (_count) * (_stride) ;\ - cnt++; } - -/* This indexed type is setup like a contiguous type . - Note that systems may try to convert this to contiguous, so we'll - eventually need a test that has holes in it */ -#define SETUPINDEXTYPE(_mpitype,_ctype,_count,_name) { \ - int i; int *lens, *disp; _ctype *a; char *myname; \ - char _basename[MPI_MAX_OBJECT_NAME]; int _basenamelen;\ - if (cnt > *n) {*n = cnt; return; }\ - lens = (int *)malloc((_count) * sizeof(int)); \ - disp = (int *)malloc((_count) * sizeof(int)); \ - for (i=0; i<(_count); i++) { lens[i] = 1; disp[i] = i; } \ - MPI_Type_indexed((_count), lens, disp, _mpitype, types + cnt);\ - free(lens); free(disp); \ - MPI_Type_commit(types + cnt);\ - inbufs[cnt] = (void *)calloc((_count), sizeof(_ctype)); \ - outbufs[cnt] = (void *)malloc(sizeof(_ctype) * (_count)); \ - a = (_ctype *)inbufs[cnt]; for (i=0; i<(_count); i++) a[i] = i; \ - a = (_ctype *)outbufs[cnt]; for (i=0; i<(_count); i++) a[i] = 0; \ - myname = (char *)malloc(100);\ - MPI_Type_get_name(_mpitype, _basename, &_basenamelen); \ - snprintf(myname, 100, "Index type %s", _basename); \ - MPI_Type_set_name(types[cnt], myname); \ - free(myname); \ - counts[cnt] = 1; bytesize[cnt] = sizeof(_ctype) * (_count); cnt++; } - -/* This defines a structure of two basic members; by chosing things like - (char, double), various packing and alignment tests can be made */ -#define SETUPSTRUCT2TYPE(_mpitype1,_ctype1,_mpitype2,_ctype2,_count,_tname) { \ - int i; char *myname; \ - MPI_Datatype b[3]; int cnts[3]; \ - struct name { _ctype1 a1; _ctype2 a2; } *a, samp; \ - MPI_Aint disp[3]; \ - if (cnt > *n) {*n = cnt; return; } \ - b[0] = _mpitype1; b[1] = _mpitype2; b[2] = MPI_UB; \ - cnts[0] = 1; cnts[1] = 1; cnts[2] = 1; \ - MPI_Get_address(&(samp.a2), &disp[1]); \ - MPI_Get_address(&(samp.a1), &disp[0]); \ - MPI_Get_address(&(samp) + 1, &disp[2]); \ - disp[1] = disp[1] - disp[0]; disp[2] = disp[2] - disp[0]; disp[0] = 0; \ - MPI_Type_create_struct(3, cnts, disp, b, types + cnt); \ - MPI_Type_commit(types + cnt); \ - inbufs[cnt] = (void *)calloc(sizeof(struct name) * (_count),1); \ - outbufs[cnt] = (void *)calloc(sizeof(struct name) * (_count),1); \ - a = (struct name *)inbufs[cnt]; for (i=0; i<(_count); i++) { a[i].a1 = i; \ - a[i].a2 = i; } \ - a = (struct name *)outbufs[cnt]; for (i=0; i<(_count); i++) { a[i].a1 = 0; \ - a[i].a2 = 0; } \ - myname = (char *)malloc(100); \ - snprintf(myname, 100, "Struct type %s", _tname); \ - MPI_Type_set_name(types[cnt], myname); \ - free(myname); \ - counts[cnt] = (_count); bytesize[cnt] = sizeof(struct name) * (_count);cnt++; } - -/* This accomplished the same effect as VECTOR, but allow a count of > 1 */ -#define SETUPSTRUCTTYPEUB(_mpitype,_ctype,_count,_stride) { \ - int i; _ctype *a; char *myname; \ - int blens[2]; MPI_Aint disps[2]; MPI_Datatype mtypes[2]; \ - char _basename[MPI_MAX_OBJECT_NAME]; int _basenamelen;\ - if (cnt > *n) {*n = cnt; return; } \ - blens[0] = 1; blens[1] = 1; disps[0] = 0; \ - disps[1] = (_stride) * sizeof(_ctype); \ - mtypes[0] = _mpitype; mtypes[1] = MPI_UB; \ - MPI_Type_create_struct(2, blens, disps, mtypes, types + cnt); \ - MPI_Type_commit(types + cnt); \ - inbufs[cnt] = (void *)calloc(sizeof(_ctype) * (_count) * (_stride),1);\ - outbufs[cnt] = (void *)calloc(sizeof(_ctype) * (_count) * (_stride),1);\ - a = (_ctype *)inbufs[cnt]; for (i=0; i<(_count); i++) a[i*(_stride)] = i; \ - a = (_ctype *)outbufs[cnt]; for (i=0; i<(_count); i++) a[i*(_stride)] = 0; \ - myname = (char *)malloc(100); \ - MPI_Type_get_name(_mpitype, _basename, &_basenamelen); \ - snprintf(myname, 100, "Struct (MPI_UB) type %s", _basename); \ - MPI_Type_set_name(types[cnt], myname); \ - free(myname); \ - counts[cnt] = (_count); \ - bytesize[cnt] = sizeof(_ctype) * (_count) * (_stride);\ - cnt++; } - -/* - * Set whether only the basic types should be generated - */ -void MTestDatatype2BasicOnly(void) -{ - SMPI_VARGET_GLOBAL(basic_only) = 1; -} - -SMPI_VARINIT_GLOBAL_AND_SET(nbasic_types, int, 0); /* World rank */ -/* On input, n is the size of the various buffers. On output, - it is the number available types - */ -void MTestDatatype2Generate(MPI_Datatype * types, void **inbufs, void **outbufs, - int *counts, int *bytesize, int *n) -{ - int cnt = 0; /* Number of defined types */ - int typecnt = 10; /* Number of instances to send in most cases */ - int stride = 9; /* Number of elements in vector to stride */ - - /* First, generate an element of each basic type */ - SETUPBASICTYPE(MPI_CHAR, char, typecnt); - SETUPBASICTYPE(MPI_SHORT, short, typecnt); - SETUPBASICTYPE(MPI_INT, int, typecnt); - SETUPBASICTYPE(MPI_LONG, long, typecnt); - SETUPBASICTYPE(MPI_UNSIGNED_CHAR, unsigned char, typecnt); - SETUPBASICTYPE(MPI_UNSIGNED_SHORT, unsigned short, typecnt); - SETUPBASICTYPE(MPI_UNSIGNED, unsigned, typecnt); - SETUPBASICTYPE(MPI_UNSIGNED_LONG, unsigned long, typecnt); - SETUPBASICTYPE(MPI_FLOAT, float, typecnt); - SETUPBASICTYPE(MPI_DOUBLE, double, typecnt); - SETUPBASICTYPE(MPI_BYTE, char, typecnt); -#ifdef HAVE_LONG_LONG_INT - SETUPBASICTYPE(MPI_LONG_LONG_INT, long long, typecnt); -#endif -#ifdef HAVE_LONG_DOUBLE - SETUPBASICTYPE(MPI_LONG_DOUBLE, long double, typecnt); -#endif - SMPI_VARGET_GLOBAL(nbasic_types) = cnt; - - if (SMPI_VARGET_GLOBAL(basic_only)) { - *n = cnt; - return; - } - /* Generate contiguous data items */ - SETUPCONTIGTYPE(MPI_CHAR, char, typecnt); - SETUPCONTIGTYPE(MPI_SHORT, short, typecnt); - SETUPCONTIGTYPE(MPI_INT, int, typecnt); - SETUPCONTIGTYPE(MPI_LONG, long, typecnt); - SETUPCONTIGTYPE(MPI_UNSIGNED_CHAR, unsigned char, typecnt); - SETUPCONTIGTYPE(MPI_UNSIGNED_SHORT, unsigned short, typecnt); - SETUPCONTIGTYPE(MPI_UNSIGNED, unsigned, typecnt); - SETUPCONTIGTYPE(MPI_UNSIGNED_LONG, unsigned long, typecnt); - SETUPCONTIGTYPE(MPI_FLOAT, float, typecnt); - SETUPCONTIGTYPE(MPI_DOUBLE, double, typecnt); - SETUPCONTIGTYPE(MPI_BYTE, char, typecnt); -#ifdef HAVE_LONG_LONG_INT - SETUPCONTIGTYPE(MPI_LONG_LONG_INT, long long, typecnt); -#endif -#ifdef HAVE_LONG_DOUBLE - SETUPCONTIGTYPE(MPI_LONG_DOUBLE, long double, typecnt); -#endif - - /* Generate vector items */ - SETUPVECTORTYPE(MPI_CHAR, char, typecnt, stride, "MPI_CHAR"); - SETUPVECTORTYPE(MPI_SHORT, short, typecnt, stride, "MPI_SHORT"); - SETUPVECTORTYPE(MPI_INT, int, typecnt, stride, "MPI_INT"); - SETUPVECTORTYPE(MPI_LONG, long, typecnt, stride, "MPI_LONG"); - SETUPVECTORTYPE(MPI_UNSIGNED_CHAR, unsigned char, typecnt, stride, "MPI_UNSIGNED_CHAR"); - SETUPVECTORTYPE(MPI_UNSIGNED_SHORT, unsigned short, typecnt, stride, "MPI_UNSIGNED_SHORT"); - SETUPVECTORTYPE(MPI_UNSIGNED, unsigned, typecnt, stride, "MPI_UNSIGNED"); - SETUPVECTORTYPE(MPI_UNSIGNED_LONG, unsigned long, typecnt, stride, "MPI_UNSIGNED_LONG"); - SETUPVECTORTYPE(MPI_FLOAT, float, typecnt, stride, "MPI_FLOAT"); - SETUPVECTORTYPE(MPI_DOUBLE, double, typecnt, stride, "MPI_DOUBLE"); - SETUPVECTORTYPE(MPI_BYTE, char, typecnt, stride, "MPI_BYTE"); -#ifdef HAVE_LONG_LONG_INT - SETUPVECTORTYPE(MPI_LONG_LONG_INT, long long, typecnt, stride, "MPI_LONG_LONG_INT"); -#endif -#ifdef HAVE_LONG_DOUBLE - SETUPVECTORTYPE(MPI_LONG_DOUBLE, long double, typecnt, stride, "MPI_LONG_DOUBLE"); -#endif - - /* Generate indexed items */ - SETUPINDEXTYPE(MPI_CHAR, char, typecnt, "MPI_CHAR"); - SETUPINDEXTYPE(MPI_SHORT, short, typecnt, "MPI_SHORT"); - SETUPINDEXTYPE(MPI_INT, int, typecnt, "MPI_INT"); - SETUPINDEXTYPE(MPI_LONG, long, typecnt, "MPI_LONG"); - SETUPINDEXTYPE(MPI_UNSIGNED_CHAR, unsigned char, typecnt, "MPI_UNSIGNED_CHAR"); - SETUPINDEXTYPE(MPI_UNSIGNED_SHORT, unsigned short, typecnt, "MPI_UNSIGNED_SHORT"); - SETUPINDEXTYPE(MPI_UNSIGNED, unsigned, typecnt, "MPI_UNSIGNED"); - SETUPINDEXTYPE(MPI_UNSIGNED_LONG, unsigned long, typecnt, "MPI_UNSIGNED_LONG"); - SETUPINDEXTYPE(MPI_FLOAT, float, typecnt, "MPI_FLOAT"); - SETUPINDEXTYPE(MPI_DOUBLE, double, typecnt, "MPI_DOUBLE"); - SETUPINDEXTYPE(MPI_BYTE, char, typecnt, "MPI_BYTE"); -#ifdef HAVE_LONG_LONG_INT - SETUPINDEXTYPE(MPI_LONG_LONG_INT, long long, typecnt, "MPI_LONG_LONG_INT"); -#endif -#ifdef HAVE_LONG_DOUBLE - SETUPINDEXTYPE(MPI_LONG_DOUBLE, long double, typecnt, "MPI_LONG_DOUBLE"); -#endif - - /* Generate struct items */ - SETUPSTRUCT2TYPE(MPI_CHAR, char, MPI_DOUBLE, double, typecnt, "char-double"); - SETUPSTRUCT2TYPE(MPI_DOUBLE, double, MPI_CHAR, char, typecnt, "double-char"); - SETUPSTRUCT2TYPE(MPI_UNSIGNED, unsigned, MPI_DOUBLE, double, typecnt, "unsigned-double"); - SETUPSTRUCT2TYPE(MPI_FLOAT, float, MPI_LONG, long, typecnt, "float-long"); - SETUPSTRUCT2TYPE(MPI_UNSIGNED_CHAR, unsigned char, MPI_CHAR, char, typecnt, - "unsigned char-char"); - SETUPSTRUCT2TYPE(MPI_UNSIGNED_SHORT, unsigned short, MPI_DOUBLE, double, - typecnt, "unsigned short-double"); - - /* Generate struct using MPI_UB */ - SETUPSTRUCTTYPEUB(MPI_CHAR, char, typecnt, stride); - SETUPSTRUCTTYPEUB(MPI_SHORT, short, typecnt, stride); - SETUPSTRUCTTYPEUB(MPI_INT, int, typecnt, stride); - SETUPSTRUCTTYPEUB(MPI_LONG, long, typecnt, stride); - SETUPSTRUCTTYPEUB(MPI_UNSIGNED_CHAR, unsigned char, typecnt, stride); - SETUPSTRUCTTYPEUB(MPI_UNSIGNED_SHORT, unsigned short, typecnt, stride); - SETUPSTRUCTTYPEUB(MPI_UNSIGNED, unsigned, typecnt, stride); - SETUPSTRUCTTYPEUB(MPI_UNSIGNED_LONG, unsigned long, typecnt, stride); - SETUPSTRUCTTYPEUB(MPI_FLOAT, float, typecnt, stride); - SETUPSTRUCTTYPEUB(MPI_DOUBLE, double, typecnt, stride); - SETUPSTRUCTTYPEUB(MPI_BYTE, char, typecnt, stride); - - /* 60 different entries to this point + 4 for long long and - * 4 for long double */ - *n = cnt; -} - -/* - MAX_TEST should be 1 + actual max (allows us to check that it was, - indeed, large enough) - */ -#define MAX_TEST 70 -void MTestDatatype2Allocate(MPI_Datatype ** types, void ***inbufs, - void ***outbufs, int **counts, int **bytesize, int *n) -{ - *types = (MPI_Datatype *) malloc(MAX_TEST * sizeof(MPI_Datatype)); - *inbufs = (void **) malloc(MAX_TEST * sizeof(void *)); - *outbufs = (void **) malloc(MAX_TEST * sizeof(void *)); - *counts = (int *) malloc(MAX_TEST * sizeof(int)); - *bytesize = (int *) malloc(MAX_TEST * sizeof(int)); - *n = MAX_TEST; -} - -int MTestDatatype2Check(void *inbuf, void *outbuf, int size_bytes) -{ - char *in = (char *) inbuf, *out = (char *) outbuf; - int i; - for (i = 0; i < size_bytes; i++) { - if (in[i] != out[i]) { - return i + 1; - } - } - return 0; -} - -/* - * This is a version of CheckData that prints error messages - */ -static int MtestDatatype2CheckAndPrint(void *inbuf, void *outbuf, int size_bytes, - char *typename, int typenum) -{ - int errloc, world_rank; - - if ((errloc = MTestDatatype2Check(inbuf, outbuf, size_bytes))) { - char *p1, *p2; - MPI_Comm_rank(MPI_COMM_WORLD, &world_rank); - fprintf(stderr, - "Error in data with type %s (type %d on %d) at byte %d of %d\n", - typename, typenum, world_rank, errloc - 1, size_bytes); - p1 = (char *) inbuf; - p2 = (char *) outbuf; - fprintf(stderr, "Got %hhx expected %hhx\n", p2[errloc - 1], p1[errloc - 1]); - } - return errloc; -} - -void MTestDatatype2Free(MPI_Datatype * types, void **inbufs, void **outbufs, - int *counts, int *bytesize, int n) -{ - int i; - for (i = 0; i < n; i++) { - if (inbufs[i]) - free(inbufs[i]); - if (outbufs[i]) - free(outbufs[i]); - /* Only if not basic ... */ - if (i >= SMPI_VARGET_GLOBAL(nbasic_types)) - MPI_Type_free(types + i); - } - free(types); - free(inbufs); - free(outbufs); - free(counts); - free(bytesize); -} diff --git a/teshsuite/smpi/mpich3-test/util/mtest_datatype_gen_manual.c b/teshsuite/smpi/mpich3-test/util/mtest_datatype_gen_manual.c deleted file mode 100644 index 7e271d126b..0000000000 --- a/teshsuite/smpi/mpich3-test/util/mtest_datatype_gen_manual.c +++ /dev/null @@ -1,634 +0,0 @@ -/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ -/* - * - * (C) 2014 by Argonne National Laboratory. - * See COPYRIGHT in top-level directory. - */ -#include "mtest_datatype.h" -#if defined(HAVE_STDIO_H) || defined(STDC_HEADERS) -#include -#endif -#if defined(HAVE_STDLIB_H) || defined(STDC_HEADERS) -#include -#endif -#if defined(HAVE_STRING_H) || defined(STDC_HEADERS) -#include -#endif -#ifdef HAVE_STDARG_H -#include -#endif -/* The following two includes permit the collection of resource usage - data in the tests - */ -#ifdef HAVE_SYS_TIME_H -#include -#endif -#ifdef HAVE_SYS_RESOURCE_H -#include -#endif -#include - -SMPI_VARINIT_GLOBAL_AND_SET(dbgflag2, int, 0); /* Flag used for debugging */ -SMPI_VARINIT_GLOBAL_AND_SET(wrank2, int, -1); /* World rank */ -SMPI_VARINIT_GLOBAL_AND_SET(verbose2,int, 0); /* Message level (0 is none) */ - -/* - * Utility routines for writing MPI datatype communication tests. - * - * Both basic and derived datatype are included. - * For basic datatypes, every type has a test case that both the send and - * receive buffer use the same datatype and count. - * - * For derived datatypes: - * All the test cases are defined in this file, and the datatype definitions - * are in file mtest_datatype.c. Each test case will be automatically called - * by every datatype. - * - * Test case generation: - * Every datatype tests derived datatype send buffer and - * derived datatype receive buffer separately. Each test contains various sub - * tests for different structures (i.e., different value of count or block - * length). The following four structures are defined: - * L count & S block length & S stride - * S count & L block length & S stride - * L count & S block length & L stride - * S count & L block length & L stride - * S count & L block length & S stride & S lower-bound - * contiguous (stride = block length) - * contiguous (stride = block length) & S lower-bound - * - * How to add a new structure for each datatype: - * 1. Add structure definition in function MTestDdtStructDefine. - * 2. Increase MTEST_DDT_NUM_SUBTESTS - * - * Datatype definition: - * Every type is initialized by the creation function stored in - * mtestDdtCreators variable, all of their create/init/check functions are - * defined in file mtest_datatype.c. - * - * How to add a new derived datatype: - * 1. Add the new datatype in enum MTEST_DERIVED_DT. - * 2. Add its create/init/check functions in file mtest_datatype.c - * 3. Add its creator function to mtestDdtCreators variable - * - * Following three test levels of datatype are defined. - * 1. Basic - * All basic datatypes - * 2. Minimum - * All basic datatypes | Vector | Indexed - * 3. Full - * All basic datatypes | Vector | Hvector | Indexed | Hindexed | - * Indexed-block | Hindexed-block | Subarray with order-C | Subarray with order-Fortran - * - * There are two ways to specify the test level of datatype. The second way has - * higher priority (means the value specified by the first way will be overwritten - * by that in the second way). - * 1. Specify global test level by setting the MPITEST_DATATYPE_TEST_LEVEL - * environment variable before execution (basic,min,full|full by default). - * 2. Initialize a special level for a datatype loop by calling the corresponding - * initialization function before that loop, otherwise the default value specified - * in the first way is used. - * Basic : MTestInitBasicDatatypes - * Minimum : MTestInitMinDatatypes - * Full : MTestInitFullDatatypes - */ - -SMPI_VARINIT_GLOBAL_AND_SET(datatype_index,int,0); - -/* ------------------------------------------------------------------------ */ -/* Routine and internal parameters to define the range of datatype tests */ -/* ------------------------------------------------------------------------ */ - -#define MTEST_DDT_NUM_SUBTESTS 7 /* 7 kinds of derived datatype structure */ -SMPI_VARINIT_GLOBAL_AND_SET( mtestDdtCreators, MTestDdtCreator*,NULL); - -SMPI_VARINIT_GLOBAL_AND_SET(MTEST_BDT_START_IDX, int, -1); -SMPI_VARINIT_GLOBAL_AND_SET(MTEST_BDT_NUM_TESTS, int, 0); -SMPI_VARINIT_GLOBAL_AND_SET(MTEST_BDT_RANGE, int, 0); - -SMPI_VARINIT_GLOBAL_AND_SET(MTEST_DDT_NUM_TYPES, int, 0); -SMPI_VARINIT_GLOBAL_AND_SET(MTEST_SEND_DDT_START_IDX, int, 0); -SMPI_VARINIT_GLOBAL_AND_SET(MTEST_SEND_DDT_NUM_TESTS, int, 0); -SMPI_VARINIT_GLOBAL_AND_SET(MTEST_SEND_DDT_RANGE, int, 0); - -SMPI_VARINIT_GLOBAL_AND_SET(MTEST_RECV_DDT_START_IDX, int, 0); -SMPI_VARINIT_GLOBAL_AND_SET(MTEST_RECV_DDT_NUM_TESTS, int, 0); -SMPI_VARINIT_GLOBAL_AND_SET(MTEST_RECV_DDT_RANGE, int, 0); - -enum { - MTEST_DATATYPE_TEST_LEVEL_FULL, - MTEST_DATATYPE_TEST_LEVEL_MIN, - MTEST_DATATYPE_TEST_LEVEL_BASIC -}; - -/* current datatype test level */ -SMPI_VARINIT_GLOBAL_AND_SET(MTEST_DATATYPE_TEST_LEVEL,int, MTEST_DATATYPE_TEST_LEVEL_FULL); -/* default datatype test level specified by environment variable */ -SMPI_VARINIT_GLOBAL_AND_SET(MTEST_DATATYPE_TEST_LEVEL_ENV, int, -1); -/* default datatype initialization function */ -static void (*MTestInitDefaultTestFunc) (void) = NULL; - -static void MTestInitDatatypeGen(int basic_dt_num, int derived_dt_num) -{ - SMPI_VARGET_GLOBAL(MTEST_BDT_START_IDX) = 0; - SMPI_VARGET_GLOBAL(MTEST_BDT_NUM_TESTS) = basic_dt_num; - SMPI_VARGET_GLOBAL(MTEST_BDT_RANGE) = SMPI_VARGET_GLOBAL(MTEST_BDT_START_IDX) + SMPI_VARGET_GLOBAL(MTEST_BDT_NUM_TESTS); - SMPI_VARGET_GLOBAL(MTEST_DDT_NUM_TYPES) = derived_dt_num; - SMPI_VARGET_GLOBAL(MTEST_SEND_DDT_START_IDX) = SMPI_VARGET_GLOBAL(MTEST_BDT_NUM_TESTS); - SMPI_VARGET_GLOBAL(MTEST_SEND_DDT_NUM_TESTS) = SMPI_VARGET_GLOBAL(MTEST_DDT_NUM_TYPES) * MTEST_DDT_NUM_SUBTESTS; - SMPI_VARGET_GLOBAL(MTEST_SEND_DDT_RANGE) = SMPI_VARGET_GLOBAL(MTEST_SEND_DDT_START_IDX) + SMPI_VARGET_GLOBAL(MTEST_SEND_DDT_NUM_TESTS); - SMPI_VARGET_GLOBAL(MTEST_RECV_DDT_START_IDX) = SMPI_VARGET_GLOBAL(MTEST_SEND_DDT_START_IDX) + SMPI_VARGET_GLOBAL(MTEST_SEND_DDT_NUM_TESTS); - SMPI_VARGET_GLOBAL(MTEST_RECV_DDT_NUM_TESTS) = SMPI_VARGET_GLOBAL(MTEST_DDT_NUM_TYPES) * MTEST_DDT_NUM_SUBTESTS; - SMPI_VARGET_GLOBAL(MTEST_RECV_DDT_RANGE) = SMPI_VARGET_GLOBAL(MTEST_RECV_DDT_START_IDX) + SMPI_VARGET_GLOBAL(MTEST_RECV_DDT_NUM_TESTS); -} - -static int MTestIsDatatypeGenInited() -{ - return (SMPI_VARGET_GLOBAL(MTEST_BDT_START_IDX) < 0) ? 0 : 1; -} - -static void MTestPrintDatatypeGen() -{ - MTestPrintfMsg(1, "MTest datatype test level : %s. %d basic datatype tests, " - "%d derived datatype tests will be generated\n", - (SMPI_VARGET_GLOBAL(MTEST_DATATYPE_TEST_LEVEL) == MTEST_DATATYPE_TEST_LEVEL_FULL) ? "FULL" : "MIN", - SMPI_VARGET_GLOBAL(MTEST_BDT_NUM_TESTS), SMPI_VARGET_GLOBAL(MTEST_SEND_DDT_NUM_TESTS) + SMPI_VARGET_GLOBAL(MTEST_RECV_DDT_NUM_TESTS)); -} - -static void MTestResetDatatypeGen() -{ - SMPI_VARGET_GLOBAL(MTEST_BDT_START_IDX) = -1; -} - -void MTestInitFullDatatypes(void) -{ - if(SMPI_VARGET_GLOBAL(mtestDdtCreators)==NULL) - SMPI_VARGET_GLOBAL(mtestDdtCreators)= (MTestDdtCreator*)malloc(sizeof(MTestDdtCreator)*MTEST_DDT_MAX); - /* Do not allow to change datatype test level during loop. - * Otherwise indexes will be wrong. - * Test must explicitly call reset or wait for current datatype loop being - * done before changing to another test level. */ - if (!MTestIsDatatypeGenInited()) { - SMPI_VARGET_GLOBAL(MTEST_DATATYPE_TEST_LEVEL) = MTEST_DATATYPE_TEST_LEVEL_FULL; - MTestTypeCreatorInit((MTestDdtCreator *) SMPI_VARGET_GLOBAL(mtestDdtCreators)); - MTestInitDatatypeGen(MTEST_BDT_MAX, MTEST_DDT_MAX); - } - else { - printf("Warning: trying to reinitialize mtest datatype during " "datatype iteration!"); - } -} - -void MTestInitMinDatatypes(void) -{ - if(SMPI_VARGET_GLOBAL(mtestDdtCreators)==NULL) - SMPI_VARGET_GLOBAL(mtestDdtCreators)= (MTestDdtCreator*)malloc(sizeof(MTestDdtCreator)*MTEST_DDT_MAX); - /* Do not allow to change datatype test level during loop. - * Otherwise indexes will be wrong. - * Test must explicitly call reset or wait for current datatype loop being - * done before changing to another test level. */ - if (!MTestIsDatatypeGenInited()) { - SMPI_VARGET_GLOBAL(MTEST_DATATYPE_TEST_LEVEL) = MTEST_DATATYPE_TEST_LEVEL_MIN; - MTestTypeMinCreatorInit((MTestDdtCreator *) SMPI_VARGET_GLOBAL(mtestDdtCreators)); - MTestInitDatatypeGen(MTEST_BDT_MAX, MTEST_MIN_DDT_MAX); - } - else { - printf("Warning: trying to reinitialize mtest datatype during " "datatype iteration!"); - } -} - -void MTestInitBasicDatatypes(void) -{ - if(SMPI_VARGET_GLOBAL(mtestDdtCreators)==NULL) - SMPI_VARGET_GLOBAL(mtestDdtCreators)= (MTestDdtCreator*)malloc(sizeof(MTestDdtCreator)*MTEST_DDT_MAX); - /* Do not allow to change datatype test level during loop. - * Otherwise indexes will be wrong. - * Test must explicitly call reset or wait for current datatype loop being - * done before changing to another test level. */ - if (!MTestIsDatatypeGenInited()) { - SMPI_VARGET_GLOBAL(MTEST_DATATYPE_TEST_LEVEL) = MTEST_DATATYPE_TEST_LEVEL_BASIC; - MTestInitDatatypeGen(MTEST_BDT_MAX, 0); - } - else { - printf("Warning: trying to reinitialize mtest datatype during " "datatype iteration!"); - } -} - -static inline void MTestInitDatatypeEnv() -{ - char *envval = 0; - - /* Read global test level specified by user environment variable. - * Only initialize once at the first time that test calls datatype routine. */ - if (SMPI_VARGET_GLOBAL(MTEST_DATATYPE_TEST_LEVEL_ENV) > -1) - return; - - /* default full */ - SMPI_VARGET_GLOBAL(MTEST_DATATYPE_TEST_LEVEL_ENV) = MTEST_DATATYPE_TEST_LEVEL_FULL; - MTestInitDefaultTestFunc = MTestInitFullDatatypes; - - envval = getenv("MPITEST_DATATYPE_TEST_LEVEL"); - if (envval && strlen(envval)) { - if (!strncmp(envval, "min", strlen("min"))) { - SMPI_VARGET_GLOBAL(MTEST_DATATYPE_TEST_LEVEL_ENV) = MTEST_DATATYPE_TEST_LEVEL_MIN; - MTestInitDefaultTestFunc = MTestInitMinDatatypes; - } - else if (!strncmp(envval, "basic", strlen("basic"))) { - SMPI_VARGET_GLOBAL(MTEST_DATATYPE_TEST_LEVEL_ENV) = MTEST_DATATYPE_TEST_LEVEL_BASIC; - MTestInitDefaultTestFunc = MTestInitBasicDatatypes; - } - else if (strncmp(envval, "full", strlen("full"))) { - fprintf(stderr, "Unknown MPITEST_DATATYPE_TEST_LEVEL %s\n", envval); - } - } -} - -/* -------------------------------------------------------------------------------*/ -/* Routine to define various sets of blocklen/count/stride for derived datatypes. */ -/* ------------------------------------------------------------------------------ */ - -static inline int MTestDdtStructDefine(int ddt_index, MPI_Aint tot_count, MPI_Aint * count, - MPI_Aint * blen, MPI_Aint * stride, - MPI_Aint * align_tot_count, MPI_Aint * lb) -{ - int merr = 0; - int ddt_c_st; - MPI_Aint _short = 0, _align_tot_count = 0, _count = 0, _blen = 0, _stride = 0; - MPI_Aint _lb = 0; - - ddt_c_st = ddt_index % MTEST_DDT_NUM_SUBTESTS; - - /* Get short value according to user specified tot_count. - * It is used as count for large-block-length structure, or block length - * for large-count structure. */ - if (tot_count < 2) { - _short = 1; - } - else if (tot_count < 64) { - _short = 2; - } - else { - _short = 64; - } - _align_tot_count = (tot_count + _short - 1) & ~(_short - 1); - - switch (ddt_c_st) { - case 0: - /* Large block length. */ - _count = _short; - _blen = _align_tot_count / _short; - _stride = _blen * 2; - break; - case 1: - /* Large count */ - _count = _align_tot_count / _short; - _blen = _short; - _stride = _blen * 2; - break; - case 2: - /* Large block length and large stride */ - _count = _short; - _blen = _align_tot_count / _short; - _stride = _blen * 10; - break; - case 3: - /* Large count and large stride */ - _count = _align_tot_count / _short; - _blen = _short; - _stride = _blen * 10; - break; - case 4: - /* Large block length with lb */ - _count = _short; - _blen = _align_tot_count / _short; - _stride = _blen * 2; - _lb = _short / 2; /* make sure lb < blen */ - break; - case 5: - /* Contig ddt (stride = block length) without lb */ - _count = _align_tot_count / _short; - _blen = _short; - _stride = _blen; - break; - case 6: - /* Contig ddt (stride = block length) with lb */ - _count = _short; - _blen = _align_tot_count / _short; - _stride = _blen; - _lb = _short / 2; /* make sure lb < blen */ - break; - default: - /* Undefined index */ - merr = 1; - break; - } - - *align_tot_count = _align_tot_count; - *count = _count; - *blen = _blen; - *stride = _stride; - *lb = _lb; - - return merr; -} - -/* ------------------------------------------------------------------------ */ -/* Routine to generate basic datatypes */ -/* ------------------------------------------------------------------------ */ - -static inline int MTestGetBasicDatatypes(MTestDatatype * sendtype, - MTestDatatype * recvtype, MPI_Aint tot_count) -{ - int merr = 0; - int bdt_index = SMPI_VARGET_GLOBAL(datatype_index) - SMPI_VARGET_GLOBAL(MTEST_BDT_START_IDX); - if (bdt_index >= MTEST_BDT_MAX) { - printf("Wrong index: global %d, bst %d in %s\n", SMPI_VARGET_GLOBAL(datatype_index), bdt_index, __func__); - merr++; - return merr; - } - - switch (bdt_index) { - case MTEST_BDT_INT: - merr = MTestTypeBasicCreate(MPI_INT, sendtype); - merr = MTestTypeBasicCreate(MPI_INT, recvtype); - break; - case MTEST_BDT_DOUBLE: - merr = MTestTypeBasicCreate(MPI_DOUBLE, sendtype); - merr = MTestTypeBasicCreate(MPI_DOUBLE, recvtype); - break; - case MTEST_BDT_FLOAT_INT: - merr = MTestTypeBasicCreate(MPI_FLOAT_INT, sendtype); - merr = MTestTypeBasicCreate(MPI_FLOAT_INT, recvtype); - break; - case MTEST_BDT_SHORT: - merr = MTestTypeBasicCreate(MPI_SHORT, sendtype); - merr = MTestTypeBasicCreate(MPI_SHORT, recvtype); - break; - case MTEST_BDT_LONG: - merr = MTestTypeBasicCreate(MPI_LONG, sendtype); - merr = MTestTypeBasicCreate(MPI_LONG, recvtype); - break; - case MTEST_BDT_CHAR: - merr = MTestTypeBasicCreate(MPI_CHAR, sendtype); - merr = MTestTypeBasicCreate(MPI_CHAR, recvtype); - break; - case MTEST_BDT_UINT64_T: - merr = MTestTypeBasicCreate(MPI_UINT64_T, sendtype); - merr = MTestTypeBasicCreate(MPI_UINT64_T, recvtype); - break; - case MTEST_BDT_FLOAT: - merr = MTestTypeBasicCreate(MPI_FLOAT, sendtype); - merr = MTestTypeBasicCreate(MPI_FLOAT, recvtype); - break; - case MTEST_BDT_BYTE: - merr = MTestTypeBasicCreate(MPI_BYTE, sendtype); - merr = MTestTypeBasicCreate(MPI_BYTE, recvtype); - break; - } - sendtype->count = tot_count; - recvtype->count = tot_count; - - return merr; -} - -/* ------------------------------------------------------------------------ */ -/* Routine to generate send/receive derived datatypes */ -/* ------------------------------------------------------------------------ */ - -static inline int MTestGetSendDerivedDatatypes(MTestDatatype * sendtype, - MTestDatatype * recvtype, MPI_Aint tot_count) -{ - int merr = 0; - int ddt_datatype_index, ddt_c_dt; - MPI_Aint blen, stride, count, align_tot_count, lb; - MPI_Datatype old_type = MPI_DOUBLE; - - /* Check index */ - ddt_datatype_index = SMPI_VARGET_GLOBAL(datatype_index) - SMPI_VARGET_GLOBAL(MTEST_SEND_DDT_START_IDX); - ddt_c_dt = ddt_datatype_index / MTEST_DDT_NUM_SUBTESTS; - if (ddt_c_dt >= MTEST_DDT_MAX || !SMPI_VARGET_GLOBAL(mtestDdtCreators)[ddt_c_dt]) { - printf("Wrong index: global %d, send %d send-ddt %d, or undefined creator in %s\n", - SMPI_VARGET_GLOBAL(datatype_index), ddt_datatype_index, ddt_c_dt, __func__); - merr++; - return merr; - } - - /* Set datatype structure */ - merr = MTestDdtStructDefine(ddt_datatype_index, tot_count, &count, &blen, - &stride, &align_tot_count, &lb); - if (merr) { - printf("Wrong index: global %d, send %d send-ddt %d, or undefined ddt structure in %s\n", - SMPI_VARGET_GLOBAL(datatype_index), ddt_datatype_index, ddt_c_dt, __func__); - merr++; - return merr; - } - - /* Create send datatype */ - merr = SMPI_VARGET_GLOBAL(mtestDdtCreators)[ddt_c_dt] (count, blen, stride, lb, old_type, "send", sendtype); - if (merr) - return merr; - - sendtype->count = 1; - - /* Create receive datatype */ - merr = MTestTypeBasicCreate(old_type, recvtype); - if (merr) - return merr; - - recvtype->count = sendtype->count * align_tot_count; - - return merr; -} - -static inline int MTestGetRecvDerivedDatatypes(MTestDatatype * sendtype, - MTestDatatype * recvtype, MPI_Aint tot_count) -{ - int merr = 0; - int ddt_datatype_index, ddt_c_dt; - MPI_Aint blen, stride, count, align_tot_count, lb; - MPI_Datatype old_type = MPI_DOUBLE; - - /* Check index */ - ddt_datatype_index = SMPI_VARGET_GLOBAL(datatype_index) - SMPI_VARGET_GLOBAL(MTEST_RECV_DDT_START_IDX); - ddt_c_dt = ddt_datatype_index / MTEST_DDT_NUM_SUBTESTS; - if (ddt_c_dt >= MTEST_DDT_MAX || !SMPI_VARGET_GLOBAL(mtestDdtCreators)[ddt_c_dt]) { - printf("Wrong index: global %d, recv %d recv-ddt %d, or undefined creator in %s\n", - SMPI_VARGET_GLOBAL(datatype_index), ddt_datatype_index, ddt_c_dt, __func__); - merr++; - return merr; - } - - /* Set datatype structure */ - merr = MTestDdtStructDefine(ddt_datatype_index, tot_count, &count, &blen, - &stride, &align_tot_count, &lb); - if (merr) { - printf("Wrong index: global %d, recv %d recv-ddt %d, or undefined ddt structure in %s\n", - SMPI_VARGET_GLOBAL(datatype_index), ddt_datatype_index, ddt_c_dt, __func__); - return merr; - } - - /* Create receive datatype */ - merr = SMPI_VARGET_GLOBAL(mtestDdtCreators)[ddt_c_dt] (count, blen, stride, lb, old_type, "recv", recvtype); - if (merr) - return merr; - - recvtype->count = 1; - - /* Create send datatype */ - merr = MTestTypeBasicCreate(old_type, sendtype); - if (merr) - return merr; - - sendtype->count = recvtype->count * align_tot_count; - - return merr; -} - -/* ------------------------------------------------------------------------ */ -/* Exposed routine to external tests */ -/* ------------------------------------------------------------------------ */ -int MTestGetDatatypes(MTestDatatype * sendtype, MTestDatatype * recvtype, MPI_Aint tot_count) -{ - int merr = 0; - - MTestGetDbgInfo(&SMPI_VARGET_GLOBAL(dbgflag2), &SMPI_VARGET_GLOBAL(verbose2)); - MTestInitDatatypeEnv(); - MPI_Comm_rank(MPI_COMM_WORLD, &SMPI_VARGET_GLOBAL(wrank2)); - - /* Initialize the default test level if test does not specify. */ - if (!MTestIsDatatypeGenInited()) { - MTestInitDefaultTestFunc(); - } - - if (SMPI_VARGET_GLOBAL(datatype_index) == 0) { - MTestPrintDatatypeGen(); - } - - /* Start generating tests */ - if (SMPI_VARGET_GLOBAL(datatype_index) < SMPI_VARGET_GLOBAL(MTEST_BDT_RANGE)) { - merr = MTestGetBasicDatatypes(sendtype, recvtype, tot_count); - - } - else if (SMPI_VARGET_GLOBAL(datatype_index) < SMPI_VARGET_GLOBAL(MTEST_SEND_DDT_RANGE)) { - merr = MTestGetSendDerivedDatatypes(sendtype, recvtype, tot_count); - - } - else if (SMPI_VARGET_GLOBAL(datatype_index) < SMPI_VARGET_GLOBAL(MTEST_RECV_DDT_RANGE)) { - merr = MTestGetRecvDerivedDatatypes(sendtype, recvtype, tot_count); - - } - else { - /* out of range */ - SMPI_VARGET_GLOBAL(datatype_index) = -1; - MTestResetDatatypeGen(); - } - - /* stop if error reported */ - if (merr) { - SMPI_VARGET_GLOBAL(datatype_index) = -1; - } - - if (SMPI_VARGET_GLOBAL(datatype_index) > 0) { - /* general initialization for receive buffer. */ - recvtype->InitBuf = MTestTypeInitRecv; - } - - SMPI_VARGET_GLOBAL(datatype_index)++; - - if (SMPI_VARGET_GLOBAL(verbose2) >= 2 && SMPI_VARGET_GLOBAL(datatype_index) > 0) { - MPI_Count ssize, rsize; - MPI_Aint slb, rlb, sextent, rextent; - const char *sendtype_nm = MTestGetDatatypeName(sendtype); - const char *recvtype_nm = MTestGetDatatypeName(recvtype); - MPI_Type_size_x(sendtype->datatype, &ssize); - MPI_Type_size_x(recvtype->datatype, &rsize); - - MPI_Type_get_extent(sendtype->datatype, &slb, &sextent); - MPI_Type_get_extent(recvtype->datatype, &rlb, &rextent); - - MTestPrintfMsg(2, "Get datatypes: send = %s(size %d ext %ld lb %ld count %d basesize %d), " - "recv = %s(size %d ext %ld lb %ld count %d basesize %d), tot_count=%d\n", - sendtype_nm, ssize, sextent, slb, sendtype->count, sendtype->basesize, - recvtype_nm, rsize, rextent, rlb, recvtype->count, recvtype->basesize, - tot_count); - fflush(stdout); - } - - return SMPI_VARGET_GLOBAL(datatype_index); -} - -/* Reset the datatype index (start from the initial data type. - Note: This routine is rarely needed; MTestGetDatatypes automatically - starts over after the last available datatype is used. -*/ -void MTestResetDatatypes(void) -{ - SMPI_VARGET_GLOBAL(datatype_index) = 0; - MTestResetDatatypeGen(); -} - -/* Return the index of the current datatype. This is rarely needed and - is provided mostly to enable debugging of the MTest package itself */ -int MTestGetDatatypeIndex(void) -{ - return SMPI_VARGET_GLOBAL(datatype_index); -} - -/* Free the storage associated with a datatype */ -void MTestFreeDatatype(MTestDatatype * mtype) -{ - int merr; - /* Invoke a datatype-specific free function to handle - * both the datatype and the send/receive buffers */ - if (mtype->FreeBuf) { - (mtype->FreeBuf) (mtype); - } - /* Free the datatype itself if it was created */ - if (!mtype->isBasic) { - merr = MPI_Type_free(&mtype->datatype); - if (merr) - MTestPrintError(merr); - } -} - -/* Check that a message was received correctly. Returns the number of - errors detected. Status may be NULL or MPI_STATUS_IGNORE */ -int MTestCheckRecv(MPI_Status * status, MTestDatatype * recvtype) -{ - int count; - int errs = 0, merr; - - if (status && status != MPI_STATUS_IGNORE) { - merr = MPI_Get_count(status, recvtype->datatype, &count); - if (merr) - MTestPrintError(merr); - - /* Check count against expected count */ - if (count != recvtype->count) { - errs++; - } - } - - /* Check received data */ - if (!errs && recvtype->CheckBuf(recvtype)) { - errs++; - } - return errs; -} - - SMPI_VARINIT_GLOBAL_AND_SET(name , char*,NULL); - SMPI_VARINIT_GLOBAL_AND_SET(sp,int,0); - -/* This next routine uses a circular buffer of static name arrays just to - simplify the use of the routine */ -const char *MTestGetDatatypeName(MTestDatatype * dtype) -{ - if(SMPI_VARGET_GLOBAL(name)==NULL) SMPI_VARGET_GLOBAL(name)=(char*)malloc(4*MPI_MAX_OBJECT_NAME*sizeof(char)); - int rlen, merr; - - if (SMPI_VARGET_GLOBAL(sp) >= 4) - SMPI_VARGET_GLOBAL(sp) = 0; - merr = MPI_Type_get_name(dtype->datatype, &SMPI_VARGET_GLOBAL(name)[SMPI_VARGET_GLOBAL(sp)*MPI_MAX_OBJECT_NAME], &rlen); - if (merr) - MTestPrintError(merr); - return (const char *) &SMPI_VARGET_GLOBAL(name)[(SMPI_VARGET_GLOBAL(sp)++) *MPI_MAX_OBJECT_NAME]; -} diff --git a/teshsuite/smpi/mpich3-test/util/mtest_manual.c b/teshsuite/smpi/mpich3-test/util/mtest_manual.c deleted file mode 100644 index 9461da445b..0000000000 --- a/teshsuite/smpi/mpich3-test/util/mtest_manual.c +++ /dev/null @@ -1,1361 +0,0 @@ -/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ -/* - * - * (C) 2001 by Argonne National Laboratory. - * See COPYRIGHT in top-level directory. - */ -#include "mpi.h" -#include "mpitestconf.h" -#include "mpitest.h" -#if defined(HAVE_STDIO_H) || defined(STDC_HEADERS) -#include -#endif -#if defined(HAVE_STDLIB_H) || defined(STDC_HEADERS) -#include -#endif -#if defined(HAVE_STRING_H) || defined(STDC_HEADERS) -#include -#endif -#ifdef HAVE_STDARG_H -#include -#endif -/* The following two includes permit the collection of resource usage - data in the tests - */ -#ifdef HAVE_SYS_TIME_H -#include -#endif -#ifdef HAVE_SYS_RESOURCE_H -#include -#endif -#include - - -/* - * Utility routines for writing MPI tests. - * - * We check the return codes on all MPI routines (other than INIT) - * to allow the program that uses these routines to select MPI_ERRORS_RETURN - * as the error handler. We do *not* set MPI_ERRORS_RETURN because - * the code that makes use of these routines may not check return - * codes. - * - */ - -static void MTestRMACleanup(void); -static void MTestResourceSummary(FILE *); - -/* Here is where we could put the includes and definitions to enable - memory testing */ - -SMPI_VARINIT_GLOBAL_AND_SET(dbgflag, int, 0); /* Flag used for debugging */ -SMPI_VARINIT_GLOBAL_AND_SET(wrank, int, -1); /* World rank */ -SMPI_VARINIT_GLOBAL_AND_SET(verbose, int, 0); /* Message level (0 is none) */ -SMPI_VARINIT_GLOBAL_AND_SET(returnWithVal, int, 0); /* Allow programs to return - with a non-zero if there was an error (may - cause problems with some runtime systems) */ -SMPI_VARINIT_GLOBAL_AND_SET(usageOutput, int, 0); /* */ - -/* Provide backward portability to MPI 1 */ -#ifndef MPI_VERSION -#define MPI_VERSION 1 -#endif -#if MPI_VERSION < 2 -#define MPI_THREAD_SINGLE 0 -#endif - -/* - * Initialize and Finalize MTest - */ - -/* - Initialize MTest, initializing MPI if necessary. - - Environment Variables: -+ MPITEST_DEBUG - If set (to any value), turns on debugging output -. MPITEST_THREADLEVEL_DEFAULT - If set, use as the default "provided" - level of thread support. Applies to - MTest_Init but not MTest_Init_thread. -- MPITEST_VERBOSE - If set to a numeric value, turns on that level of - verbose output. This is used by the routine 'MTestPrintfMsg' - -*/ -void MTest_Init_thread(int *argc, char ***argv, int required, int *provided) -{ - int flag; - char *envval = 0; - - MPI_Initialized(&flag); - if (!flag) { - /* Permit an MPI that claims only MPI 1 but includes the - * MPI_Init_thread routine (e.g., IBM MPI) */ -#if MPI_VERSION >= 2 || defined(HAVE_MPI_INIT_THREAD) - MPI_Init_thread(argc, argv, required, provided); -#else - MPI_Init(argc, argv); - *provided = -1; -#endif - } - /* Check for debugging control */ - if (getenv("MPITEST_DEBUG")) { - SMPI_VARGET_GLOBAL(dbgflag) = 1; - MPI_Comm_rank(MPI_COMM_WORLD, &SMPI_VARGET_GLOBAL(wrank)); - } - - /* Check for verbose control */ - envval = getenv("MPITEST_VERBOSE"); - if (envval) { - char *s; - long val = strtol(envval, &s, 0); - if (s == envval) { - /* This is the error case for strtol */ - fprintf(stderr, "Warning: %s not valid for MPITEST_VERBOSE\n", envval); - fflush(stderr); - } - else { - if (val >= 0) { - SMPI_VARGET_GLOBAL(verbose) = val; - } - else { - fprintf(stderr, "Warning: %s not valid for MPITEST_VERBOSE\n", envval); - fflush(stderr); - } - } - } - /* Check for option to return success/failure in the return value of main */ - envval = getenv("MPITEST_RETURN_WITH_CODE"); - if (envval) { - if (strcmp(envval, "yes") == 0 || - strcmp(envval, "YES") == 0 || - strcmp(envval, "true") == 0 || strcmp(envval, "TRUE") == 0) { - SMPI_VARGET_GLOBAL(returnWithVal) = 1; - } - else if (strcmp(envval, "no") == 0 || - strcmp(envval, "NO") == 0 || - strcmp(envval, "false") == 0 || strcmp(envval, "FALSE") == 0) { - SMPI_VARGET_GLOBAL(returnWithVal) = 0; - } - else { - fprintf(stderr, "Warning: %s not valid for MPITEST_RETURN_WITH_CODE\n", envval); - fflush(stderr); - } - } - - /* Print rusage data if set */ - if (getenv("MPITEST_RUSAGE")) { - SMPI_VARGET_GLOBAL(usageOutput) = 1; - } -} - -/* - * Initialize the tests, using an MPI-1 style init. Supports - * MTEST_THREADLEVEL_DEFAULT to test with user-specified thread level - */ -void MTest_Init(int *argc, char ***argv) -{ - int provided; -#if MPI_VERSION >= 2 || defined(HAVE_MPI_INIT_THREAD) - const char *str = 0; - int threadLevel; - - threadLevel = MPI_THREAD_SINGLE; - str = getenv("MTEST_THREADLEVEL_DEFAULT"); - if (!str) - str = getenv("MPITEST_THREADLEVEL_DEFAULT"); - if (str && *str) { - if (strcmp(str, "MULTIPLE") == 0 || strcmp(str, "multiple") == 0) { - threadLevel = MPI_THREAD_MULTIPLE; - } - else if (strcmp(str, "SERIALIZED") == 0 || strcmp(str, "serialized") == 0) { - threadLevel = MPI_THREAD_SERIALIZED; - } - else if (strcmp(str, "FUNNELED") == 0 || strcmp(str, "funneled") == 0) { - threadLevel = MPI_THREAD_FUNNELED; - } - else if (strcmp(str, "SINGLE") == 0 || strcmp(str, "single") == 0) { - threadLevel = MPI_THREAD_SINGLE; - } - else { - fprintf(stderr, "Unrecognized thread level %s\n", str); - /* Use exit since MPI_Init/Init_thread has not been called. */ - exit(1); - } - } - MTest_Init_thread(argc, argv, threadLevel, &provided); -#else - /* If the MPI_VERSION is 1, there is no MPI_THREAD_xxx defined */ - MTest_Init_thread(argc, argv, 0, &provided); -#endif -} - -/* - Finalize MTest. errs is the number of errors on the calling process; - this routine will write the total number of errors over all of MPI_COMM_WORLD - to the process with rank zero, or " No Errors". - It does *not* finalize MPI. - */ -void MTest_Finalize(int errs) -{ - int rank, toterrs, merr; - - merr = MPI_Comm_rank(MPI_COMM_WORLD, &rank); - if (merr) - MTestPrintError(merr); - - merr = MPI_Reduce(&errs, &toterrs, 1, MPI_INT, MPI_SUM, 0, MPI_COMM_WORLD); - if (merr) - MTestPrintError(merr); - if (rank == 0) { - if (toterrs) { - printf(" Found %d errors\n", toterrs); - } - else { - printf(" No Errors\n"); - } - fflush(stdout); - } - - if (SMPI_VARGET_GLOBAL(usageOutput)) - MTestResourceSummary(stdout); - - - /* Clean up any persistent objects that we allocated */ - MTestRMACleanup(); -} - -/* ------------------------------------------------------------------------ */ -/* This routine may be used instead of "return 0;" at the end of main; - it allows the program to use the return value to signal success or failure. - */ -int MTestReturnValue(int errors) -{ - if (SMPI_VARGET_GLOBAL(returnWithVal)) - return errors ? 1 : 0; - return 0; -} - -/* ------------------------------------------------------------------------ */ - -/* - * Miscellaneous utilities, particularly to eliminate OS dependencies - * from the tests. - * MTestSleep(seconds) - */ -#ifdef HAVE_WINDOWS_H -#include -void MTestSleep(int sec) -{ - Sleep(1000 * sec); -} -#else -#include -void MTestSleep(int sec) -{ - sleep(sec); -} -#endif - -/* Other mtest subfiles read debug setting using this function. */ -void MTestGetDbgInfo(int *_dbgflag, int *_verbose) -{ - *_dbgflag = SMPI_VARGET_GLOBAL(dbgflag); - *_verbose = SMPI_VARGET_GLOBAL(verbose); -} - -/* ----------------------------------------------------------------------- */ - -/* - * Create communicators. Use separate routines for inter and intra - * communicators (there is a routine to give both) - * Note that the routines may return MPI_COMM_NULL, so code should test for - * that return value as well. - * - */ -SMPI_VARINIT_GLOBAL_AND_SET(interCommIdx, int, 0); -SMPI_VARINIT_GLOBAL_AND_SET(intraCommIdx, int, 0); -SMPI_VARINIT_GLOBAL_AND_SET(intraCommName, const char *, 0); -SMPI_VARINIT_GLOBAL_AND_SET(interCommName, const char *, 0); - -/* - * Get an intracommunicator with at least min_size members. If "allowSmaller" - * is true, allow the communicator to be smaller than MPI_COMM_WORLD and - * for this routine to return MPI_COMM_NULL for some values. Returns 0 if - * no more communicators are available. - */ -int MTestGetIntracommGeneral(MPI_Comm * comm, int min_size, int allowSmaller) -{ - int size, rank, merr; - int done = 0; - int isBasic = 0; - - /* The while loop allows us to skip communicators that are too small. - * MPI_COMM_NULL is always considered large enough */ - while (!done) { - isBasic = 0; - SMPI_VARGET_GLOBAL(intraCommName) = ""; - switch (SMPI_VARGET_GLOBAL(intraCommIdx)) { - case 0: - *comm = MPI_COMM_WORLD; - isBasic = 1; - SMPI_VARGET_GLOBAL(intraCommName) = "MPI_COMM_WORLD"; - break; - case 1: - /* dup of world */ - merr = MPI_Comm_dup(MPI_COMM_WORLD, comm); - if (merr) - MTestPrintError(merr); - SMPI_VARGET_GLOBAL(intraCommName) = "Dup of MPI_COMM_WORLD"; - break; - case 2: - /* reverse ranks */ - merr = MPI_Comm_size(MPI_COMM_WORLD, &size); - if (merr) - MTestPrintError(merr); - merr = MPI_Comm_rank(MPI_COMM_WORLD, &rank); - if (merr) - MTestPrintError(merr); - merr = MPI_Comm_split(MPI_COMM_WORLD, 0, size - rank, comm); - if (merr) - MTestPrintError(merr); - SMPI_VARGET_GLOBAL(intraCommName) = "Rank reverse of MPI_COMM_WORLD"; - break; - case 3: - /* subset of world, with reversed ranks */ - merr = MPI_Comm_size(MPI_COMM_WORLD, &size); - if (merr) - MTestPrintError(merr); - merr = MPI_Comm_rank(MPI_COMM_WORLD, &rank); - if (merr) - MTestPrintError(merr); - merr = MPI_Comm_split(MPI_COMM_WORLD, ((rank < size / 2) ? 1 : MPI_UNDEFINED), - size - rank, comm); - if (merr) - MTestPrintError(merr); - SMPI_VARGET_GLOBAL(intraCommName) = "Rank reverse of half of MPI_COMM_WORLD"; - break; - case 4: - *comm = MPI_COMM_SELF; - isBasic = 1; - SMPI_VARGET_GLOBAL(intraCommName) = "MPI_COMM_SELF"; - break; - case 5: - { -#if MTEST_HAVE_MIN_MPI_VERSION(3,0) - /* Dup of the world using MPI_Intercomm_merge */ - int rleader, isLeft; - MPI_Comm local_comm, inter_comm; - MPI_Comm_size(MPI_COMM_WORLD, &size); - MPI_Comm_rank(MPI_COMM_WORLD, &rank); - if (size > 1) { - merr = MPI_Comm_split(MPI_COMM_WORLD, (rank < size / 2), rank, &local_comm); - if (merr) - MTestPrintError(merr); - if (rank == 0) { - rleader = size / 2; - } - else if (rank == size / 2) { - rleader = 0; - } - else { - rleader = -1; - } - isLeft = rank < size / 2; - merr = - MPI_Intercomm_create(local_comm, 0, MPI_COMM_WORLD, rleader, 99, - &inter_comm); - if (merr) - MTestPrintError(merr); - merr = MPI_Intercomm_merge(inter_comm, isLeft, comm); - if (merr) - MTestPrintError(merr); - MPI_Comm_free(&inter_comm); - MPI_Comm_free(&local_comm); - SMPI_VARGET_GLOBAL(intraCommName) = "Dup of WORLD created by MPI_Intercomm_merge"; - } - else { - *comm = MPI_COMM_NULL; - } - } - break; - case 6: - { - /* Even of the world using MPI_Comm_create_group */ - int i; - MPI_Group world_group, even_group; - int *excl = NULL; - - MPI_Comm_size(MPI_COMM_WORLD, &size); - MPI_Comm_rank(MPI_COMM_WORLD, &rank); - if (allowSmaller && (size + 1) / 2 >= min_size) { - /* exclude the odd ranks */ - excl = malloc((size / 2) * sizeof(int)); - for (i = 0; i < size / 2; i++) - excl[i] = (2 * i) + 1; - - MPI_Comm_group(MPI_COMM_WORLD, &world_group); - MPI_Group_excl(world_group, size / 2, excl, &even_group); - MPI_Group_free(&world_group); - free(excl); - - if (rank % 2 == 0) { - /* Even processes create a comm. for themselves */ - MPI_Comm_create_group(MPI_COMM_WORLD, even_group, 0, comm); - SMPI_VARGET_GLOBAL(intraCommName) = "Even of WORLD created by MPI_Comm_create_group"; - } - else { - *comm = MPI_COMM_NULL; - } - - MPI_Group_free(&even_group); - } - else { - *comm = MPI_COMM_NULL; - } -#else - *comm = MPI_COMM_NULL; -#endif - } - break; - case 7: - { - /* High half of the world using MPI_Comm_create */ - int ranges[1][3]; - MPI_Group world_group, high_group; - MPI_Comm_size(MPI_COMM_WORLD, &size); - MPI_Comm_rank(MPI_COMM_WORLD, &rank); - ranges[0][0] = size / 2; - ranges[0][1] = size - 1; - ranges[0][2] = 1; - - if (allowSmaller && (size + 1) / 2 >= min_size) { - MPI_Comm_group(MPI_COMM_WORLD, &world_group); - merr = MPI_Group_range_incl(world_group, 1, ranges, &high_group); - if (merr) - MTestPrintError(merr); - merr = MPI_Comm_create(MPI_COMM_WORLD, high_group, comm); - if (merr) - MTestPrintError(merr); - MPI_Group_free(&world_group); - MPI_Group_free(&high_group); - SMPI_VARGET_GLOBAL(intraCommName) = "High half of WORLD created by MPI_Comm_create"; - } - else { - *comm = MPI_COMM_NULL; - } - } - break; - /* These next cases are communicators that include some - * but not all of the processes */ - case 8: - case 9: - case 10: - case 11: - { - int newsize; - merr = MPI_Comm_size(MPI_COMM_WORLD, &size); - if (merr) - MTestPrintError(merr); - newsize = size - (SMPI_VARGET_GLOBAL(intraCommIdx) - 7); - - if (allowSmaller && newsize >= min_size) { - merr = MPI_Comm_rank(MPI_COMM_WORLD, &rank); - if (merr) - MTestPrintError(merr); - merr = MPI_Comm_split(MPI_COMM_WORLD, rank < newsize, rank, comm); - if (merr) - MTestPrintError(merr); - if (rank >= newsize) { - merr = MPI_Comm_free(comm); - if (merr) - MTestPrintError(merr); - *comm = MPI_COMM_NULL; - } - else { - SMPI_VARGET_GLOBAL(intraCommName) = "Split of WORLD"; - } - } - else { - /* Act like default */ - *comm = MPI_COMM_NULL; - SMPI_VARGET_GLOBAL(intraCommIdx) = -1; - } - } - break; - - /* Other ideas: dup of self, cart comm, graph comm */ - default: - *comm = MPI_COMM_NULL; - SMPI_VARGET_GLOBAL(intraCommIdx) = -1; - break; - } - - if (*comm != MPI_COMM_NULL) { - merr = MPI_Comm_size(*comm, &size); - if (merr) - MTestPrintError(merr); - if (size >= min_size) - done = 1; - } - else { - SMPI_VARGET_GLOBAL(intraCommName) = "MPI_COMM_NULL"; - isBasic = 1; - done = 1; - } - - /* we are only done if all processes are done */ - MPI_Allreduce(MPI_IN_PLACE, &done, 1, MPI_INT, MPI_LAND, MPI_COMM_WORLD); - - /* Advance the comm index whether we are done or not, otherwise we could - * spin forever trying to allocate a too-small communicator over and - * over again. */ - SMPI_VARGET_GLOBAL(intraCommIdx)++; - - if (!done && !isBasic && *comm != MPI_COMM_NULL) { - /* avoid leaking communicators */ - merr = MPI_Comm_free(comm); - if (merr) - MTestPrintError(merr); - } - } - - return SMPI_VARGET_GLOBAL(intraCommIdx); -} - -/* - * Get an intracommunicator with at least min_size members. - */ -int MTestGetIntracomm(MPI_Comm * comm, int min_size) -{ - return MTestGetIntracommGeneral(comm, min_size, 0); -} - -/* Return the name of an intra communicator */ -const char *MTestGetIntracommName(void) -{ - return SMPI_VARGET_GLOBAL(intraCommName); -} - -/* - * Return an intercomm; set isLeftGroup to 1 if the calling process is - * a member of the "left" group. - */ -int MTestGetIntercomm(MPI_Comm * comm, int *isLeftGroup, int min_size) -{ - int size, rank, remsize, merr; - int done = 0; - MPI_Comm mcomm = MPI_COMM_NULL; - MPI_Comm mcomm2 = MPI_COMM_NULL; - int rleader; - - /* The while loop allows us to skip communicators that are too small. - * MPI_COMM_NULL is always considered large enough. The size is - * the sum of the sizes of the local and remote groups */ - while (!done) { - *comm = MPI_COMM_NULL; - *isLeftGroup = 0; - SMPI_VARGET_GLOBAL(interCommName) = "MPI_COMM_NULL"; - - switch (SMPI_VARGET_GLOBAL(interCommIdx)) { - case 0: - /* Split comm world in half */ - merr = MPI_Comm_rank(MPI_COMM_WORLD, &rank); - if (merr) - MTestPrintError(merr); - merr = MPI_Comm_size(MPI_COMM_WORLD, &size); - if (merr) - MTestPrintError(merr); - if (size > 1) { - merr = MPI_Comm_split(MPI_COMM_WORLD, (rank < size / 2), rank, &mcomm); - if (merr) - MTestPrintError(merr); - if (rank == 0) { - rleader = size / 2; - } - else if (rank == size / 2) { - rleader = 0; - } - else { - /* Remote leader is signficant only for the processes - * designated local leaders */ - rleader = -1; - } - *isLeftGroup = rank < size / 2; - merr = MPI_Intercomm_create(mcomm, 0, MPI_COMM_WORLD, rleader, 12345, comm); - if (merr) - MTestPrintError(merr); - SMPI_VARGET_GLOBAL(interCommName) = "Intercomm by splitting MPI_COMM_WORLD"; - } - else - *comm = MPI_COMM_NULL; - break; - case 1: - /* Split comm world in to 1 and the rest */ - merr = MPI_Comm_rank(MPI_COMM_WORLD, &rank); - if (merr) - MTestPrintError(merr); - merr = MPI_Comm_size(MPI_COMM_WORLD, &size); - if (merr) - MTestPrintError(merr); - if (size > 1) { - merr = MPI_Comm_split(MPI_COMM_WORLD, rank == 0, rank, &mcomm); - if (merr) - MTestPrintError(merr); - if (rank == 0) { - rleader = 1; - } - else if (rank == 1) { - rleader = 0; - } - else { - /* Remote leader is signficant only for the processes - * designated local leaders */ - rleader = -1; - } - *isLeftGroup = rank == 0; - merr = MPI_Intercomm_create(mcomm, 0, MPI_COMM_WORLD, rleader, 12346, comm); - if (merr) - MTestPrintError(merr); - SMPI_VARGET_GLOBAL(interCommName) = "Intercomm by splitting MPI_COMM_WORLD into 1, rest"; - } - else - *comm = MPI_COMM_NULL; - break; - - case 2: - /* Split comm world in to 2 and the rest */ - merr = MPI_Comm_rank(MPI_COMM_WORLD, &rank); - if (merr) - MTestPrintError(merr); - merr = MPI_Comm_size(MPI_COMM_WORLD, &size); - if (merr) - MTestPrintError(merr); - if (size > 3) { - merr = MPI_Comm_split(MPI_COMM_WORLD, rank < 2, rank, &mcomm); - if (merr) - MTestPrintError(merr); - if (rank == 0) { - rleader = 2; - } - else if (rank == 2) { - rleader = 0; - } - else { - /* Remote leader is signficant only for the processes - * designated local leaders */ - rleader = -1; - } - *isLeftGroup = rank < 2; - merr = MPI_Intercomm_create(mcomm, 0, MPI_COMM_WORLD, rleader, 12347, comm); - if (merr) - MTestPrintError(merr); - SMPI_VARGET_GLOBAL(interCommName) = "Intercomm by splitting MPI_COMM_WORLD into 2, rest"; - } - else - *comm = MPI_COMM_NULL; - break; - - case 3: - /* Split comm world in half, then dup */ - merr = MPI_Comm_rank(MPI_COMM_WORLD, &rank); - if (merr) - MTestPrintError(merr); - merr = MPI_Comm_size(MPI_COMM_WORLD, &size); - if (merr) - MTestPrintError(merr); - if (size > 1) { - merr = MPI_Comm_split(MPI_COMM_WORLD, (rank < size / 2), rank, &mcomm); - if (merr) - MTestPrintError(merr); - if (rank == 0) { - rleader = size / 2; - } - else if (rank == size / 2) { - rleader = 0; - } - else { - /* Remote leader is signficant only for the processes - * designated local leaders */ - rleader = -1; - } - *isLeftGroup = rank < size / 2; - merr = MPI_Intercomm_create(mcomm, 0, MPI_COMM_WORLD, rleader, 12345, comm); - if (merr) - MTestPrintError(merr); - /* avoid leaking after assignment below */ - merr = MPI_Comm_free(&mcomm); - if (merr) - MTestPrintError(merr); - - /* now dup, some bugs only occur for dup's of intercomms */ - mcomm = *comm; - merr = MPI_Comm_dup(mcomm, comm); - if (merr) - MTestPrintError(merr); - SMPI_VARGET_GLOBAL(interCommName) = "Intercomm by splitting MPI_COMM_WORLD then dup'ing"; - } - else - *comm = MPI_COMM_NULL; - break; - - case 4: - /* Split comm world in half, form intercomm, then split that intercomm */ - merr = MPI_Comm_rank(MPI_COMM_WORLD, &rank); - if (merr) - MTestPrintError(merr); - merr = MPI_Comm_size(MPI_COMM_WORLD, &size); - if (merr) - MTestPrintError(merr); - if (size > 1) { - merr = MPI_Comm_split(MPI_COMM_WORLD, (rank < size / 2), rank, &mcomm); - if (merr) - MTestPrintError(merr); - if (rank == 0) { - rleader = size / 2; - } - else if (rank == size / 2) { - rleader = 0; - } - else { - /* Remote leader is signficant only for the processes - * designated local leaders */ - rleader = -1; - } - *isLeftGroup = rank < size / 2; - merr = MPI_Intercomm_create(mcomm, 0, MPI_COMM_WORLD, rleader, 12345, comm); - if (merr) - MTestPrintError(merr); - /* avoid leaking after assignment below */ - merr = MPI_Comm_free(&mcomm); - if (merr) - MTestPrintError(merr); - - /* now split, some bugs only occur for splits of intercomms */ - mcomm = *comm; - merr = MPI_Comm_rank(mcomm, &rank); - if (merr) - MTestPrintError(merr); - /* this split is effectively a dup but tests the split code paths */ - merr = MPI_Comm_split(mcomm, 0, rank, comm); - if (merr) - MTestPrintError(merr); - SMPI_VARGET_GLOBAL(interCommName) = "Intercomm by splitting MPI_COMM_WORLD then then splitting again"; - } - else - *comm = MPI_COMM_NULL; - break; - - case 5: - /* split comm world in half discarding rank 0 on the "left" - * communicator, then form them into an intercommunicator */ - merr = MPI_Comm_rank(MPI_COMM_WORLD, &rank); - if (merr) - MTestPrintError(merr); - merr = MPI_Comm_size(MPI_COMM_WORLD, &size); - if (merr) - MTestPrintError(merr); - if (size >= 4) { - int color = (rank < size / 2 ? 0 : 1); - if (rank == 0) - color = MPI_UNDEFINED; - - merr = MPI_Comm_split(MPI_COMM_WORLD, color, rank, &mcomm); - if (merr) - MTestPrintError(merr); - - if (rank == 1) { - rleader = size / 2; - } - else if (rank == (size / 2)) { - rleader = 1; - } - else { - /* Remote leader is signficant only for the processes - * designated local leaders */ - rleader = -1; - } - *isLeftGroup = rank < size / 2; - if (rank != 0) { /* 0's mcomm is MPI_COMM_NULL */ - merr = MPI_Intercomm_create(mcomm, 0, MPI_COMM_WORLD, rleader, 12345, comm); - if (merr) - MTestPrintError(merr); - } - SMPI_VARGET_GLOBAL(interCommName) = - "Intercomm by splitting MPI_COMM_WORLD (discarding rank 0 in the left group) then MPI_Intercomm_create'ing"; - } - else { - *comm = MPI_COMM_NULL; - } - break; - - case 6: - /* Split comm world in half then form them into an - * intercommunicator. Then discard rank 0 from each group of the - * intercomm via MPI_Comm_create. */ - merr = MPI_Comm_rank(MPI_COMM_WORLD, &rank); - if (merr) - MTestPrintError(merr); - merr = MPI_Comm_size(MPI_COMM_WORLD, &size); - if (merr) - MTestPrintError(merr); - if (size >= 4) { - MPI_Group oldgroup, newgroup; - int ranks[1]; - int color = (rank < size / 2 ? 0 : 1); - - merr = MPI_Comm_split(MPI_COMM_WORLD, color, rank, &mcomm); - if (merr) - MTestPrintError(merr); - - if (rank == 0) { - rleader = size / 2; - } - else if (rank == (size / 2)) { - rleader = 0; - } - else { - /* Remote leader is signficant only for the processes - * designated local leaders */ - rleader = -1; - } - *isLeftGroup = rank < size / 2; - merr = MPI_Intercomm_create(mcomm, 0, MPI_COMM_WORLD, rleader, 12345, &mcomm2); - if (merr) - MTestPrintError(merr); - - /* We have an intercomm between the two halves of comm world. Now create - * a new intercomm that removes rank 0 on each side. */ - merr = MPI_Comm_group(mcomm2, &oldgroup); - if (merr) - MTestPrintError(merr); - ranks[0] = 0; - merr = MPI_Group_excl(oldgroup, 1, ranks, &newgroup); - if (merr) - MTestPrintError(merr); - merr = MPI_Comm_create(mcomm2, newgroup, comm); - if (merr) - MTestPrintError(merr); - - merr = MPI_Group_free(&oldgroup); - if (merr) - MTestPrintError(merr); - merr = MPI_Group_free(&newgroup); - if (merr) - MTestPrintError(merr); - - SMPI_VARGET_GLOBAL(interCommName) = - "Intercomm by splitting MPI_COMM_WORLD then discarding 0 ranks with MPI_Comm_create"; - } - else { - *comm = MPI_COMM_NULL; - } - break; - - default: - *comm = MPI_COMM_NULL; - SMPI_VARGET_GLOBAL(interCommIdx) = -1; - break; - } - - if (*comm != MPI_COMM_NULL) { - merr = MPI_Comm_size(*comm, &size); - if (merr) - MTestPrintError(merr); - merr = MPI_Comm_remote_size(*comm, &remsize); - if (merr) - MTestPrintError(merr); - if (size + remsize >= min_size) - done = 1; - } - else { - SMPI_VARGET_GLOBAL(interCommName) = "MPI_COMM_NULL"; - done = 1; - } - - /* we are only done if all processes are done */ - MPI_Allreduce(MPI_IN_PLACE, &done, 1, MPI_INT, MPI_LAND, MPI_COMM_WORLD); - - /* Advance the comm index whether we are done or not, otherwise we could - * spin forever trying to allocate a too-small communicator over and - * over again. */ - SMPI_VARGET_GLOBAL(interCommIdx)++; - - if (!done && *comm != MPI_COMM_NULL) { - /* avoid leaking communicators */ - merr = MPI_Comm_free(comm); - if (merr) - MTestPrintError(merr); - } - - /* cleanup for common temp objects */ - if (mcomm != MPI_COMM_NULL) { - merr = MPI_Comm_free(&mcomm); - if (merr) - MTestPrintError(merr); - } - if (mcomm2 != MPI_COMM_NULL) { - merr = MPI_Comm_free(&mcomm2); - if (merr) - MTestPrintError(merr); - } - } - - return SMPI_VARGET_GLOBAL(interCommIdx); -} - -int MTestTestIntercomm(MPI_Comm comm) -{ - int local_size, remote_size, rank, **bufs, *bufmem, rbuf[2], j; - int errs = 0, wrank_loc, nsize; - char commname[MPI_MAX_OBJECT_NAME + 1]; - MPI_Request *reqs; - - MPI_Comm_rank(MPI_COMM_WORLD, &wrank_loc); - MPI_Comm_size(comm, &local_size); - MPI_Comm_remote_size(comm, &remote_size); - MPI_Comm_rank(comm, &rank); - MPI_Comm_get_name(comm, commname, &nsize); - - MTestPrintfMsg(1, "Testing communication on intercomm '%s', remote_size=%d\n", - commname, remote_size); - - reqs = (MPI_Request *) malloc(remote_size * sizeof(MPI_Request)); - if (!reqs) { - printf("[%d] Unable to allocated %d requests for testing intercomm %s\n", - wrank_loc, remote_size, commname); - errs++; - return errs; - } - bufs = (int **) malloc(remote_size * sizeof(int *)); - if (!bufs) { - printf("[%d] Unable to allocated %d int pointers for testing intercomm %s\n", - wrank_loc, remote_size, commname); - errs++; - return errs; - } - bufmem = (int *) malloc(remote_size * 2 * sizeof(int)); - if (!bufmem) { - printf("[%d] Unable to allocated %d int data for testing intercomm %s\n", - wrank_loc, 2 * remote_size, commname); - errs++; - return errs; - } - - /* Each process sends a message containing its own rank and the - * rank of the destination with a nonblocking send. Because we're using - * nonblocking sends, we need to use different buffers for each isend */ - /* NOTE: the send buffer access restriction was relaxed in MPI-2.2, although - * it doesn't really hurt to keep separate buffers for our purposes */ - for (j = 0; j < remote_size; j++) { - bufs[j] = &bufmem[2 * j]; - bufs[j][0] = rank; - bufs[j][1] = j; - MPI_Isend(bufs[j], 2, MPI_INT, j, 0, comm, &reqs[j]); - } - MTestPrintfMsg(2, "isends posted, about to recv\n"); - - for (j = 0; j < remote_size; j++) { - MPI_Recv(rbuf, 2, MPI_INT, j, 0, comm, MPI_STATUS_IGNORE); - if (rbuf[0] != j) { - printf("[%d] Expected rank %d but saw %d in %s\n", wrank_loc, j, rbuf[0], commname); - errs++; - } - if (rbuf[1] != rank) { - printf("[%d] Expected target rank %d but saw %d from %d in %s\n", - wrank_loc, rank, rbuf[1], j, commname); - errs++; - } - } - if (errs) - fflush(stdout); - - MTestPrintfMsg(2, "my recvs completed, about to waitall\n"); - MPI_Waitall(remote_size, reqs, MPI_STATUSES_IGNORE); - - free(reqs); - free(bufs); - free(bufmem); - - return errs; -} - -int MTestTestIntracomm(MPI_Comm comm) -{ - int i, errs = 0; - int size; - int in[16], out[16], sol[16]; - - MPI_Comm_size(comm, &size); - - /* Set input, output and sol-values */ - for (i = 0; i < 16; i++) { - in[i] = i; - out[i] = 0; - sol[i] = i * size; - } - MPI_Allreduce(in, out, 16, MPI_INT, MPI_SUM, comm); - - /* Test results */ - for (i = 0; i < 16; i++) { - if (sol[i] != out[i]) - errs++; - } - - return errs; -} - -int MTestTestComm(MPI_Comm comm) -{ - int is_inter; - - if (comm == MPI_COMM_NULL) - return 0; - - MPI_Comm_test_inter(comm, &is_inter); - - if (is_inter) - return MTestTestIntercomm(comm); - else - return MTestTestIntracomm(comm); -} - -/* Return the name of an intercommunicator */ -const char *MTestGetIntercommName(void) -{ - return SMPI_VARGET_GLOBAL(interCommName); -} - -/* Get a communicator of a given minimum size. Both intra and inter - communicators are provided */ -int MTestGetComm(MPI_Comm * comm, int min_size) -{ - int idx = 0; - static int getinter = 0; - - if (!getinter) { - idx = MTestGetIntracomm(comm, min_size); - if (idx == 0) { - getinter = 1; - } - } - if (getinter) { - int isLeft; - idx = MTestGetIntercomm(comm, &isLeft, min_size); - if (idx == 0) { - getinter = 0; - } - } - - return idx; -} - -/* Free a communicator. It may be called with a predefined communicator - or MPI_COMM_NULL */ -void MTestFreeComm(MPI_Comm * comm) -{ - int merr; - if (*comm != MPI_COMM_WORLD && *comm != MPI_COMM_SELF && *comm != MPI_COMM_NULL) { - merr = MPI_Comm_free(comm); - if (merr) - MTestPrintError(merr); - } -} - -/* ------------------------------------------------------------------------ */ -void MTestPrintError(int errcode) -{ - int errclass, slen; - char string[MPI_MAX_ERROR_STRING]; - - MPI_Error_class(errcode, &errclass); - MPI_Error_string(errcode, string, &slen); - printf("Error class %d (%s)\n", errclass, string); - fflush(stdout); -} - -void MTestPrintErrorMsg(const char msg[], int errcode) -{ - int errclass, slen; - char string[MPI_MAX_ERROR_STRING]; - - MPI_Error_class(errcode, &errclass); - MPI_Error_string(errcode, string, &slen); - printf("%s: Error class %d (%s)\n", msg, errclass, string); - fflush(stdout); -} - -/* ------------------------------------------------------------------------ */ -/* - If verbose output is selected and the level is at least that of the - value of the verbose flag, then perform printf(format, ...); - */ -void MTestPrintfMsg(int level, const char format[], ...) -{ - va_list list; - - if (SMPI_VARGET_GLOBAL(verbose) && level <= SMPI_VARGET_GLOBAL(verbose)) { - va_start(list, format); - vprintf(format, list); - va_end(list); - fflush(stdout); - } -} - -/* Fatal error. Report and exit */ -void MTestError(const char *msg) -{ - fprintf(stderr, "%s\n", msg); - fflush(stderr); - MPI_Abort(MPI_COMM_WORLD, 1); -} - -/* ------------------------------------------------------------------------ */ -static void MTestResourceSummary(FILE * fp) -{ -#ifdef HAVE_GETRUSAGE - struct rusage ru; - static int pfThreshold = -2; - int doOutput = 1; - if (getrusage(RUSAGE_SELF, &ru) == 0) { - /* There is an option to generate output only when a resource - * exceeds a threshold. To date, only page faults supported. */ - if (pfThreshold == -2) { - char *p = getenv("MPITEST_RUSAGE_PF"); - pfThreshold = -1; - if (p) { - pfThreshold = strtol(p, 0, 0); - } - } - if (pfThreshold > 0) { - doOutput = ru.ru_minflt > pfThreshold; - } - if (doOutput) { - /* Cast values to long in case some system has defined them - * as another integer type */ - fprintf(fp, "RUSAGE: max resident set = %ldKB\n", (long) ru.ru_maxrss); - fprintf(fp, "RUSAGE: page faults = %ld : %ld\n", - (long) ru.ru_minflt, (long) ru.ru_majflt); - /* Not every Unix provides useful information for the xxrss fields */ - fprintf(fp, "RUSAGE: memory in text/data/stack = %ld : %ld : %ld\n", - (long) ru.ru_ixrss, (long) ru.ru_idrss, (long) ru.ru_isrss); - fprintf(fp, "RUSAGE: I/O in and out = %ld : %ld\n", - (long) ru.ru_inblock, (long) ru.ru_oublock); - fprintf(fp, "RUSAGE: context switch = %ld : %ld\n", - (long) ru.ru_nvcsw, (long) ru.ru_nivcsw); - } - } - else { - fprintf(fp, "RUSAGE: return error %d\n", errno); - } -#endif -} - -/* ------------------------------------------------------------------------ */ -#ifdef HAVE_MPI_WIN_CREATE -/* - * Create MPI Windows - */ -SMPI_VARINIT_GLOBAL_AND_SET(win_index, int, 0); -SMPI_VARINIT_GLOBAL(winName, const char *); -/* Use an attribute to remember the type of memory allocation (static, - malloc, or MPI_Alloc_mem) */ -SMPI_VARINIT_GLOBAL_AND_SET(mem_keyval, int, MPI_KEYVAL_INVALID); -int MTestGetWin(MPI_Win * win, int mustBePassive) -{ - static char actbuf[1024]; - static char *pasbuf; - char *buf; - int n, rank, merr; - MPI_Info info; - - if (SMPI_VARGET_GLOBAL(mem_keyval) == MPI_KEYVAL_INVALID) { - /* Create the keyval */ - merr = MPI_Win_create_keyval(MPI_WIN_NULL_COPY_FN, MPI_WIN_NULL_DELETE_FN, &SMPI_VARGET_GLOBAL(mem_keyval), 0); - if (merr) - MTestPrintError(merr); - - } - - switch (SMPI_VARGET_GLOBAL(win_index)) { - case 0: - /* Active target window */ - merr = MPI_Win_create(actbuf, 1024, 1, MPI_INFO_NULL, MPI_COMM_WORLD, win); - if (merr) - MTestPrintError(merr); - SMPI_VARGET_GLOBAL(winName) = "active-window"; - merr = MPI_Win_set_attr(*win, SMPI_VARGET_GLOBAL(mem_keyval), (void *) 0); - if (merr) - MTestPrintError(merr); - break; - case 1: - /* Passive target window */ - merr = MPI_Alloc_mem(1024, MPI_INFO_NULL, &pasbuf); - if (merr) - MTestPrintError(merr); - merr = MPI_Win_create(pasbuf, 1024, 1, MPI_INFO_NULL, MPI_COMM_WORLD, win); - if (merr) - MTestPrintError(merr); - SMPI_VARGET_GLOBAL(winName) = "passive-window"; - merr = MPI_Win_set_attr(*win, SMPI_VARGET_GLOBAL(mem_keyval), (void *) 2); - if (merr) - MTestPrintError(merr); - break; - case 2: - /* Active target; all windows different sizes */ - merr = MPI_Comm_rank(MPI_COMM_WORLD, &rank); - if (merr) - MTestPrintError(merr); - n = rank * 64; - if (n) - buf = (char *) malloc(n); - else - buf = 0; - merr = MPI_Win_create(buf, n, 1, MPI_INFO_NULL, MPI_COMM_WORLD, win); - if (merr) - MTestPrintError(merr); - SMPI_VARGET_GLOBAL(winName) = "active-all-different-win"; - merr = MPI_Win_set_attr(*win, SMPI_VARGET_GLOBAL(mem_keyval), (void *) 1); - if (merr) - MTestPrintError(merr); - break; - case 3: - /* Active target, no locks set */ - merr = MPI_Comm_rank(MPI_COMM_WORLD, &rank); - if (merr) - MTestPrintError(merr); - n = rank * 64; - if (n) - buf = (char *) malloc(n); - else - buf = 0; - merr = MPI_Info_create(&info); - if (merr) - MTestPrintError(merr); - merr = MPI_Info_set(info, (char *) "nolocks", (char *) "true"); - if (merr) - MTestPrintError(merr); - merr = MPI_Win_create(buf, n, 1, info, MPI_COMM_WORLD, win); - if (merr) - MTestPrintError(merr); - merr = MPI_Info_free(&info); - if (merr) - MTestPrintError(merr); - SMPI_VARGET_GLOBAL(winName) = "active-nolocks-all-different-win"; - merr = MPI_Win_set_attr(*win, SMPI_VARGET_GLOBAL(mem_keyval), (void *) 1); - if (merr) - MTestPrintError(merr); - break; - default: - SMPI_VARGET_GLOBAL(win_index) = -1; - } - SMPI_VARGET_GLOBAL(win_index)++; - return SMPI_VARGET_GLOBAL(win_index); -} - -/* Return a pointer to the name associated with a window object */ -const char *MTestGetWinName(void) -{ - return SMPI_VARGET_GLOBAL(winName); -} - -/* Free the storage associated with a window object */ -void MTestFreeWin(MPI_Win * win) -{ - void *addr; - int flag, merr; - - merr = MPI_Win_get_attr(*win, MPI_WIN_BASE, &addr, &flag); - if (merr) - MTestPrintError(merr); - if (!flag) { - MTestError("Could not get WIN_BASE from window"); - } - if (addr) { - void *val; - merr = MPI_Win_get_attr(*win, SMPI_VARGET_GLOBAL(mem_keyval), &val, &flag); - if (merr) - MTestPrintError(merr); - if (flag) { - if (val == (void *) 1) { - free(addr); - } - else if (val == (void *) 2) { - merr = MPI_Free_mem(addr); - if (merr) - MTestPrintError(merr); - } - /* if val == (void *)0, then static data that must not be freed */ - } - } - merr = MPI_Win_free(win); - if (merr) - MTestPrintError(merr); -} - -static void MTestRMACleanup(void) -{ - if (SMPI_VARGET_GLOBAL(mem_keyval) != MPI_KEYVAL_INVALID) { - MPI_Win_free_keyval(&SMPI_VARGET_GLOBAL(mem_keyval)); - } -} -#else -static void MTestRMACleanup(void) -{ -} -#endif - -/* ------------------------------------------------------------------------ */ -/* This function determines if it is possible to spawn addition MPI - * processes using MPI_COMM_SPAWN and MPI_COMM_SPAWN_MULTIPLE. - * - * It sets the can_spawn value to one of the following: - * 1 = yes, additional processes can be spawned - * 0 = no, MPI_UNIVERSE_SIZE <= the size of MPI_COMM_WORLD - * -1 = it is unknown whether or not processes can be spawned - * due to errors in the necessary query functions - * - */ -int MTestSpawnPossible(int *can_spawn) -{ - int errs = 0; - - void *v = NULL; - int flag = -1; - int vval = -1; - int rc; - - rc = MPI_Comm_get_attr(MPI_COMM_WORLD, MPI_UNIVERSE_SIZE, &v, &flag); - if (rc != MPI_SUCCESS) { - /* MPI_UNIVERSE_SIZE keyval missing from MPI_COMM_WORLD attributes */ - *can_spawn = -1; - errs++; - } - else { - /* MPI_UNIVERSE_SIZE need not be set */ - if (flag) { - - int size = -1; - rc = MPI_Comm_size(MPI_COMM_WORLD, &size); - if (rc != MPI_SUCCESS) { - /* MPI_Comm_size failed for MPI_COMM_WORLD */ - *can_spawn = -1; - errs++; - } - - vval = *(int *) v; - if (vval <= size) { - /* no additional processes can be spawned */ - *can_spawn = 0; - } - else { - *can_spawn = 1; - } - } - else { - /* No attribute associated with key MPI_UNIVERSE_SIZE of MPI_COMM_WORLD */ - *can_spawn = -1; - } - } - return errs; -} - -/* ------------------------------------------------------------------------ */ diff --git a/tools/cmake/DefinePackages.cmake b/tools/cmake/DefinePackages.cmake index 9fb63c2941..3e7a0a114b 100644 --- a/tools/cmake/DefinePackages.cmake +++ b/tools/cmake/DefinePackages.cmake @@ -215,7 +215,6 @@ set(SMPI_SRC src/smpi/internals/smpi_bench.cpp src/smpi/internals/smpi_memory.cpp src/smpi/internals/smpi_shared.cpp - src/smpi/internals/smpi_static_variables.cpp src/smpi/internals/smpi_deployment.cpp src/smpi/internals/smpi_dvfs.cpp src/smpi/internals/smpi_global.cpp