/* -*- 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 int count, size, rank; int errs; 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(count, sizeof(type)); \ out = (type *) calloc(count, sizeof(type)); \ sol = (type *) calloc(count, sizeof(type)); #define SET_INDEX_CONST(arr, val) \ { \ int i; \ for (i = 0; i < count; i++) \ arr[i] = val; \ } #define SET_INDEX_SUM(arr, val) \ { \ int i; \ for (i = 0; i < count; i++) \ arr[i] = i + val; \ } #define SET_INDEX_FACTOR(arr, val) \ { \ int i; \ for (i = 0; i < count; i++) \ arr[i] = i * (val); \ } #define SET_INDEX_POWER(arr, val) \ { \ int i, j; \ for (i = 0; i < 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", \ 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, count, mpi_type, mpi_op, MPI_COMM_WORLD); \ if (rc) { lerrcnt++; errs++; MTestPrintError(rc); } \ else { \ for (i = 0; i < count; i++) { \ if (out[i] != sol[i]) { \ errs++; \ 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, count, mpi_type, mpi_op, MPI_COMM_WORLD); \ if (rc) { lerrcnt++; errs++; MTestPrintError(rc); } \ else { \ for (i = 0; i < count; i++) { \ if ((out[i].a != sol[i].a) || (out[i].b != sol[i].b)) { \ errs++; \ lerrcnt++; \ } \ } \ } \ ERROR_CHECK_AND_FREE(lerrcnt, mpi_type, mpi_op); \ } #define SET_INDEX_STRUCT_CONST(arr, val, el) \ { \ int i; \ for (i = 0; i < count; i++) \ arr[i].el = val; \ } #define SET_INDEX_STRUCT_SUM(arr, val, el) \ { \ int i; \ for (i = 0; i < 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, 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, 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, rank); \ SET_INDEX_SUM(sol, 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, 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, (rank & 0x1), (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, (rank == 1), (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, (size & 0x1), 0) #define land_test1(type, mpi_type) \ const_test(type, mpi_type, MPI_LAND, (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, (rank & 0x3), ((size < 3) ? size - 1 : 0x3), 0) #define bxor_test1(type, mpi_type) \ const_test(type, mpi_type, MPI_BXOR, (rank == 1) * 0xf0, (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, (size &0x1) ? ~0 : 0, 0) #define band_test1(type, mpi_type) \ { \ DECL_MALLOC_IN_OUT_SOL(type); \ if (rank == 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 (rank == 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, rank, a); \ SET_INDEX_STRUCT_CONST(in, rank, b); \ SET_INDEX_STRUCT_SUM(sol, size - 1, a); \ SET_INDEX_STRUCT_CONST(sol, 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, rank, a); \ SET_INDEX_STRUCT_CONST(in, 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, &size); MPI_Comm_rank(MPI_COMM_WORLD, &rank); if (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); 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) { count = atoi(argv[1]); if (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(errs); return MTestReturnValue(errs); }