From: Augustin Degomme Date: Fri, 12 Jul 2013 17:09:37 +0000 (+0200) Subject: fix build and dist, add missing folder X-Git-Tag: v3_9_90~140 X-Git-Url: http://info.iut-bm.univ-fcomte.fr/pub/gitweb/simgrid.git/commitdiff_plain/8006a03b1ef66a0ddd4a4983ef170781a87a7225 fix build and dist, add missing folder --- diff --git a/teshsuite/smpi/mpich3-test/CMakeLists.txt b/teshsuite/smpi/mpich3-test/CMakeLists.txt index 97f032f167..91e3325725 100644 --- a/teshsuite/smpi/mpich3-test/CMakeLists.txt +++ b/teshsuite/smpi/mpich3-test/CMakeLists.txt @@ -35,7 +35,10 @@ endif() set(txt_files ${txt_files} ${CMAKE_CURRENT_SOURCE_DIR}/README - ${CMAKE_CURRENT_SOURCE_DIR}/runtest + ${CMAKE_CURRENT_SOURCE_DIR}/runtests ${CMAKE_CURRENT_SOURCE_DIR}/testlist - ${CMAKE_CURRENT_SOURCE_DIR}/checktest + ${CMAKE_CURRENT_SOURCE_DIR}/checktests + ${CMAKE_CURRENT_SOURCE_DIR}/util/mtest.c + ${CMAKE_CURRENT_SOURCE_DIR}/include/mpitestconf.h + ${CMAKE_CURRENT_SOURCE_DIR}/include/mpitest.h PARENT_SCOPE) diff --git a/teshsuite/smpi/mpich3-test/attr/CMakeLists.txt b/teshsuite/smpi/mpich3-test/attr/CMakeLists.txt index 3a17813a3f..d410c76e3d 100644 --- a/teshsuite/smpi/mpich3-test/attr/CMakeLists.txt +++ b/teshsuite/smpi/mpich3-test/attr/CMakeLists.txt @@ -107,7 +107,6 @@ set(bin_files ) set(txt_files ${txt_files} - ${CMAKE_CURRENT_SOURCE_DIR}/runtests ${CMAKE_CURRENT_SOURCE_DIR}/testlist PARENT_SCOPE ) diff --git a/teshsuite/smpi/mpich3-test/coll/CMakeLists.txt b/teshsuite/smpi/mpich3-test/coll/CMakeLists.txt index 4eb8ba2232..1d1965db02 100644 --- a/teshsuite/smpi/mpich3-test/coll/CMakeLists.txt +++ b/teshsuite/smpi/mpich3-test/coll/CMakeLists.txt @@ -397,7 +397,6 @@ set(bin_files ) set(txt_files ${txt_files} - ${CMAKE_CURRENT_SOURCE_DIR}/runtests ${CMAKE_CURRENT_SOURCE_DIR}/testlist PARENT_SCOPE ) diff --git a/teshsuite/smpi/mpich3-test/comm/CMakeLists.txt b/teshsuite/smpi/mpich3-test/comm/CMakeLists.txt index 784fcf1bb2..eef15ba139 100644 --- a/teshsuite/smpi/mpich3-test/comm/CMakeLists.txt +++ b/teshsuite/smpi/mpich3-test/comm/CMakeLists.txt @@ -14,7 +14,6 @@ if(enable_smpi) include_directories("${CMAKE_CURRENT_BINARY_DIR}/../include/") - add_executable(cmake_install cmake_install.cmake ../util/mtest.c) add_executable(cmfree cmfree.c ../util/mtest.c) add_executable(cmsplit2 cmsplit2.c ../util/mtest.c) add_executable(cmsplit cmsplit.c ../util/mtest.c) @@ -39,9 +38,6 @@ if(enable_smpi) add_executable(icsplit icsplit.c ../util/mtest.c) add_executable(probe-intercomm probe-intercomm.c ../util/mtest.c) - - - target_link_libraries(cmake_install simgrid) target_link_libraries(cmfree simgrid) target_link_libraries(cmsplit2 simgrid) target_link_libraries(cmsplit simgrid) @@ -66,9 +62,6 @@ if(enable_smpi) target_link_libraries(icsplit simgrid) target_link_libraries(probe-intercomm simgrid) - - - set_target_properties(cmake_install PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") set_target_properties(cmfree PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") set_target_properties(cmsplit2 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") set_target_properties(cmsplit PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") @@ -105,7 +98,6 @@ set(xml_files ) set(examples_src ${examples_src} - ${CMAKE_CURRENT_SOURCE_DIR}/cmake_install.cmake ${CMAKE_CURRENT_SOURCE_DIR}/cmfree.c ${CMAKE_CURRENT_SOURCE_DIR}/cmsplit2.c ${CMAKE_CURRENT_SOURCE_DIR}/cmsplit.c @@ -137,7 +129,6 @@ set(bin_files ) set(txt_files ${txt_files} - ${CMAKE_CURRENT_SOURCE_DIR}/runtests ${CMAKE_CURRENT_SOURCE_DIR}/testlist PARENT_SCOPE ) diff --git a/teshsuite/smpi/mpich3-test/datatype/CMakeLists.txt b/teshsuite/smpi/mpich3-test/datatype/CMakeLists.txt new file mode 100644 index 0000000000..f95df735de --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/CMakeLists.txt @@ -0,0 +1,266 @@ +cmake_minimum_required(VERSION 2.6) + +if(enable_smpi) + if(WIN32) + set(CMAKE_C_FLAGS "-include ${CMAKE_HOME_DIRECTORY}/include/smpi/smpi_main.h") + else() + set(CMAKE_C_COMPILER "${CMAKE_BINARY_DIR}/smpi_script/bin/smpicc") + set(CMAKE_Fortran_COMPILER "${CMAKE_BINARY_DIR}/smpi_script/bin/smpiff") + endif() + + set(EXECUTABLE_OUTPUT_PATH "${CMAKE_CURRENT_BINARY_DIR}") + set(MPICH_FLAGS "-DHAVE_STDLIB_H=1 -DHAVE_UNISTD_H=1 -DHAVE_STRING_H=1 -DUSE_STDARG=1 -DHAVE_LONG_DOUBLE=1 -DHAVE_PROTOTYPES=1 -DHAVE_SIGNAL_H=1 -DHAVE_SIGACTION=1 -DHAVE_SLEEP=1 -DHAVE_SYSCONF=1 -Wno-error=unused-variable") + include_directories("${CMAKE_HOME_DIRECTORY}/include/smpi") + include_directories("${CMAKE_CURRENT_BINARY_DIR}/../include/") + + + add_executable(blockindexed-misc blockindexed-misc.c ../util/mtest.c) + add_executable(blockindexed-zero-count blockindexed-zero-count.c ../util/mtest.c) + add_executable(contents contents.c ../util/mtest.c) + add_executable(contigstruct contigstruct.c ../util/mtest.c) + add_executable(contig-zero-count contig-zero-count.c ../util/mtest.c) + add_executable(cxx-types cxx-types.c ../util/mtest.c) + add_executable(darray-cyclic darray-cyclic.c ../util/mtest.c) + add_executable(darray-pack darray-pack.c ../util/mtest.c) + add_executable(gaddress gaddress.c ../util/mtest.c) + add_executable(get-elements get-elements.c ../util/mtest.c) + add_executable(get-elements-pairtype get-elements-pairtype.c ../util/mtest.c) + add_executable(getpartelm getpartelm.c ../util/mtest.c) + add_executable(hindexed_block hindexed_block.c ../util/mtest.c) + add_executable(hindexed_block_contents hindexed_block_contents.c ../util/mtest.c) + add_executable(hindexed-zeros hindexed-zeros.c ../util/mtest.c) + add_executable(indexed-misc indexed-misc.c ../util/mtest.c) + add_executable(large-count large-count.c ../util/mtest.c) + add_executable(lbub lbub.c ../util/mtest.c) + add_executable(localpack localpack.c ../util/mtest.c) + add_executable(longdouble longdouble.c ../util/mtest.c) + add_executable(lots-of-types lots-of-types.c ../util/mtest.c) + add_executable(pairtype-pack pairtype-pack.c ../util/mtest.c) + add_executable(pairtype-size-extent pairtype-size-extent.c ../util/mtest.c) + add_executable(simple-commit simple-commit.c ../util/mtest.c) + add_executable(simple-pack simple-pack.c ../util/mtest.c) + add_executable(simple-pack-external simple-pack-external.c ../util/mtest.c) + add_executable(simple-resized simple-resized.c ../util/mtest.c) + add_executable(simple-size-extent simple-size-extent.c ../util/mtest.c) + add_executable(sizedtypes sizedtypes.c ../util/mtest.c) + add_executable(slice-pack slice-pack.c ../util/mtest.c) + add_executable(slice-pack-external slice-pack-external.c ../util/mtest.c) + add_executable(struct-derived-zeros struct-derived-zeros.c ../util/mtest.c) + add_executable(struct-empty-el struct-empty-el.c ../util/mtest.c) + add_executable(struct-ezhov struct-ezhov.c ../util/mtest.c) + add_executable(struct-no-real-types struct-no-real-types.c ../util/mtest.c) + add_executable(struct-pack struct-pack.c ../util/mtest.c) + add_executable(struct-verydeep struct-verydeep.c ../util/mtest.c) + add_executable(struct-zero-count struct-zero-count.c ../util/mtest.c) + add_executable(subarray subarray.c ../util/mtest.c) + add_executable(subarray-pack subarray-pack.c ../util/mtest.c) + add_executable(tfree tfree.c ../util/mtest.c) + add_executable(tmatchsize tmatchsize.c ../util/mtest.c) + add_executable(transpose-pack transpose-pack.c ../util/mtest.c) + add_executable(tresized2 tresized2.c ../util/mtest.c) + add_executable(tresized tresized.c ../util/mtest.c) + add_executable(triangular-pack triangular-pack.c ../util/mtest.c) + add_executable(typecommit typecommit.c ../util/mtest.c) + add_executable(typefree typefree.c ../util/mtest.c) + add_executable(typelb typelb.c ../util/mtest.c) + add_executable(typename typename.c ../util/mtest.c) + add_executable(unpack unpack.c ../util/mtest.c) + add_executable(unusual-noncontigs unusual-noncontigs.c ../util/mtest.c) + add_executable(zero-blklen-vector zero-blklen-vector.c ../util/mtest.c) + add_executable(zeroblks zeroblks.c ../util/mtest.c) + add_executable(zeroparms zeroparms.c ../util/mtest.c) + + + + target_link_libraries(blockindexed-misc simgrid) + target_link_libraries(blockindexed-zero-count simgrid) + target_link_libraries(contents simgrid) + target_link_libraries(contigstruct simgrid) + target_link_libraries(contig-zero-count simgrid) + target_link_libraries(cxx-types simgrid) + target_link_libraries(darray-cyclic simgrid) + target_link_libraries(darray-pack simgrid) + target_link_libraries(gaddress simgrid) + target_link_libraries(get-elements simgrid) + target_link_libraries(get-elements-pairtype simgrid) + target_link_libraries(getpartelm simgrid) + target_link_libraries(hindexed_block simgrid) + target_link_libraries(hindexed_block_contents simgrid) + target_link_libraries(hindexed-zeros simgrid) + target_link_libraries(indexed-misc simgrid) + target_link_libraries(large-count simgrid) + target_link_libraries(lbub simgrid) + target_link_libraries(localpack simgrid) + target_link_libraries(longdouble simgrid) + target_link_libraries(lots-of-types simgrid) + target_link_libraries(pairtype-pack simgrid) + target_link_libraries(pairtype-size-extent simgrid) + target_link_libraries(simple-commit simgrid) + target_link_libraries(simple-pack simgrid) + target_link_libraries(simple-pack-external simgrid) + target_link_libraries(simple-resized simgrid) + target_link_libraries(simple-size-extent simgrid) + target_link_libraries(sizedtypes simgrid) + target_link_libraries(slice-pack simgrid) + target_link_libraries(slice-pack-external simgrid) + target_link_libraries(struct-derived-zeros simgrid) + target_link_libraries(struct-empty-el simgrid) + target_link_libraries(struct-ezhov simgrid) + target_link_libraries(struct-no-real-types simgrid) + target_link_libraries(struct-pack simgrid) + target_link_libraries(struct-verydeep simgrid) + target_link_libraries(struct-zero-count simgrid) + target_link_libraries(subarray simgrid) + target_link_libraries(subarray-pack simgrid) + target_link_libraries(tfree simgrid) + target_link_libraries(tmatchsize simgrid) + target_link_libraries(transpose-pack simgrid) + target_link_libraries(tresized2 simgrid) + target_link_libraries(tresized simgrid) + target_link_libraries(triangular-pack simgrid) + target_link_libraries(typecommit simgrid) + target_link_libraries(typefree simgrid) + target_link_libraries(typelb simgrid) + target_link_libraries(typename simgrid) + target_link_libraries(unpack simgrid) + target_link_libraries(unusual-noncontigs simgrid) + target_link_libraries(zero-blklen-vector simgrid) + target_link_libraries(zeroblks simgrid) + target_link_libraries(zeroparms simgrid) + + + + set_target_properties(blockindexed-misc PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(blockindexed-zero-count PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(contents PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(contigstruct PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(contig-zero-count PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(cxx-types PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(darray-cyclic PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(darray-pack PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(gaddress PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(get-elements PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(get-elements-pairtype PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(getpartelm PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(hindexed_block PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(hindexed_block_contents PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(hindexed-zeros PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(indexed-misc PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(large-count PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS} -Wno-error=implicit-function-declaration") + set_target_properties(lbub PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(localpack PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(longdouble PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(lots-of-types PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(pairtype-pack PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(pairtype-size-extent PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(simple-commit PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(simple-pack PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(simple-pack-external PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(simple-resized PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(simple-size-extent PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(sizedtypes PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(slice-pack PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(slice-pack-external PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(struct-derived-zeros PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(struct-empty-el PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(struct-ezhov PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(struct-no-real-types PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(struct-pack PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(struct-verydeep PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(struct-zero-count PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(subarray PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(subarray-pack PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(tfree PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(tmatchsize PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(transpose-pack PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(tresized2 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(tresized PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(triangular-pack PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(typecommit PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(typefree PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(typelb PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(typename PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(unpack PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(unusual-noncontigs PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(zero-blklen-vector PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(zeroblks PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(zeroparms PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + +endif() + +set(tesh_files + ${tesh_files} + PARENT_SCOPE + ) +set(xml_files + ${xml_files} + PARENT_SCOPE + ) +set(examples_src + ${examples_src} + ${CMAKE_CURRENT_SOURCE_DIR}/blockindexed-misc.c + ${CMAKE_CURRENT_SOURCE_DIR}/blockindexed-zero-count.c + ${CMAKE_CURRENT_SOURCE_DIR}/contents.c + ${CMAKE_CURRENT_SOURCE_DIR}/contigstruct.c + ${CMAKE_CURRENT_SOURCE_DIR}/contig-zero-count.c + ${CMAKE_CURRENT_SOURCE_DIR}/cxx-types.c + ${CMAKE_CURRENT_SOURCE_DIR}/darray-cyclic.c + ${CMAKE_CURRENT_SOURCE_DIR}/darray-pack.c + ${CMAKE_CURRENT_SOURCE_DIR}/gaddress.c + ${CMAKE_CURRENT_SOURCE_DIR}/get-elements.c + ${CMAKE_CURRENT_SOURCE_DIR}/get-elements-pairtype.c + ${CMAKE_CURRENT_SOURCE_DIR}/getpartelm.c + ${CMAKE_CURRENT_SOURCE_DIR}/hindexed_block.c + ${CMAKE_CURRENT_SOURCE_DIR}/hindexed_block_contents.c + ${CMAKE_CURRENT_SOURCE_DIR}/hindexed-zeros.c + ${CMAKE_CURRENT_SOURCE_DIR}/indexed-misc.c + ${CMAKE_CURRENT_SOURCE_DIR}/large-count.c + ${CMAKE_CURRENT_SOURCE_DIR}/lbub.c + ${CMAKE_CURRENT_SOURCE_DIR}/localpack.c + ${CMAKE_CURRENT_SOURCE_DIR}/longdouble.c + ${CMAKE_CURRENT_SOURCE_DIR}/lots-of-types.c + ${CMAKE_CURRENT_SOURCE_DIR}/pairtype-pack.c + ${CMAKE_CURRENT_SOURCE_DIR}/pairtype-size-extent.c + ${CMAKE_CURRENT_SOURCE_DIR}/simple-commit.c + ${CMAKE_CURRENT_SOURCE_DIR}/simple-pack.c + ${CMAKE_CURRENT_SOURCE_DIR}/simple-pack-external.c + ${CMAKE_CURRENT_SOURCE_DIR}/simple-resized.c + ${CMAKE_CURRENT_SOURCE_DIR}/simple-size-extent.c + ${CMAKE_CURRENT_SOURCE_DIR}/sizedtypes.c + ${CMAKE_CURRENT_SOURCE_DIR}/slice-pack.c + ${CMAKE_CURRENT_SOURCE_DIR}/slice-pack-external.c + ${CMAKE_CURRENT_SOURCE_DIR}/struct-derived-zeros.c + ${CMAKE_CURRENT_SOURCE_DIR}/struct-empty-el.c + ${CMAKE_CURRENT_SOURCE_DIR}/struct-ezhov.c + ${CMAKE_CURRENT_SOURCE_DIR}/struct-no-real-types.c + ${CMAKE_CURRENT_SOURCE_DIR}/struct-pack.c + ${CMAKE_CURRENT_SOURCE_DIR}/struct-verydeep.c + ${CMAKE_CURRENT_SOURCE_DIR}/struct-zero-count.c + ${CMAKE_CURRENT_SOURCE_DIR}/subarray.c + ${CMAKE_CURRENT_SOURCE_DIR}/subarray-pack.c + ${CMAKE_CURRENT_SOURCE_DIR}/tfree.c + ${CMAKE_CURRENT_SOURCE_DIR}/tmatchsize.c + ${CMAKE_CURRENT_SOURCE_DIR}/transpose-pack.c + ${CMAKE_CURRENT_SOURCE_DIR}/tresized2.c + ${CMAKE_CURRENT_SOURCE_DIR}/tresized.c + ${CMAKE_CURRENT_SOURCE_DIR}/triangular-pack.c + ${CMAKE_CURRENT_SOURCE_DIR}/typecommit.c + ${CMAKE_CURRENT_SOURCE_DIR}/typefree.c + ${CMAKE_CURRENT_SOURCE_DIR}/typelb.c + ${CMAKE_CURRENT_SOURCE_DIR}/typename.c + ${CMAKE_CURRENT_SOURCE_DIR}/unpack.c + ${CMAKE_CURRENT_SOURCE_DIR}/unusual-noncontigs.c + ${CMAKE_CURRENT_SOURCE_DIR}/zero-blklen-vector.c + ${CMAKE_CURRENT_SOURCE_DIR}/zeroblks.c + ${CMAKE_CURRENT_SOURCE_DIR}/zeroparms.c + PARENT_SCOPE + ) +set(bin_files + ${bin_files} + PARENT_SCOPE + ) +set(txt_files + ${txt_files} + ${CMAKE_CURRENT_SOURCE_DIR}/testlist + PARENT_SCOPE + ) diff --git a/teshsuite/smpi/mpich3-test/datatype/blockindexed-misc.c b/teshsuite/smpi/mpich3-test/datatype/blockindexed-misc.c new file mode 100644 index 0000000000..c3c59dcab1 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/blockindexed-misc.c @@ -0,0 +1,379 @@ +/* -*- 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 +#include +#include "mpitestconf.h" +#ifdef HAVE_STRING_H +#include +#endif + +static int verbose = 0; + +/* tests */ +int blockindexed_contig_test(void); +int blockindexed_vector_test(void); + +/* helper functions */ +int parse_args(int argc, char **argv); +static int pack_and_unpack(char *typebuf, + int count, + MPI_Datatype datatype, + int typebufsz); + +int main(int argc, char **argv) +{ + int err, errs = 0; + + MPI_Init(&argc, &argv); /* MPI-1.2 doesn't allow for MPI_Init(0,0) */ + parse_args(argc, argv); + + /* To improve reporting of problems about operations, we + change the error handler to errors return */ + MPI_Comm_set_errhandler( MPI_COMM_WORLD, MPI_ERRORS_RETURN ); + + /* perform some tests */ + err = blockindexed_contig_test(); + if (err && verbose) fprintf(stderr, "%d errors in blockindexed test.\n", + err); + errs += err; + + err = blockindexed_vector_test(); + if (err && verbose) fprintf(stderr, "%d errors in blockindexed vector test.\n", + err); + errs += err; + + /* print message and exit */ + if (errs) { + fprintf(stderr, "Found %d errors\n", errs); + } + else { + printf(" No Errors\n"); + } + MPI_Finalize(); + return 0; +} + +/* blockindexed_contig_test() + * + * Tests behavior with a blockindexed that can be converted to a + * contig easily. This is specifically for coverage. + * + * Returns the number of errors encountered. + */ +int blockindexed_contig_test(void) +{ + int buf[4] = {7, -1, -2, -3}; + int err, errs = 0; + + int i, count = 1; + int disp = 0; + MPI_Datatype newtype; + + int size, int_size; + MPI_Aint extent; + + err = MPI_Type_create_indexed_block(count, + 1, + &disp, + MPI_INT, + &newtype); + if (err != MPI_SUCCESS) { + if (verbose) { + fprintf(stderr, + "error creating struct type in blockindexed_contig_test()\n"); + } + errs++; + } + + MPI_Type_size(MPI_INT, &int_size); + + err = MPI_Type_size(newtype, &size); + if (err != MPI_SUCCESS) { + if (verbose) { + fprintf(stderr, + "error obtaining type size in blockindexed_contig_test()\n"); + } + errs++; + } + + if (size != int_size) { + if (verbose) { + fprintf(stderr, + "error: size != int_size in blockindexed_contig_test()\n"); + } + errs++; + } + + err = MPI_Type_extent(newtype, &extent); + if (err != MPI_SUCCESS) { + if (verbose) { + fprintf(stderr, + "error obtaining type extent in blockindexed_contig_test()\n"); + } + errs++; + } + + if (extent != int_size) { + if (verbose) { + fprintf(stderr, + "error: extent != int_size in blockindexed_contig_test()\n"); + } + errs++; + } + + MPI_Type_commit(&newtype); + + err = pack_and_unpack((char *) buf, 1, newtype, 4 * sizeof(int)); + if (err != 0) { + if (verbose) { + fprintf(stderr, + "error packing/unpacking in blockindexed_contig_test()\n"); + } + errs += err; + } + + for (i=0; i < 4; i++) { + int goodval; + + switch(i) { + case 0: + goodval = 7; + break; + default: + goodval = 0; /* pack_and_unpack() zeros before unpack */ + break; + } + if (buf[i] != goodval) { + errs++; + if (verbose) fprintf(stderr, "buf[%d] = %d; should be %d\n", + i, buf[i], goodval); + } + } + + MPI_Type_free( &newtype ); + + return errs; +} + +/* blockindexed_vector_test() + * + * Tests behavior with a blockindexed of some vector types; + * this shouldn't be easily convertable into anything else. + * + * Returns the number of errors encountered. + */ +int blockindexed_vector_test(void) +{ +#define NELT (18) + int buf[NELT] = { -1, -1, -1, + 1, -2, 2, + -3, -3, -3, + -4, -4, -4, + 3, -5, 4, + 5, -6, 6 }; + int expected[NELT] = { + 0, 0, 0, + 1, 0, 2, + 0, 0, 0, + 0, 0, 0, + 3, 0, 4, + 5, 0, 6 }; + int err, errs = 0; + + int i, count = 3; + int disp[] = {1, 4, 5}; + MPI_Datatype vectype, newtype; + + int size, int_size; + + /* create a vector type of 2 ints, skipping one in between */ + err = MPI_Type_vector(2, 1, 2, MPI_INT, &vectype); + if (err != MPI_SUCCESS) { + if (verbose) { + fprintf(stderr, + "error creating vector type in blockindexed_contig_test()\n"); + } + errs++; + } + + err = MPI_Type_create_indexed_block(count, + 1, + disp, + vectype, + &newtype); + if (err != MPI_SUCCESS) { + if (verbose) { + fprintf(stderr, + "error creating blockindexed type in blockindexed_contig_test()\n"); + } + errs++; + } + + MPI_Type_size(MPI_INT, &int_size); + + err = MPI_Type_size(newtype, &size); + if (err != MPI_SUCCESS) { + if (verbose) { + fprintf(stderr, + "error obtaining type size in blockindexed_contig_test()\n"); + } + errs++; + } + + if (size != 6 * int_size) { + if (verbose) { + fprintf(stderr, + "error: size != 6 * int_size in blockindexed_contig_test()\n"); + } + errs++; + } + + MPI_Type_commit(&newtype); + + err = pack_and_unpack((char *) buf, 1, newtype, NELT * sizeof(int)); + if (err != 0) { + if (verbose) { + fprintf(stderr, + "error packing/unpacking in blockindexed_vector_test()\n"); + } + errs += err; + } + + for (i=0; i < NELT; i++) { + if (buf[i] != expected[i]) { + errs++; + if (verbose) fprintf(stderr, "buf[%d] = %d; should be %d\n", + i, buf[i], expected[i]); + } + } + + MPI_Type_free( &vectype ); + MPI_Type_free( &newtype ); + return errs; +} + + +/* pack_and_unpack() + * + * Perform packing and unpacking of a buffer for the purposes of checking + * to see if we are processing a type correctly. Zeros the buffer between + * these two operations, so the data described by the type should be in + * place upon return but all other regions of the buffer should be zero. + * + * Parameters: + * typebuf - pointer to buffer described by datatype and count that + * will be packed and then unpacked into + * count, datatype - description of typebuf + * typebufsz - size of typebuf; used specifically to zero the buffer + * between the pack and unpack steps + * + */ +static int pack_and_unpack(char *typebuf, + int count, + MPI_Datatype datatype, + int typebufsz) +{ + char *packbuf; + int err, errs = 0, pack_size, type_size, position; + + err = MPI_Type_size(datatype, &type_size); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, + "error in MPI_Type_size call; aborting after %d errors\n", + errs); + } + return errs; + } + + type_size *= count; + + err = MPI_Pack_size(count, datatype, MPI_COMM_SELF, &pack_size); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, + "error in MPI_Pack_size call; aborting after %d errors\n", + errs); + } + return errs; + } + packbuf = (char *) malloc(pack_size); + if (packbuf == NULL) { + errs++; + if (verbose) { + fprintf(stderr, + "error in malloc call; aborting after %d errors\n", + errs); + } + return errs; + } + + position = 0; + err = MPI_Pack(typebuf, + count, + datatype, + packbuf, + type_size, + &position, + MPI_COMM_SELF); + + if (position != type_size) { + errs++; + if (verbose) fprintf(stderr, "position = %d; should be %d (pack)\n", + position, type_size); + } + + memset(typebuf, 0, typebufsz); + position = 0; + err = MPI_Unpack(packbuf, + type_size, + &position, + typebuf, + count, + datatype, + MPI_COMM_SELF); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, + "error in MPI_Unpack call; aborting after %d errors\n", + errs); + } + return errs; + } + free(packbuf); + + if (position != type_size) { + errs++; + if (verbose) fprintf(stderr, "position = %d; should be %d (unpack)\n", + position, type_size); + } + + return errs; +} + +int parse_args(int argc, char **argv) +{ + /* + int ret; + + while ((ret = getopt(argc, argv, "v")) >= 0) + { + switch (ret) { + case 'v': + verbose = 1; + break; + } + } + */ + if (argc > 1 && strcmp(argv[1], "-v") == 0) + verbose = 1; + return 0; +} + diff --git a/teshsuite/smpi/mpich3-test/datatype/blockindexed-zero-count.c b/teshsuite/smpi/mpich3-test/datatype/blockindexed-zero-count.c new file mode 100644 index 0000000000..f7d14b09ee --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/blockindexed-zero-count.c @@ -0,0 +1,137 @@ +/* -*- 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 +#include +#include "mpitestconf.h" +#ifdef HAVE_STRING_H +#include +#endif + +static int verbose = 0; + +/* tests */ +int blockindexed_test(void); + +/* helper functions */ +int parse_args(int argc, char **argv); + +int main(int argc, char **argv) +{ + int err, errs = 0; + + MPI_Init(&argc, &argv); /* MPI-1.2 doesn't allow for MPI_Init(0,0) */ + parse_args(argc, argv); + + /* To improve reporting of problems about operations, we + change the error handler to errors return */ + MPI_Comm_set_errhandler( MPI_COMM_WORLD, MPI_ERRORS_RETURN ); + + /* perform some tests */ + err = blockindexed_test(); + if (err && verbose) fprintf(stderr, "%d errors in blockindexed test.\n", + err); + errs += err; + + /* print message and exit */ + if (errs) { + fprintf(stderr, "Found %d errors\n", errs); + } + else { + printf(" No Errors\n"); + } + MPI_Finalize(); + return 0; +} + +/* blockindexed_test() + * + * Tests behavior with a zero-count blockindexed. + * + * Returns the number of errors encountered. + */ +int blockindexed_test(void) +{ + int err, errs = 0; + + int count = 0; + MPI_Datatype newtype; + + int size; + MPI_Aint extent; + + err = MPI_Type_create_indexed_block(count, + 0, + (int *) 0, + MPI_INT, + &newtype); + if (err != MPI_SUCCESS) { + if (verbose) { + fprintf(stderr, + "error creating struct type in blockindexed_test()\n"); + } + errs++; + } + + err = MPI_Type_size(newtype, &size); + if (err != MPI_SUCCESS) { + if (verbose) { + fprintf(stderr, + "error obtaining type size in blockindexed_test()\n"); + } + errs++; + } + + if (size != 0) { + if (verbose) { + fprintf(stderr, + "error: size != 0 in blockindexed_test()\n"); + } + errs++; + } + + err = MPI_Type_extent(newtype, &extent); + if (err != MPI_SUCCESS) { + if (verbose) { + fprintf(stderr, + "error obtaining type extent in blockindexed_test()\n"); + } + errs++; + } + + if (extent != 0) { + if (verbose) { + fprintf(stderr, + "error: extent != 0 in blockindexed_test()\n"); + } + errs++; + } + + MPI_Type_free( &newtype ); + + return errs; +} + + +int parse_args(int argc, char **argv) +{ + /* + int ret; + + while ((ret = getopt(argc, argv, "v")) >= 0) + { + switch (ret) { + case 'v': + verbose = 1; + break; + } + } + */ + if (argc > 1 && strcmp(argv[1], "-v") == 0) + verbose = 1; + return 0; +} + diff --git a/teshsuite/smpi/mpich3-test/datatype/contents.c b/teshsuite/smpi/mpich3-test/datatype/contents.c new file mode 100644 index 0000000000..fb513c30a8 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/contents.c @@ -0,0 +1,867 @@ +/* -*- 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" +#ifdef HAVE_UNISTD_H +#include +#endif +#include +#include + +static int verbose = 0; + +/* tests */ +int builtin_float_test(void); +int vector_of_vectors_test(void); +int optimizable_vector_of_basics_test(void); +int indexed_of_basics_test(void); +int indexed_of_vectors_test(void); +int struct_of_basics_test(void); + +/* helper functions */ +char *combiner_to_string(int combiner); +int parse_args(int argc, char **argv); + +int main(int argc, char **argv) +{ + int err, errs = 0; + + MPI_Init(&argc, &argv); /* MPI-1.2 doesn't allow for MPI_Init(0,0) */ + parse_args(argc, argv); + + /* To improve reporting of problems about operations, we + change the error handler to errors return */ + MPI_Comm_set_errhandler( MPI_COMM_WORLD, MPI_ERRORS_RETURN ); + + /* perform some tests */ + err = builtin_float_test(); + errs += err; + if (err) { + fprintf(stderr, "Found %d errors in builtin float test.\n", err); + } + + err = vector_of_vectors_test(); + errs += err; + if (err) { + fprintf(stderr, "Found %d errors in vector of vectors test.\n", err); + } + + err = optimizable_vector_of_basics_test(); + errs += err; + if (err) { + fprintf(stderr, "Found %d errors in vector of basics test.\n", err); + } + + err = indexed_of_basics_test(); + errs += err; + if (err) { + fprintf(stderr, "Found %d errors in indexed of basics test.\n", err); + } + + err = indexed_of_vectors_test(); + errs += err; + if (err) { + fprintf(stderr, "Found %d errors in indexed of vectors test.\n", err); + } + +#ifdef HAVE_MPI_TYPE_CREATE_STRUCT + err = struct_of_basics_test(); + errs += err; +#endif + + /* print message and exit */ + if (errs) { + fprintf(stderr, "Found %d errors\n", errs); + } + else { + printf(" No Errors\n"); + } + MPI_Finalize(); + return 0; +} + +/* builtin_float_test() + * + * Tests functionality of get_envelope() and get_contents() on a MPI_FLOAT. + * + * Returns the number of errors encountered. + */ +int builtin_float_test(void) +{ + int nints, nadds, ntypes, combiner; + + int err, errs = 0; + + err = MPI_Type_get_envelope(MPI_FLOAT, + &nints, + &nadds, + &ntypes, + &combiner); + + if (combiner != MPI_COMBINER_NAMED) errs++; + if (verbose && combiner != MPI_COMBINER_NAMED) + fprintf(stderr, "combiner = %s; should be named\n", + combiner_to_string(combiner)); + + /* Note: it is erroneous to call MPI_Type_get_contents() on a basic. */ + return errs; +} + +/* vector_of_vectors_test() + * + * Builds a vector of a vector of ints. Assuming an int array of size 9 + * integers, and treating the array as a 3x3 2D array, this will grab the + * corners. + * + * Returns the number of errors encountered. + */ +int vector_of_vectors_test(void) +{ + MPI_Datatype inner_vector, inner_vector_copy; + MPI_Datatype outer_vector; + + int nints, nadds, ntypes, combiner, *ints; + MPI_Aint *adds = NULL; + MPI_Datatype *types; + + int err, errs = 0; + + /* set up type */ + err = MPI_Type_vector(2, + 1, + 2, + MPI_INT, + &inner_vector); + if (err != MPI_SUCCESS) { + if (verbose) fprintf(stderr, + "error in MPI call; aborting after %d errors\n", + errs+1); + return errs+1; + } + + err = MPI_Type_vector(2, + 1, + 2, + inner_vector, + &outer_vector); + if (err != MPI_SUCCESS) { + if (verbose) fprintf(stderr, + "error in MPI call; aborting after %d errors\n", + errs+1); + return errs+1; + } + + /* decode outer vector (get envelope, then contents) */ + err = MPI_Type_get_envelope(outer_vector, + &nints, + &nadds, + &ntypes, + &combiner); + if (err != MPI_SUCCESS) { + if (verbose) fprintf(stderr, + "error in MPI call; aborting after %d errors\n", + errs+1); + return errs+1; + } + + if (nints != 3) errs++; + if (nadds != 0) errs++; + if (ntypes != 1) errs++; + if (combiner != MPI_COMBINER_VECTOR) errs++; + + if (verbose) { + if (nints != 3) fprintf(stderr, + "outer vector nints = %d; should be 3\n", + nints); + if (nadds != 0) fprintf(stderr, + "outer vector nadds = %d; should be 0\n", + nadds); + if (ntypes != 1) fprintf(stderr, + "outer vector ntypes = %d; should be 1\n", + ntypes); + if (combiner != MPI_COMBINER_VECTOR) + fprintf(stderr, "outer vector combiner = %s; should be vector\n", + combiner_to_string(combiner)); + } + if (errs) { + if (verbose) fprintf(stderr, "aborting after %d errors\n", errs); + return errs; + } + + ints = malloc(nints * sizeof(*ints)); + if (nadds) adds = malloc(nadds * sizeof(*adds)); + types = malloc(ntypes * sizeof(*types)); + + /* get contents of outer vector */ + err = MPI_Type_get_contents(outer_vector, + nints, + nadds, + ntypes, + ints, + adds, + types); + + if (ints[0] != 2) errs++; + if (ints[1] != 1) errs++; + if (ints[2] != 2) errs++; + + if (verbose) { + if (ints[0] != 2) fprintf(stderr, + "outer vector count = %d; should be 2\n", + ints[0]); + if (ints[1] != 1) fprintf(stderr, + "outer vector blocklength = %d; should be 1\n", + ints[1]); + if (ints[2] != 2) fprintf(stderr, "outer vector stride = %d; should be 2\n", + ints[2]); + } + if (errs) { + if (verbose) fprintf(stderr, "aborting after %d errors\n", errs); + return errs; + } + + inner_vector_copy = types[0]; + free(ints); + if (nadds) free(adds); + free(types); + + /* decode inner vector */ + err = MPI_Type_get_envelope(inner_vector_copy, + &nints, + &nadds, + &ntypes, + &combiner); + if (err != MPI_SUCCESS) { + if (verbose) fprintf(stderr, + "error in MPI call; aborting after %d errors\n", + errs+1); + return errs+1; + } + + if (nints != 3) errs++; + if (nadds != 0) errs++; + if (ntypes != 1) errs++; + if (combiner != MPI_COMBINER_VECTOR) errs++; + + if (verbose) { + if (nints != 3) fprintf(stderr, + "inner vector nints = %d; should be 3\n", + nints); + if (nadds != 0) fprintf(stderr, + "inner vector nadds = %d; should be 0\n", + nadds); + if (ntypes != 1) fprintf(stderr, + "inner vector ntypes = %d; should be 1\n", + ntypes); + if (combiner != MPI_COMBINER_VECTOR) + fprintf(stderr, "inner vector combiner = %s; should be vector\n", + combiner_to_string(combiner)); + } + if (errs) { + if (verbose) fprintf(stderr, "aborting after %d errors\n", errs); + return errs; + } + + ints = malloc(nints * sizeof(*ints)); + if (nadds) adds = malloc(nadds * sizeof(*adds)); + types = malloc(ntypes * sizeof(*types)); + + err = MPI_Type_get_contents(inner_vector_copy, + nints, + nadds, + ntypes, + ints, + adds, + types); + + if (ints[0] != 2) errs++; + if (ints[1] != 1) errs++; + if (ints[2] != 2) errs++; + + if (verbose) { + if (ints[0] != 2) fprintf(stderr, + "inner vector count = %d; should be 2\n", + ints[0]); + if (ints[1] != 1) fprintf(stderr, + "inner vector blocklength = %d; should be 1\n", + ints[1]); + if (ints[2] != 2) fprintf(stderr, + "inner vector stride = %d; should be 2\n", + ints[2]); + } + if (errs) { + if (verbose) fprintf(stderr, "aborting after %d errors\n", errs); + return errs; + } + + free(ints); + if (nadds) free(adds); + free(types); + + MPI_Type_free( &inner_vector_copy ); + MPI_Type_free( &inner_vector ); + MPI_Type_free( &outer_vector ); + + return 0; +} + +/* optimizable_vector_of_basics_test() + * + * Builds a vector of ints. Count is 10, blocksize is 2, stride is 2, so this + * is equivalent to a contig of 20. But remember...we should get back our + * suboptimal values under MPI-2. + * + * Returns the number of errors encountered. + */ +int optimizable_vector_of_basics_test(void) +{ + MPI_Datatype parent_type; + + int nints, nadds, ntypes, combiner, *ints; + MPI_Aint *adds = NULL; + MPI_Datatype *types; + + int err, errs = 0; + + /* set up type */ + err = MPI_Type_vector(10, + 2, + 2, + MPI_INT, + &parent_type); + + /* decode */ + err = MPI_Type_get_envelope(parent_type, + &nints, + &nadds, + &ntypes, + &combiner); + + if (nints != 3) errs++; + if (nadds != 0) errs++; + if (ntypes != 1) errs++; + if (combiner != MPI_COMBINER_VECTOR) errs++; + + if (verbose) { + if (nints != 3) fprintf(stderr, "nints = %d; should be 3\n", nints); + if (nadds != 0) fprintf(stderr, "nadds = %d; should be 0\n", nadds); + if (ntypes != 1) fprintf(stderr, "ntypes = %d; should be 1\n", ntypes); + if (combiner != MPI_COMBINER_VECTOR) + fprintf(stderr, "combiner = %s; should be vector\n", + combiner_to_string(combiner)); + } + + ints = malloc(nints * sizeof(*ints)); + if (nadds) adds = malloc(nadds * sizeof(*adds)); + types = malloc(ntypes *sizeof(*types)); + + err = MPI_Type_get_contents(parent_type, + nints, + nadds, + ntypes, + ints, + adds, + types); + + if (ints[0] != 10) errs++; + if (ints[1] != 2) errs++; + if (ints[2] != 2) errs++; + if (types[0] != MPI_INT) errs++; + + if (verbose) { + if (ints[0] != 10) fprintf(stderr, "count = %d; should be 10\n", + ints[0]); + if (ints[1] != 2) fprintf(stderr, "blocklength = %d; should be 2\n", + ints[1]); + if (ints[2] != 2) fprintf(stderr, "stride = %d; should be 2\n", + ints[2]); + if (types[0] != MPI_INT) fprintf(stderr, "type is not MPI_INT\n"); + } + + free(ints); + if (nadds) free(adds); + free(types); + + MPI_Type_free( &parent_type ); + + return errs; +} + + +/* indexed_of_basics_test(void) + * + * Simple indexed type. + * + * Returns number of errors encountered. + */ +int indexed_of_basics_test(void) +{ + MPI_Datatype parent_type; + int s_count = 3, s_blocklengths[3] = { 3, 2, 1 }; + int s_displacements[3] = { 10, 20, 30 }; + + int nints, nadds, ntypes, combiner, *ints; + MPI_Aint *adds = NULL; + MPI_Datatype *types; + + int err, errs = 0; + + /* set up type */ + err = MPI_Type_indexed(s_count, + s_blocklengths, + s_displacements, + MPI_INT, + &parent_type); + + /* decode */ + err = MPI_Type_get_envelope(parent_type, + &nints, + &nadds, + &ntypes, + &combiner); + + if (nints != 7) errs++; + if (nadds != 0) errs++; + if (ntypes != 1) errs++; + if (combiner != MPI_COMBINER_INDEXED) errs++; + + if (verbose) { + if (nints != 7) fprintf(stderr, "nints = %d; should be 7\n", nints); + if (nadds != 0) fprintf(stderr, "nadds = %d; should be 0\n", nadds); + if (ntypes != 1) fprintf(stderr, "ntypes = %d; should be 1\n", ntypes); + if (combiner != MPI_COMBINER_INDEXED) + fprintf(stderr, "combiner = %s; should be indexed\n", + combiner_to_string(combiner)); + } + + ints = malloc(nints * sizeof(*ints)); + if (nadds) adds = malloc(nadds * sizeof(*adds)); + types = malloc(ntypes *sizeof(*types)); + + err = MPI_Type_get_contents(parent_type, + nints, + nadds, + ntypes, + ints, + adds, + types); + + if (ints[0] != s_count) errs++; + if (ints[1] != s_blocklengths[0]) errs++; + if (ints[2] != s_blocklengths[1]) errs++; + if (ints[3] != s_blocklengths[2]) errs++; + if (ints[4] != s_displacements[0]) errs++; + if (ints[5] != s_displacements[1]) errs++; + if (ints[6] != s_displacements[2]) errs++; + if (types[0] != MPI_INT) errs++; + + if (verbose) { + if (ints[0] != s_count) + fprintf(stderr, "count = %d; should be %d\n", ints[0], s_count); + if (ints[1] != s_blocklengths[0]) + fprintf(stderr, "blocklength[0] = %d; should be %d\n", ints[1], s_blocklengths[0]); + if (ints[2] != s_blocklengths[1]) + fprintf(stderr, "blocklength[1] = %d; should be %d\n", ints[2], s_blocklengths[1]); + if (ints[3] != s_blocklengths[2]) + fprintf(stderr, "blocklength[2] = %d; should be %d\n", ints[3], s_blocklengths[2]); + if (ints[4] != s_displacements[0]) + fprintf(stderr, "displacement[0] = %d; should be %d\n", ints[4], s_displacements[0]); + if (ints[5] != s_displacements[1]) + fprintf(stderr, "displacement[1] = %d; should be %d\n", ints[5], s_displacements[1]); + if (ints[6] != s_displacements[2]) + fprintf(stderr, "displacement[2] = %d; should be %d\n", ints[6], s_displacements[2]); + if (types[0] != MPI_INT) fprintf(stderr, "type[0] does not match\n"); + } + + free(ints); + if (nadds) free(adds); + free(types); + + MPI_Type_free( &parent_type ); + return errs; +} + +/* indexed_of_vectors_test() + * + * Builds an indexed type of vectors of ints. + * + * Returns the number of errors encountered. + */ +int indexed_of_vectors_test(void) +{ + MPI_Datatype inner_vector, inner_vector_copy; + MPI_Datatype outer_indexed; + + int i_count = 3, i_blocklengths[3] = { 3, 2, 1 }; + int i_displacements[3] = { 10, 20, 30 }; + + int nints, nadds, ntypes, combiner, *ints; + MPI_Aint *adds = NULL; + MPI_Datatype *types; + + int err, errs = 0; + + /* set up type */ + err = MPI_Type_vector(2, + 1, + 2, + MPI_INT, + &inner_vector); + if (err != MPI_SUCCESS) { + if (verbose) fprintf(stderr, + "error in MPI call; aborting after %d errors\n", + errs+1); + return errs+1; + } + + err = MPI_Type_indexed(i_count, + i_blocklengths, + i_displacements, + inner_vector, + &outer_indexed); + if (err != MPI_SUCCESS) { + if (verbose) fprintf(stderr, + "error in MPI call; aborting after %d errors\n", + errs+1); + return errs+1; + } + + /* decode outer vector (get envelope, then contents) */ + err = MPI_Type_get_envelope(outer_indexed, + &nints, + &nadds, + &ntypes, + &combiner); + if (err != MPI_SUCCESS) { + if (verbose) fprintf(stderr, + "error in MPI call; aborting after %d errors\n", + errs+1); + return errs+1; + } + + if (nints != 7) errs++; + if (nadds != 0) errs++; + if (ntypes != 1) errs++; + if (combiner != MPI_COMBINER_INDEXED) errs++; + + if (verbose) { + if (nints != 7) fprintf(stderr, "nints = %d; should be 7\n", nints); + if (nadds != 0) fprintf(stderr, "nadds = %d; should be 0\n", nadds); + if (ntypes != 1) fprintf(stderr, "ntypes = %d; should be 1\n", ntypes); + if (combiner != MPI_COMBINER_INDEXED) + fprintf(stderr, "combiner = %s; should be indexed\n", + combiner_to_string(combiner)); + } + + if (errs) { + if (verbose) fprintf(stderr, "aborting after %d errors\n", errs); + return errs; + } + + ints = malloc(nints * sizeof(*ints)); + if (nadds) adds = malloc(nadds * sizeof(*adds)); + types = malloc(ntypes * sizeof(*types)); + + /* get contents of outer vector */ + err = MPI_Type_get_contents(outer_indexed, + nints, + nadds, + ntypes, + ints, + adds, + types); + + if (ints[0] != i_count) errs++; + if (ints[1] != i_blocklengths[0]) errs++; + if (ints[2] != i_blocklengths[1]) errs++; + if (ints[3] != i_blocklengths[2]) errs++; + if (ints[4] != i_displacements[0]) errs++; + if (ints[5] != i_displacements[1]) errs++; + if (ints[6] != i_displacements[2]) errs++; + + if (verbose) { + if (ints[0] != i_count) + fprintf(stderr, "count = %d; should be %d\n", ints[0], i_count); + if (ints[1] != i_blocklengths[0]) + fprintf(stderr, "blocklength[0] = %d; should be %d\n", ints[1], i_blocklengths[0]); + if (ints[2] != i_blocklengths[1]) + fprintf(stderr, "blocklength[1] = %d; should be %d\n", ints[2], i_blocklengths[1]); + if (ints[3] != i_blocklengths[2]) + fprintf(stderr, "blocklength[2] = %d; should be %d\n", ints[3], i_blocklengths[2]); + if (ints[4] != i_displacements[0]) + fprintf(stderr, "displacement[0] = %d; should be %d\n", ints[4], i_displacements[0]); + if (ints[5] != i_displacements[1]) + fprintf(stderr, "displacement[1] = %d; should be %d\n", ints[5], i_displacements[1]); + if (ints[6] != i_displacements[2]) + fprintf(stderr, "displacement[2] = %d; should be %d\n", ints[6], i_displacements[2]); + } + + if (errs) { + if (verbose) fprintf(stderr, "aborting after %d errors\n", errs); + return errs; + } + + inner_vector_copy = types[0]; + free(ints); + if (nadds) free(adds); + free(types); + + /* decode inner vector */ + err = MPI_Type_get_envelope(inner_vector_copy, + &nints, + &nadds, + &ntypes, + &combiner); + if (err != MPI_SUCCESS) { + if (verbose) fprintf(stderr, + "error in MPI call; aborting after %d errors\n", + errs+1); + return errs+1; + } + + if (nints != 3) errs++; + if (nadds != 0) errs++; + if (ntypes != 1) errs++; + if (combiner != MPI_COMBINER_VECTOR) errs++; + + if (verbose) { + if (nints != 3) fprintf(stderr, + "inner vector nints = %d; should be 3\n", + nints); + if (nadds != 0) fprintf(stderr, + "inner vector nadds = %d; should be 0\n", + nadds); + if (ntypes != 1) fprintf(stderr, + "inner vector ntypes = %d; should be 1\n", + ntypes); + if (combiner != MPI_COMBINER_VECTOR) + fprintf(stderr, "inner vector combiner = %s; should be vector\n", + combiner_to_string(combiner)); + } + if (errs) { + if (verbose) fprintf(stderr, "aborting after %d errors\n", errs); + return errs; + } + + ints = malloc(nints * sizeof(*ints)); + if (nadds) adds = malloc(nadds * sizeof(*adds)); + types = malloc(ntypes * sizeof(*types)); + + err = MPI_Type_get_contents(inner_vector_copy, + nints, + nadds, + ntypes, + ints, + adds, + types); + + if (ints[0] != 2) errs++; + if (ints[1] != 1) errs++; + if (ints[2] != 2) errs++; + + if (verbose) { + if (ints[0] != 2) fprintf(stderr, + "inner vector count = %d; should be 2\n", + ints[0]); + if (ints[1] != 1) fprintf(stderr, + "inner vector blocklength = %d; should be 1\n", + ints[1]); + if (ints[2] != 2) fprintf(stderr, + "inner vector stride = %d; should be 2\n", + ints[2]); + } + if (errs) { + if (verbose) fprintf(stderr, "aborting after %d errors\n", errs); + return errs; + } + + free(ints); + if (nadds) free(adds); + free(types); + + MPI_Type_free( &inner_vector_copy ); + MPI_Type_free( &inner_vector ); + MPI_Type_free( &outer_indexed ); + + return 0; +} + + +#ifdef HAVE_MPI_TYPE_CREATE_STRUCT +/* struct_of_basics_test(void) + * + * There's nothing simple about structs :). Although this is an easy one. + * + * Returns number of errors encountered. + * + * NOT TESTED. + */ +int struct_of_basics_test(void) +{ + MPI_Datatype parent_type; + int s_count = 3, s_blocklengths[3] = { 3, 2, 1 }; + MPI_Aint s_displacements[3] = { 10, 20, 30 }; + MPI_Datatype s_types[3] = { MPI_CHAR, MPI_INT, MPI_FLOAT }; + + int nints, nadds, ntypes, combiner, *ints; + MPI_Aint *adds = NULL; + MPI_Datatype *types; + + int err, errs = 0; + + /* set up type */ + err = MPI_Type_create_struct(s_count, + s_blocklengths, + s_displacements, + s_types, + &parent_type); + + /* decode */ + err = MPI_Type_get_envelope(parent_type, + &nints, + &nadds, + &ntypes, + &combiner); + + if (nints != 4) errs++; + if (nadds != 3) errs++; + if (ntypes != 3) errs++; + if (combiner != MPI_COMBINER_STRUCT) errs++; + + if (verbose) { + if (nints != 4) fprintf(stderr, "nints = %d; should be 3\n", nints); + if (nadds != 3) fprintf(stderr, "nadds = %d; should be 0\n", nadds); + if (ntypes != 3) fprintf(stderr, "ntypes = %d; should be 3\n", ntypes); + if (combiner != MPI_COMBINER_STRUCT) + fprintf(stderr, "combiner = %s; should be struct\n", + combiner_to_string(combiner)); + } + + ints = malloc(nints * sizeof(*ints)); + adds = malloc(nadds * sizeof(*adds)); + types = malloc(ntypes *sizeof(*types)); + + err = MPI_Type_get_contents(parent_type, + nints, + nadds, + ntypes, + ints, + adds, + types); + + if (ints[0] != s_count) errs++; + if (ints[1] != s_blocklengths[0]) errs++; + if (ints[2] != s_blocklengths[1]) errs++; + if (ints[3] != s_blocklengths[2]) errs++; + if (adds[0] != s_displacements[0]) errs++; + if (adds[1] != s_displacements[1]) errs++; + if (adds[2] != s_displacements[2]) errs++; + if (types[0] != s_types[0]) errs++; + if (types[1] != s_types[1]) errs++; + if (types[2] != s_types[2]) errs++; + + if (verbose) { + if (ints[0] != s_count) + fprintf(stderr, "count = %d; should be %d\n", ints[0], s_count); + if (ints[1] != s_blocklengths[0]) + fprintf(stderr, "blocklength[0] = %d; should be %d\n", ints[1], s_blocklengths[0]); + if (ints[2] != s_blocklengths[1]) + fprintf(stderr, "blocklength[1] = %d; should be %d\n", ints[2], s_blocklengths[1]); + if (ints[3] != s_blocklengths[2]) + fprintf(stderr, "blocklength[2] = %d; should be %d\n", ints[3], s_blocklengths[2]); + if (adds[0] != s_displacements[0]) + fprintf(stderr, "displacement[0] = %d; should be %d\n", adds[0], s_displacements[0]); + if (adds[1] != s_displacements[1]) + fprintf(stderr, "displacement[1] = %d; should be %d\n", adds[1], s_displacements[1]); + if (adds[2] != s_displacements[2]) + fprintf(stderr, "displacement[2] = %d; should be %d\n", adds[2], s_displacements[2]); + if (types[0] != s_types[0]) + fprintf(stderr, "type[0] does not match\n"); + if (types[1] != s_types[1]) + fprintf(stderr, "type[1] does not match\n"); + if (types[2] != s_types[2]) + fprintf(stderr, "type[2] does not match\n"); + } + + free(ints); + free(adds); + free(types); + + MPI_Type_free( &parent_type ); + + return errs; +} +#endif + +/* combiner_to_string(combiner) + * + * Converts a numeric combiner into a pointer to a string used for printing. + */ +char *combiner_to_string(int combiner) +{ + static char c_named[] = "named"; + static char c_contig[] = "contig"; + static char c_vector[] = "vector"; + static char c_hvector[] = "hvector"; + static char c_indexed[] = "indexed"; + static char c_hindexed[] = "hindexed"; + static char c_struct[] = "struct"; +#ifdef HAVE_MPI2_COMBINERS + static char c_dup[] = "dup"; + static char c_hvector_integer[] = "hvector_integer"; + static char c_hindexed_integer[] = "hindexed_integer"; + static char c_indexed_block[] = "indexed_block"; + static char c_struct_integer[] = "struct_integer"; + static char c_subarray[] = "subarray"; + static char c_darray[] = "darray"; + static char c_f90_real[] = "f90_real"; + static char c_f90_complex[] = "f90_complex"; + static char c_f90_integer[] = "f90_integer"; + static char c_resized[] = "resized"; +#endif + + if (combiner == MPI_COMBINER_NAMED) return c_named; + if (combiner == MPI_COMBINER_CONTIGUOUS) return c_contig; + if (combiner == MPI_COMBINER_VECTOR) return c_vector; + if (combiner == MPI_COMBINER_HVECTOR) return c_hvector; + if (combiner == MPI_COMBINER_INDEXED) return c_indexed; + if (combiner == MPI_COMBINER_HINDEXED) return c_hindexed; + if (combiner == MPI_COMBINER_STRUCT) return c_struct; +#ifdef HAVE_MPI2_COMBINERS + if (combiner == MPI_COMBINER_DUP) return c_dup; + if (combiner == MPI_COMBINER_HVECTOR_INTEGER) return c_hvector_integer; + if (combiner == MPI_COMBINER_HINDEXED_INTEGER) return c_hindexed_integer; + if (combiner == MPI_COMBINER_INDEXED_BLOCK) return c_indexed_block; + if (combiner == MPI_COMBINER_STRUCT_INTEGER) return c_struct_integer; + if (combiner == MPI_COMBINER_SUBARRAY) return c_subarray; + if (combiner == MPI_COMBINER_DARRAY) return c_darray; + if (combiner == MPI_COMBINER_F90_REAL) return c_f90_real; + if (combiner == MPI_COMBINER_F90_COMPLEX) return c_f90_complex; + if (combiner == MPI_COMBINER_F90_INTEGER) return c_f90_integer; + if (combiner == MPI_COMBINER_RESIZED) return c_resized; +#endif + + return NULL; +} + +int parse_args(int argc, char **argv) +{ +#ifdef HAVE_GET_OPT + int ret; + + while ((ret = getopt(argc, argv, "v")) >= 0) + { + switch (ret) { + case 'v': + verbose = 1; + break; + } + } +#else +#endif + return 0; +} + diff --git a/teshsuite/smpi/mpich3-test/datatype/contig-zero-count.c b/teshsuite/smpi/mpich3-test/datatype/contig-zero-count.c new file mode 100644 index 0000000000..623617372d --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/contig-zero-count.c @@ -0,0 +1,135 @@ +/* -*- 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 +#include +#include "mpitestconf.h" +#ifdef HAVE_STRING_H +#include +#endif + +static int verbose = 0; + +/* tests */ +int contig_test(void); + +/* helper functions */ +int parse_args(int argc, char **argv); + +int main(int argc, char **argv) +{ + int err, errs = 0; + + MPI_Init(&argc, &argv); /* MPI-1.2 doesn't allow for MPI_Init(0,0) */ + parse_args(argc, argv); + + /* To improve reporting of problems about operations, we + change the error handler to errors return */ + MPI_Comm_set_errhandler( MPI_COMM_WORLD, MPI_ERRORS_RETURN ); + + /* perform some tests */ + err = contig_test(); + if (err && verbose) fprintf(stderr, "%d errors in contig test.\n", + err); + errs += err; + + /* print message and exit */ + if (errs) { + fprintf(stderr, "Found %d errors\n", errs); + } + else { + printf(" No Errors\n"); + } + MPI_Finalize(); + return 0; +} + +/* contig_test() + * + * Tests behavior with a zero-count contig. + * + * Returns the number of errors encountered. + */ +int contig_test(void) +{ + int err, errs = 0; + + int count = 0; + MPI_Datatype newtype; + + int size; + MPI_Aint extent; + + err = MPI_Type_contiguous(count, + MPI_INT, + &newtype); + if (err != MPI_SUCCESS) { + if (verbose) { + fprintf(stderr, + "error creating type in contig_test()\n"); + } + errs++; + } + + err = MPI_Type_size(newtype, &size); + if (err != MPI_SUCCESS) { + if (verbose) { + fprintf(stderr, + "error obtaining type size in contig_test()\n"); + } + errs++; + } + + if (size != 0) { + if (verbose) { + fprintf(stderr, + "error: size != 0 in contig_test()\n"); + } + errs++; + } + + err = MPI_Type_extent(newtype, &extent); + if (err != MPI_SUCCESS) { + if (verbose) { + fprintf(stderr, + "error obtaining type extent in contig_test()\n"); + } + errs++; + } + + if (extent != 0) { + if (verbose) { + fprintf(stderr, + "error: extent != 0 in contig_test()\n"); + } + errs++; + } + + MPI_Type_free( &newtype ); + + return errs; +} + + +int parse_args(int argc, char **argv) +{ + /* + int ret; + + while ((ret = getopt(argc, argv, "v")) >= 0) + { + switch (ret) { + case 'v': + verbose = 1; + break; + } + } + */ + if (argc > 1 && strcmp(argv[1], "-v") == 0) + verbose = 1; + return 0; +} + diff --git a/teshsuite/smpi/mpich3-test/datatype/contigstruct.c b/teshsuite/smpi/mpich3-test/datatype/contigstruct.c new file mode 100644 index 0000000000..657c8e08b5 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/contigstruct.c @@ -0,0 +1,49 @@ +/* -*- 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 + +/* + * This test checks to see if we can create a simple datatype + * made from many contiguous copies of a single struct. The + * struct is built with monotone decreasing displacements to + * avoid any struct->contig optimizations. + */ + +int main( int argc, char **argv ) +{ + int blocklens[8], psize, i, rank; + MPI_Aint displs[8]; + MPI_Datatype oldtypes[8]; + MPI_Datatype ntype1, ntype2; + + MPI_Init( &argc, &argv ); + MPI_Comm_rank( MPI_COMM_WORLD, &rank ); + + for (i=0; i<8; i++) { + blocklens[i] = 1; + displs[i] = (7-i) * sizeof(long); + oldtypes[i] = MPI_LONG; + } + MPI_Type_struct( 8, blocklens, displs, oldtypes, &ntype1 ); + MPI_Type_contiguous( 65536, ntype1, &ntype2 ); + MPI_Type_commit( &ntype2 ); + + MPI_Pack_size( 2, ntype2, MPI_COMM_WORLD, &psize ); + + MPI_Type_free( &ntype2 ); + MPI_Type_free( &ntype1 ); + + /* The only failure mode has been SEGV or aborts within the datatype + routines */ + if (rank == 0) { + printf( " No Errors\n" ); + } + + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/datatype/cxx-types.c b/teshsuite/smpi/mpich3-test/datatype/cxx-types.c new file mode 100644 index 0000000000..a783e81757 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/cxx-types.c @@ -0,0 +1,66 @@ +/* -*- Mode: c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2012 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ + +/* This test checks for the existence of four new C++ named predefined datatypes + * that should be accessible from C (and Fortran, not tested here). */ + +#include +#include +#include +#include + +/* assert-like macro that bumps the err count and emits a message */ +#define check(x_) \ + do { \ + if (!(x_)) { \ + ++errs; \ + if (errs < 10) { \ + fprintf(stderr, "check failed: (%s), line %d\n", #x_, __LINE__); \ + } \ + } \ + } while (0) + +int main(int argc, char *argv[]) +{ + int errs = 0; + int wrank, wsize; + int size; + + MPI_Init(&argc, &argv); + MPI_Comm_rank(MPI_COMM_WORLD, &wrank); + MPI_Comm_size(MPI_COMM_WORLD, &wsize); + + /* perhaps the MPI library has no CXX support, in which case let's assume + * that these constants exist and were set to MPI_DATATYPE_NULL (standard + * MPICH behavior). */ +#define check_type(type_) \ + do { \ + size = -1; \ + if (type_ != MPI_DATATYPE_NULL) { \ + MPI_Type_size(type_, &size); \ + check(size > 0); \ + } \ + } while (0) + + check_type(MPI_CXX_BOOL); + check_type(MPI_CXX_FLOAT_COMPLEX); + check_type(MPI_CXX_DOUBLE_COMPLEX); + check_type(MPI_CXX_LONG_DOUBLE_COMPLEX); + + MPI_Reduce((wrank == 0 ? MPI_IN_PLACE : &errs), &errs, 1, MPI_INT, MPI_SUM, 0, MPI_COMM_WORLD); + if (wrank == 0) { + if (errs) { + printf("found %d errors\n", errs); + } + else { + printf(" No errors\n"); + } + } + + MPI_Finalize(); + + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/datatype/darray-cyclic.c b/teshsuite/smpi/mpich3-test/datatype/darray-cyclic.c new file mode 100644 index 0000000000..947ec3204e --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/darray-cyclic.c @@ -0,0 +1,252 @@ +/* -*- Mode: C; c-basic-offset:4 ; -*- */ +/* + * (C) 2012 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include "mpi.h" +#include +#include +#include "mpitest.h" + +int AllocateGrid( int nx, int ny, int **srcArray, int **destArray ); +int PackUnpack( MPI_Datatype, const int [], int[], int ); + +int main( int argc, char *argv[] ) +{ + int errs = 0; + int wrank, wsize; + int gsizes[3], distribs[3], dargs[3], psizes[3]; + int px, py, nx, ny, rx, ry, bx, by; + int *srcArray=NULL, *destArray=NULL; + int i, j, ii, jj, loc; + MPI_Datatype darraytype; + + MTest_Init( 0, 0 ); + MPI_Comm_rank( MPI_COMM_WORLD, &wrank ); + MPI_Comm_size( MPI_COMM_WORLD, &wsize ); + + /* Test 1: Simple, 1-D cyclic decomposition */ + if (AllocateGrid( 1, 3*wsize, &srcArray, &destArray ) ) { + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + + /* Simple cyclic with 1-dim global array */ + gsizes[0] = 3*wsize; + distribs[0] = MPI_DISTRIBUTE_CYCLIC; + dargs[0] = 1; + psizes[0] = wsize; + MPI_Type_create_darray( wsize, wrank, 1, + gsizes, distribs, dargs, psizes, + MPI_ORDER_C, MPI_INT, &darraytype ); + + /* Check the created datatype. Because cyclic, should represent + a strided type */ + if (PackUnpack( darraytype, srcArray, destArray, 3 )) { + fprintf( stderr, "Error in pack/unpack check\n" ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + /* Now, check for correct data */ + for (i=0; i<3; i++) { + if (destArray[i] != wrank + i * wsize) { + fprintf( stderr, "1D: %d: Expected %d but saw %d\n", + i, wrank + i * wsize, destArray[i] ); + errs++; + } + } + + free( destArray ); + free( srcArray ); + MPI_Type_free( &darraytype ); + + /* Test 2: Simple, 1-D cyclic decomposition, with block size=2 */ + if (AllocateGrid( 1, 4*wsize, &srcArray, &destArray ) ) { + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + + /* Simple cyclic with 1-dim global array */ + gsizes[0] = 4*wsize; + distribs[0] = MPI_DISTRIBUTE_CYCLIC; + dargs[0] = 2; + psizes[0] = wsize; + MPI_Type_create_darray( wsize, wrank, 1, + gsizes, distribs, dargs, psizes, + MPI_ORDER_C, MPI_INT, &darraytype ); + + /* Check the created datatype. Because cyclic, should represent + a strided type */ + if (PackUnpack( darraytype, srcArray, destArray, 4 )) { + fprintf( stderr, "Error in pack/unpack check\n" ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + loc = 0; + /* for each cyclic element */ + for (i=0; i<2; i++) { + /* For each element in block */ + for (j=0; j<2; j++) { + if (destArray[loc] != 2*wrank + i * 2*wsize + j) { + fprintf( stderr, "1D(2): %d: Expected %d but saw %d\n", + i, 2*wrank + i * 2*wsize+j, destArray[loc] ); + errs++; + } + loc++; + } + } + + free( destArray ); + free( srcArray ); + MPI_Type_free( &darraytype ); + + /* 2D: Create some 2-D decompositions */ + px = wsize/2; + py = 2; + rx = wrank % px; + ry = wrank / px; + + if (px * py != wsize) { + fprintf( stderr, "An even number of processes is required\n" ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + + /* Cyclic/Cyclic */ + if (AllocateGrid( 5*px, 7*py, &srcArray, &destArray )) { + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + + /* Simple cyclic/cyclic. Note in C order, the [1] index varies most + rapidly */ + gsizes[0] = ny = 7*py; + gsizes[1] = nx = 5*px; + distribs[0] = MPI_DISTRIBUTE_CYCLIC; + distribs[1] = MPI_DISTRIBUTE_CYCLIC; + dargs[0] = 1; + dargs[1] = 1; + psizes[0] = py; + psizes[1] = px; + MPI_Type_create_darray( wsize, wrank, 2, + gsizes, distribs, dargs, psizes, + MPI_ORDER_C, MPI_INT, &darraytype ); + + /* Check the created datatype. Because cyclic, should represent + a strided type */ + if (PackUnpack( darraytype, srcArray, destArray, 5*7 )) { + fprintf( stderr, "Error in pack/unpack check\n" ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + + loc = 0; + for (j=0; j<7; j++) { + for (i=0; i<5; i++) { + int expected = rx + ry * nx + i * px + j * nx * py; + if (destArray[loc] != expected) { + errs++; + fprintf( stderr, "2D(cc): [%d,%d] = %d, expected %d\n", + i, j, destArray[loc], expected ); + } + loc++; + } + } + + free( srcArray ); + free( destArray ); + MPI_Type_free( &darraytype ); + + /* Cyclic(2)/Cyclic(3) */ + if (AllocateGrid( 6*px, 4*py, &srcArray, &destArray )) { + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + + /* Block cyclic/cyclic. Note in C order, the [1] index varies most + rapidly */ + gsizes[0] = ny = 4*py; + gsizes[1] = nx = 6*px; + distribs[0] = MPI_DISTRIBUTE_CYCLIC; + distribs[1] = MPI_DISTRIBUTE_CYCLIC; + dargs[0] = by = 2; + dargs[1] = bx = 3; + psizes[0] = py; + psizes[1] = px; + MPI_Type_create_darray( wsize, wrank, 2, + gsizes, distribs, dargs, psizes, + MPI_ORDER_C, MPI_INT, &darraytype ); + + /* Check the created datatype. Because cyclic, should represent + a strided type */ + if (PackUnpack( darraytype, srcArray, destArray, 4*6 )) { + fprintf( stderr, "Error in pack/unpack check\n" ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + + loc = 0; + for (j=0; j<4/by; j++) { + for (jj=0; jj +#include +#include +#include "mpitest.h" + +/* + The default behavior of the test routines should be to briefly indicate + the cause of any errors - in this test, that means that verbose needs + to be set. Verbose should turn on output that is independent of error + levels. +*/ +static int verbose = 1; + +/* tests */ +int darray_2d_c_test1(void); +int darray_4d_c_test1(void); + +/* helper functions */ +static int parse_args(int argc, char **argv); +static int pack_and_unpack(char *typebuf, + int count, + MPI_Datatype datatype, + int typebufsz); + +int main(int argc, char **argv) +{ + int err, errs = 0; + + MTest_Init( &argc, &argv ); + parse_args(argc, argv); + + /* To improve reporting of problems about operations, we + change the error handler to errors return */ + MPI_Comm_set_errhandler( MPI_COMM_WORLD, MPI_ERRORS_RETURN ); + + /* perform some tests */ + err = darray_2d_c_test1(); + if (err && verbose) fprintf(stderr, + "%d errors in 2d darray c test 1.\n", err); + errs += err; + + err = darray_4d_c_test1(); + if (err && verbose) fprintf(stderr, + "%d errors in 4d darray c test 1.\n", err); + errs += err; + + /* print message and exit */ + /* Allow the use of more than one process - some MPI implementations + (including IBM's) check that the number of processes given to + Type_create_darray is no larger than MPI_COMM_WORLD */ + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} + +/* darray_2d_test1() + * + * Performs a sequence of tests building darrays with single-element + * blocks, running through all the various positions that the element might + * come from. + * + * Returns the number of errors encountered. + */ +int darray_2d_c_test1(void) +{ + MPI_Datatype darray; + int array[9]; /* initialized below */ + int array_size[2] = {3, 3}; + int array_distrib[2] = {MPI_DISTRIBUTE_BLOCK, MPI_DISTRIBUTE_BLOCK}; + int array_dargs[2] = {MPI_DISTRIBUTE_DFLT_DARG, MPI_DISTRIBUTE_DFLT_DARG}; + int array_psizes[2] = {3, 3}; + + int i, rank, err, errs = 0, sizeoftype; + + /* pretend we are each rank, one at a time */ + for (rank=0; rank < 9; rank++) { + /* set up buffer */ + for (i=0; i < 9; i++) { + array[i] = i; + } + + /* set up type */ + err = MPI_Type_create_darray(9, /* size */ + rank, + 2, /* dims */ + array_size, + array_distrib, + array_dargs, + array_psizes, + MPI_ORDER_C, + MPI_INT, + &darray); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, + "error in MPI_Type_create_darray call; aborting after %d errors\n", + errs); + } + MTestPrintError( err ); + return errs; + } + + MPI_Type_commit(&darray); + + MPI_Type_size(darray, &sizeoftype); + if (sizeoftype != sizeof(int)) { + errs++; + if (verbose) fprintf(stderr, "size of type = %d; should be %d\n", + sizeoftype, (int) sizeof(int)); + return errs; + } + + err = pack_and_unpack((char *) array, 1, darray, 9*sizeof(int)); + + for (i=0; i < 9; i++) { + + if ((i == rank) && (array[i] != rank)) { + errs++; + if (verbose) fprintf(stderr, "array[%d] = %d; should be %d\n", + i, array[i], rank); + } + else if ((i != rank) && (array[i] != 0)) { + errs++; + if (verbose) fprintf(stderr, "array[%d] = %d; should be %d\n", + i, array[i], 0); + } + } + MPI_Type_free(&darray); + } + + return errs; +} + +/* darray_4d_c_test1() + * + * Returns the number of errors encountered. + */ +int darray_4d_c_test1(void) +{ + MPI_Datatype darray; + int array[72]; + int array_size[4] = {6, 3, 2, 2}; + int array_distrib[4] = { MPI_DISTRIBUTE_BLOCK, + MPI_DISTRIBUTE_BLOCK, + MPI_DISTRIBUTE_NONE, + MPI_DISTRIBUTE_NONE }; + int array_dargs[4] = { MPI_DISTRIBUTE_DFLT_DARG, + MPI_DISTRIBUTE_DFLT_DARG, + MPI_DISTRIBUTE_DFLT_DARG, + MPI_DISTRIBUTE_DFLT_DARG }; + int array_psizes[4] = {6, 3, 1, 1}; + + int i, rank, err, errs = 0, sizeoftype; + + for (rank=0; rank < 18; rank++) { + /* set up array */ + for (i=0; i < 72; i++) { + array[i] = i; + } + + /* set up type */ + err = MPI_Type_create_darray(18, /* size */ + rank, + 4, /* dims */ + array_size, + array_distrib, + array_dargs, + array_psizes, + MPI_ORDER_C, + MPI_INT, + &darray); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, + "error in MPI_Type_create_darray call; aborting after %d errors\n", + errs); + } + MTestPrintError( err ); + return errs; + } + + MPI_Type_commit(&darray); + + /* verify the size of the type */ + MPI_Type_size(darray, &sizeoftype); + if (sizeoftype != 4*sizeof(int)) { + errs++; + if (verbose) fprintf(stderr, "size of type = %d; should be %d\n", + sizeoftype, (int) (4*sizeof(int))); + return errs; + } + + /* pack and unpack the type, zero'ing out all other values */ + err = pack_and_unpack((char *) array, 1, darray, 72*sizeof(int)); + + for (i=0; i < 4*rank; i++) { + if (array[i] != 0) { + errs++; + if (verbose) fprintf(stderr, "array[%d] = %d; should be %d\n", + i, array[i], 0); + } + } + + for (i=4*rank; i < 4*rank + 4; i++) { + if (array[i] != i) { + errs++; + if (verbose) fprintf(stderr, "array[%d] = %d; should be %d\n", + i, array[i], i); + } + } + for (i=4*rank+4; i < 72; i++) { + if (array[i] != 0) { + errs++; + if (verbose) fprintf(stderr, "array[%d] = %d; should be %d\n", + i, array[i], 0); + } + } + + MPI_Type_free(&darray); + } + return errs; +} + +/******************************************************************/ + +/* pack_and_unpack() + * + * Perform packing and unpacking of a buffer for the purposes of checking + * to see if we are processing a type correctly. Zeros the buffer between + * these two operations, so the data described by the type should be in + * place upon return but all other regions of the buffer should be zero. + * + * Parameters: + * typebuf - pointer to buffer described by datatype and count that + * will be packed and then unpacked into + * count, datatype - description of typebuf + * typebufsz - size of typebuf; used specifically to zero the buffer + * between the pack and unpack steps + * + */ +static int pack_and_unpack(char *typebuf, + int count, + MPI_Datatype datatype, + int typebufsz) +{ + char *packbuf; + int err, errs = 0, pack_size, type_size, position; + + err = MPI_Type_size(datatype, &type_size); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, + "error in MPI_Type_size call; aborting after %d errors\n", + errs); + } + MTestPrintError( err ); + return errs; + } + + type_size *= count; + + err = MPI_Pack_size(count, datatype, MPI_COMM_SELF, &pack_size); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, + "error in MPI_Pack_size call; aborting after %d errors\n", + errs); + } + MTestPrintError( err ); + return errs; + } + packbuf = (char *) malloc(pack_size); + if (packbuf == NULL) { + errs++; + if (verbose) { + fprintf(stderr, + "error in malloc call; aborting after %d errors\n", + errs); + } + return errs; + } + + /* FIXME: the pack size returned need not be the type_size - this will + only be true if the pack routine simply moves the bytes but does + no other transformations of the data */ + position = 0; + err = MPI_Pack(typebuf, + count, + datatype, + packbuf, + type_size, + &position, + MPI_COMM_SELF); + + if (position != type_size) { + errs++; + if (verbose) fprintf(stderr, "position = %d; should be %d (pack)\n", + position, type_size); + } + + memset(typebuf, 0, typebufsz); + position = 0; + err = MPI_Unpack(packbuf, + type_size, + &position, + typebuf, + count, + datatype, + MPI_COMM_SELF); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, + "error in MPI_Unpack call; aborting after %d errors\n", + errs); + } + MTestPrintError( err ); + return errs; + } + free(packbuf); + + if (position != type_size) { + errs++; + if (verbose) fprintf(stderr, "position = %d; should be %d (unpack)\n", + position, type_size); + } + + return errs; +} + +static int parse_args(int argc, char **argv) +{ + /* + int ret; + + while ((ret = getopt(argc, argv, "v")) >= 0) + { + switch (ret) { + case 'v': + verbose = 1; + break; + } + } + */ + if (argc > 1 && strcmp(argv[1], "-v") == 0) + verbose = 1; + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/datatype/gaddress.c b/teshsuite/smpi/mpich3-test/datatype/gaddress.c new file mode 100644 index 0000000000..dfd91fc86f --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/gaddress.c @@ -0,0 +1,34 @@ +/* -*- 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 +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = ""; +*/ + +int main( int argc, char *argv[] ) +{ + int errs = 0; + int buf[10]; + MPI_Aint a1, a2; + + MTest_Init( &argc, &argv ); + + MPI_Get_address( &buf[0], &a1 ); + MPI_Get_address( &buf[1], &a2 ); + + if ((int)(a2-a1) != sizeof(int)) { + errs++; + printf( "Get address of two address did not return values the correct distance apart\n" ); + } + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/datatype/get-elements-pairtype.c b/teshsuite/smpi/mpich3-test/datatype/get-elements-pairtype.c new file mode 100644 index 0000000000..56afdba2a2 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/get-elements-pairtype.c @@ -0,0 +1,106 @@ +/* -*- 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 +#include +#include + +static int verbose = 0; + +/* tests */ +int double_int_test(void); + +/* helper functions */ +int parse_args(int argc, char **argv); + +int main(int argc, char **argv) +{ + int err, errs = 0; + + MPI_Init(&argc, &argv); /* MPI-1.2 doesn't allow for MPI_Init(0,0) */ + parse_args(argc, argv); + + /* To improve reporting of problems about operations, we + change the error handler to errors return */ + MPI_Comm_set_errhandler( MPI_COMM_WORLD, MPI_ERRORS_RETURN ); + + /* perform some tests */ + err = double_int_test(); + if (err && verbose) fprintf(stderr, "%d errors in double_int test.\n", + err); + errs += err; + + /* print message and exit */ + if (errs) { + fprintf(stderr, "Found %d errors\n", errs); + } + else { + printf(" No Errors\n"); + } + MPI_Finalize(); + return 0; +} + +/* send a { double, int, double} tuple and receive as a pair of + * MPI_DOUBLE_INTs. this should (a) be valid, and (b) result in an + * element count of 3. + */ +int double_int_test(void) +{ + int err, errs = 0, count; + + struct { double a; int b; double c; } foo; + struct { double a; int b; double c; int d; } bar; + + int blks[3] = { 1, 1, 1 }; + MPI_Aint disps[3] = { 0, 0, 0 }; + MPI_Datatype types[3] = { MPI_DOUBLE, MPI_INT, MPI_DOUBLE }; + MPI_Datatype stype; + + MPI_Status recvstatus; + + /* fill in disps[1..2] with appropriate offset */ + disps[1] = (MPI_Aint) ((char *) &foo.b - (char *) &foo.a); + disps[2] = (MPI_Aint) ((char *) &foo.c - (char *) &foo.a); + + MPI_Type_create_struct(3, blks, disps, types, &stype); + MPI_Type_commit(&stype); + + err = MPI_Sendrecv(&foo, 1, stype, 0, 0, + &bar, 2, MPI_DOUBLE_INT, 0, 0, + MPI_COMM_SELF, &recvstatus); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, "MPI_Sendrecv returned error (%d)\n", + err); + return errs; + } + + err = MPI_Get_elements(&recvstatus, MPI_DOUBLE_INT, &count); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, "MPI_Get_elements returned error (%d)\n", + err); + } + + if (count != 3) { + errs++; + if (verbose) fprintf(stderr, + "MPI_Get_elements returned count of %d, should be 3\n", + count); + } + + MPI_Type_free( &stype ); + + return errs; +} + +int parse_args(int argc, char **argv) +{ + if (argc > 1 && strcmp(argv[1], "-v") == 0) + verbose = 1; + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/datatype/get-elements.c b/teshsuite/smpi/mpich3-test/datatype/get-elements.c new file mode 100644 index 0000000000..2809a3d34d --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/get-elements.c @@ -0,0 +1,89 @@ +/* -*- Mode: c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2011 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ + +#include "mpi.h" +#include +#include +#include + +/* Tests MPI_Get_elements with a contiguous datatype that triggered a bug in + * past versions of MPICH. See ticket #1467 for more info. */ + +struct test_struct { + char a; + short b; + int c; +}; + +int main(int argc, char **argv) +{ + int rank, count; + struct test_struct sendbuf, recvbuf; + int blens[3]; + MPI_Aint displs[3]; + MPI_Datatype types[3]; + MPI_Datatype struct_type, contig; + MPI_Status status; + + MPI_Init(&argc, &argv); + MPI_Comm_rank(MPI_COMM_WORLD, &rank); + + /* We use a contig of a struct in order to satisfy two properties: + * (A) a type that contains more than one element type (the struct portion) + * (B) a type that has an odd number of ints in its "type contents" (1 in + * this case) + * This triggers a specific bug in some versions of MPICH. */ + blens[0] = 1; + displs[0] = offsetof(struct test_struct, a); + types[0] = MPI_CHAR; + blens[1] = 1; + displs[1] = offsetof(struct test_struct, b); + types[1] = MPI_SHORT; + blens[2] = 1; + displs[2] = offsetof(struct test_struct, c); + types[2] = MPI_INT; + MPI_Type_create_struct(3, blens, displs, types, &struct_type); + MPI_Type_contiguous(1, struct_type, &contig); + MPI_Type_commit(&struct_type); + MPI_Type_commit(&contig); + + sendbuf.a = 20; + sendbuf.b = 30; + sendbuf.c = 40; + recvbuf.a = -1; + recvbuf.b = -1; + recvbuf.c = -1; + + /* send to ourself */ + MPI_Sendrecv(&sendbuf, 1, contig, 0, 0, + &recvbuf, 1, contig, 0, 0, + MPI_COMM_SELF, &status); + + /* sanity */ + assert(sendbuf.a == recvbuf.a); + assert(sendbuf.b == recvbuf.b); + assert(sendbuf.c == recvbuf.c); + + /* now check that MPI_Get_elements returns the correct answer and that the + * library doesn't explode in the process */ + count = 0xdeadbeef; + MPI_Get_elements(&status, contig, &count); + MPI_Type_free(&struct_type); + MPI_Type_free(&contig); + + if (count != 3) { + printf("unexpected value for count, expected 3, got %d\n", count); + } + else { + if (rank == 0) { + printf(" No Errors\n"); + } + } + + MPI_Finalize(); + return 0; +} + diff --git a/teshsuite/smpi/mpich3-test/datatype/getpartelm.c b/teshsuite/smpi/mpich3-test/datatype/getpartelm.c new file mode 100644 index 0000000000..49ba725b85 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/getpartelm.c @@ -0,0 +1,123 @@ +/* -*- 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 +#include "mpitest.h" + +/* +static char MTest_descrip[] = "Receive partial datatypes and check that\ +MPI_Getelements gives the correct version"; +*/ + +int main( int argc, char *argv[] ) +{ + int errs = 0; + MPI_Datatype outtype, oldtypes[2]; + MPI_Aint offsets[2]; + int blklens[2]; + MPI_Comm comm; + int size, rank, src, dest, tag; + + MTest_Init( &argc, &argv ); + + comm = MPI_COMM_WORLD; + + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + + if (size < 2) { + errs++; + printf( "This test requires at least 2 processes\n" ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + + src = 0; + dest = 1; + + if (rank == src) { + int buf[128], position, cnt; + /* sender */ + + /* Create a datatype and send it (multiple of sizeof(int)) */ + /* Create a send struct type */ + oldtypes[0] = MPI_INT; + oldtypes[1] = MPI_CHAR; + blklens[0] = 1; + blklens[1] = 4*sizeof(int); + offsets[0] = 0; + offsets[1] = sizeof(int); + MPI_Type_struct( 2, blklens, offsets, oldtypes, &outtype ); + MPI_Type_commit( &outtype ); + + buf[0] = 4*sizeof(int); + /* printf( "About to send to %d\n", dest ); */ + MPI_Send( buf, 1, outtype, dest, 0, comm ); + MPI_Type_free( &outtype ); + + /* Create a datatype and send it (not a multiple of sizeof(int)) */ + /* Create a send struct type */ + oldtypes[0] = MPI_INT; + oldtypes[1] = MPI_CHAR; + blklens[0] = 1; + blklens[1] = 4*sizeof(int)+1; + offsets[0] = 0; + offsets[1] = sizeof(int); + MPI_Type_struct( 2, blklens, offsets, oldtypes, &outtype ); + MPI_Type_commit( &outtype ); + + buf[0] = 4*sizeof(int) + 1; + MPI_Send( buf, 1, outtype, dest, 1, comm ); + MPI_Type_free( &outtype ); + + /* Pack data and send as packed */ + position = 0; + cnt = 7; + MPI_Pack( &cnt, 1, MPI_INT, + buf, 128*sizeof(int), &position, comm ); + MPI_Pack( (void*)"message", 7, MPI_CHAR, + buf, 128*sizeof(int), &position, comm ); + MPI_Send( buf, position, MPI_PACKED, dest, 2, comm ); + } + else if (rank == dest) { + MPI_Status status; + int buf[128], i, elms, count; + + /* Receiver */ + /* Create a receive struct type */ + oldtypes[0] = MPI_INT; + oldtypes[1] = MPI_CHAR; + blklens[0] = 1; + blklens[1] = 256; + offsets[0] = 0; + offsets[1] = sizeof(int); + MPI_Type_struct( 2, blklens, offsets, oldtypes, &outtype ); + MPI_Type_commit( &outtype ); + + for (i=0; i<3; i++) { + tag = i; + /* printf( "about to receive tag %d from %d\n", i, src ); */ + MPI_Recv( buf, 1, outtype, src, tag, comm, &status ); + MPI_Get_elements( &status, outtype, &elms ); + if (elms != buf[0] + 1) { + errs++; + printf( "For test %d, Get elements gave %d but should be %d\n", + i, elms, buf[0] + 1 ); + } + MPI_Get_count( &status, outtype, &count ); + if (count != MPI_UNDEFINED) { + errs++; + printf( "For partial send, Get_count did not return MPI_UNDEFINED\n" ); + } + } + MPI_Type_free( &outtype ); + } + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; + +} diff --git a/teshsuite/smpi/mpich3-test/datatype/hindexed-zeros.c b/teshsuite/smpi/mpich3-test/datatype/hindexed-zeros.c new file mode 100644 index 0000000000..4d4c39a233 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/hindexed-zeros.c @@ -0,0 +1,254 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2001 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include +#include +#include +#include +#include "mpi.h" + +static int verbose = 0; + +int main(int argc, char *argv[]); +int parse_args(int argc, char **argv); +int hindexed_zerotype_test(void); +int hindexed_sparsetype_test(void); + +struct test_struct_1 { + int a,b,c,d; +}; + +int main(int argc, char *argv[]) +{ + int err, errs = 0; + + /* Initialize MPI */ + MPI_Init(&argc, &argv); + parse_args(argc, argv); + + /* To improve reporting of problems about operations, we + change the error handler to errors return */ + MPI_Comm_set_errhandler( MPI_COMM_WORLD, MPI_ERRORS_RETURN ); + + err = hindexed_zerotype_test(); + if (verbose && err) fprintf(stderr, "error in hindexed_zerotype_test\n"); + errs += err; + + err = hindexed_sparsetype_test(); + if (verbose && err) fprintf(stderr, "error in hindexed_sparsetype_test\n"); + errs += err; + + /* print message and exit */ + if (errs) { + fprintf(stderr, "Found %d errors\n", errs); + } + else { + printf(" No Errors\n"); + } + MPI_Finalize(); + return 0; +} + +/* tests with an hindexed type with all zero length blocks */ +int hindexed_zerotype_test(void) +{ + int err, errs = 0; + int count, elements; + MPI_Datatype mytype; + MPI_Request request; + MPI_Status status; + + int blks[] = { 0, 0, 0 }; + MPI_Aint disps[] = { 0, 4, 16 }; + + err = MPI_Type_hindexed(3, blks, disps, MPI_INT, &mytype); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Type_hindexed returned error\n"); + } + } + + MPI_Type_commit(&mytype); + + err = MPI_Irecv(NULL, 2, mytype, 0, 0, MPI_COMM_SELF, &request); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Irecv returned error\n"); + } + } + + err = MPI_Send(NULL, 1, mytype, 0, 0, MPI_COMM_SELF); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Send returned error\n"); + } + } + + err = MPI_Wait(&request, &status); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Wait returned error\n"); + } + } + + /* verify count and elements */ + err = MPI_Get_count(&status, mytype, &count); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Get_count returned error\n"); + } + } + if (count != 0) { + errs++; + if (verbose) { + fprintf(stderr, "count = %d; should be 0\n", count); + } + } + + err = MPI_Get_elements(&status, mytype, &elements); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Get_elements returned error\n"); + } + } + if (elements != 0) { + errs++; + if (verbose) { + fprintf(stderr, "elements = %d; should be 0\n", elements); + } + } + + // MPI_Type_free(&mytype); + + return errs; +} + +/* tests a short receive into a sparse hindexed type with a zero + * length block in it. sort of eccentric, but we've got the basic + * stuff covered with other tests. + */ +int hindexed_sparsetype_test(void) +{ + int err, errs = 0; + int i, count, elements; + MPI_Datatype mytype; + MPI_Request request; + MPI_Status status; + + int sendbuf[6] = { 1, 2, 3, 4, 5, 6 }; + int recvbuf[16]; + int correct[16] = { 1, -2, 4, -4, 2, 3, 5, -8, -9, -10, 6, + -12, -13, -14, -15, -16 }; + + int blks[] = { 1, 0, 2, 1 }; + MPI_Aint disps[] = { 0, 1*sizeof(int), 4*sizeof(int), 2*sizeof(int) }; + + err = MPI_Type_hindexed(4, blks, disps, MPI_INT, &mytype); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Type_hindexed returned error\n"); + } + } + + MPI_Type_commit(&mytype); + + for (i=0; i < 16; i++) recvbuf[i] = -(i+1); + + err = MPI_Irecv(recvbuf, 2, mytype, 0, 0, MPI_COMM_SELF, &request); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Irecv returned error\n"); + } + } + + err = MPI_Send(sendbuf, 6, MPI_INT, 0, 0, MPI_COMM_SELF); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Send returned error\n"); + } + } + + err = MPI_Wait(&request, &status); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Wait returned error\n"); + } + } + + /* verify data */ + for (i=0; i < 16; i++) { + if (recvbuf[i] != correct[i]) { + errs++; + if (verbose) { + fprintf(stderr, "recvbuf[%d] = %d; should be %d\n", + i, recvbuf[i], correct[i]); + } + } + } + + /* verify count and elements */ + err = MPI_Get_count(&status, mytype, &count); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Get_count returned error\n"); + } + } + if (count != MPI_UNDEFINED) { + errs++; + if (verbose) { + fprintf(stderr, "count = %d; should be MPI_UNDEFINED (%d)\n", + count, MPI_UNDEFINED); + } + } + + err = MPI_Get_elements(&status, mytype, &elements); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Get_elements returned error\n"); + } + } + if (elements != 6) { + errs++; + if (verbose) { + fprintf(stderr, "elements = %d; should be 6\n", elements); + } + } + +// MPI_Type_free(&mytype); + + return errs; +} + + +int parse_args(int argc, char **argv) +{ + /* + int ret; + + while ((ret = getopt(argc, argv, "v")) >= 0) + { + switch (ret) { + case 'v': + verbose = 1; + break; + } + } + */ + if (argc > 1 && strcmp(argv[1], "-v") == 0) + verbose = 1; + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/datatype/hindexed_block.c b/teshsuite/smpi/mpich3-test/datatype/hindexed_block.c new file mode 100644 index 0000000000..da3fccdfbf --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/hindexed_block.c @@ -0,0 +1,347 @@ +/* -*- 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 +#include +#include "mpitestconf.h" +#ifdef HAVE_STRING_H +#include +#endif + +#if !defined(USE_STRICT_MPI) && defined(MPICH) +#define TEST_HINDEXED_BLOCK 1 +#endif + +static int verbose = 0; + +/* tests */ +int hindexed_block_contig_test(void); +int hindexed_block_vector_test(void); + +/* helper functions */ +int parse_args(int argc, char **argv); +static int pack_and_unpack(char *typebuf, int count, MPI_Datatype datatype, int typebufsz); + +int main(int argc, char **argv) +{ + int err, errs = 0; + int rank; + + MPI_Init(&argc, &argv); /* MPI-1.2 doesn't allow for MPI_Init(0,0) */ + MPI_Comm_rank(MPI_COMM_WORLD, &rank); +#if defined(TEST_HINDEXED_BLOCK) + parse_args(argc, argv); + + /* To improve reporting of problems about operations, we + * change the error handler to errors return */ + MPI_Comm_set_errhandler(MPI_COMM_WORLD, MPI_ERRORS_RETURN); + + /* perform some tests */ + err = hindexed_block_contig_test(); + if (err && verbose) + fprintf(stderr, "%d errors in hindexed_block test.\n", err); + errs += err; + + err = hindexed_block_vector_test(); + if (err && verbose) + fprintf(stderr, "%d errors in hindexed_block vector test.\n", err); + errs += err; +#endif /*defined(TEST_HINDEXED_BLOCK)*/ + + /* print message and exit */ + if (rank == 0) { + if (errs) { + fprintf(stderr, "Found %d errors\n", errs); + } + else { + printf(" No Errors\n"); + } + } + MPI_Finalize(); + return 0; +} + +#if defined(TEST_HINDEXED_BLOCK) + +/* hindexed_block_contig_test() + * + * Tests behavior with a hindexed_block that can be converted to a + * contig easily. This is specifically for coverage. + * + * Returns the number of errors encountered. + */ +int hindexed_block_contig_test(void) +{ + int buf[4] = { 7, -1, -2, -3 }; + int err, errs = 0; + + int i, count = 1; + MPI_Aint disp = 0; + MPI_Datatype newtype; + + int size, int_size; + MPI_Aint extent; + + err = MPI_Type_create_hindexed_block(count, 1, &disp, MPI_INT, &newtype); + if (err != MPI_SUCCESS) { + if (verbose) { + fprintf(stderr, "error creating struct type in hindexed_block_contig_test()\n"); + } + errs++; + } + + MPI_Type_size(MPI_INT, &int_size); + + err = MPI_Type_size(newtype, &size); + if (err != MPI_SUCCESS) { + if (verbose) { + fprintf(stderr, "error obtaining type size in hindexed_block_contig_test()\n"); + } + errs++; + } + + if (size != int_size) { + if (verbose) { + fprintf(stderr, "error: size != int_size in hindexed_block_contig_test()\n"); + } + errs++; + } + + err = MPI_Type_extent(newtype, &extent); + if (err != MPI_SUCCESS) { + if (verbose) { + fprintf(stderr, "error obtaining type extent in hindexed_block_contig_test()\n"); + } + errs++; + } + + if (extent != int_size) { + if (verbose) { + fprintf(stderr, "error: extent != int_size in hindexed_block_contig_test()\n"); + } + errs++; + } + + MPI_Type_commit(&newtype); + + err = pack_and_unpack((char *) buf, 1, newtype, 4 * sizeof(int)); + if (err != 0) { + if (verbose) { + fprintf(stderr, "error packing/unpacking in hindexed_block_contig_test()\n"); + } + errs += err; + } + + for (i = 0; i < 4; i++) { + int goodval; + + switch (i) { + case 0: + goodval = 7; + break; + default: + goodval = 0; /* pack_and_unpack() zeros before unpack */ + break; + } + if (buf[i] != goodval) { + errs++; + if (verbose) + fprintf(stderr, "buf[%d] = %d; should be %d\n", i, buf[i], goodval); + } + } + + MPI_Type_free(&newtype); + + return errs; +} + +/* hindexed_block_vector_test() + * + * Tests behavior with a hindexed_block of some vector types; + * this shouldn't be easily convertable into anything else. + * + * Returns the number of errors encountered. + */ +int hindexed_block_vector_test(void) +{ +#define NELT (18) + int buf[NELT] = { + -1, -1, -1, + 1, -2, 2, + -3, -3, -3, + -4, -4, -4, + 3, -5, 4, + 5, -6, 6 + }; + int expected[NELT] = { + 0, 0, 0, + 1, 0, 2, + 0, 0, 0, + 0, 0, 0, + 3, 0, 4, + 5, 0, 6 + }; + int err, errs = 0; + + int i, count = 3; + MPI_Aint disp[] = { 1, 4, 5 }; + MPI_Datatype vectype, newtype; + + int size, int_size; + MPI_Aint extent; + + /* create a vector type of 2 ints, skipping one in between */ + err = MPI_Type_vector(2, 1, 2, MPI_INT, &vectype); + if (err != MPI_SUCCESS) { + if (verbose) { + fprintf(stderr, "error creating vector type in hindexed_block_contig_test()\n"); + } + errs++; + } + + MPI_Type_commit(&vectype); + + MPI_Type_extent(vectype, &extent); + for (i = 0; i < count; i++) + disp[i] *= extent; + + err = MPI_Type_create_hindexed_block(count, 1, disp, vectype, &newtype); + if (err != MPI_SUCCESS) { + if (verbose) { + fprintf(stderr, + "error creating hindexed_block type in hindexed_block_contig_test()\n"); + } + errs++; + } + + MPI_Type_commit(&newtype); + + err = MPI_Type_size(newtype, &size); + if (err != MPI_SUCCESS) { + if (verbose) { + fprintf(stderr, "error obtaining type size in hindexed_block_contig_test()\n"); + } + errs++; + } + + MPI_Type_size(MPI_INT, &int_size); + + if (size != 6 * int_size) { + if (verbose) { + fprintf(stderr, "error: size != 6 * int_size in hindexed_block_contig_test()\n"); + } + errs++; + } + + MPI_Type_extent(newtype, &extent); + + err = pack_and_unpack((char *) buf, 1, newtype, NELT * sizeof(int)); + if (err != 0) { + if (verbose) { + fprintf(stderr, "error packing/unpacking in hindexed_block_vector_test()\n"); + } + errs += err; + } + + for (i = 0; i < NELT; i++) { + if (buf[i] != expected[i]) { + errs++; + if (verbose) + fprintf(stderr, "buf[%d] = %d; should be %d\n", i, buf[i], expected[i]); + } + } + + MPI_Type_free(&vectype); + MPI_Type_free(&newtype); + return errs; +} + + +/* pack_and_unpack() + * + * Perform packing and unpacking of a buffer for the purposes of checking + * to see if we are processing a type correctly. Zeros the buffer between + * these two operations, so the data described by the type should be in + * place upon return but all other regions of the buffer should be zero. + * + * Parameters: + * typebuf - pointer to buffer described by datatype and count that + * will be packed and then unpacked into + * count, datatype - description of typebuf + * typebufsz - size of typebuf; used specifically to zero the buffer + * between the pack and unpack steps + * + */ +static int pack_and_unpack(char *typebuf, int count, MPI_Datatype datatype, int typebufsz) +{ + char *packbuf; + int err, errs = 0, pack_size, type_size, position; + + err = MPI_Type_size(datatype, &type_size); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "error in MPI_Type_size call; aborting after %d errors\n", errs); + } + return errs; + } + + type_size *= count; + + err = MPI_Pack_size(count, datatype, MPI_COMM_SELF, &pack_size); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "error in MPI_Pack_size call; aborting after %d errors\n", errs); + } + return errs; + } + packbuf = (char *) malloc(pack_size); + if (packbuf == NULL) { + errs++; + if (verbose) { + fprintf(stderr, "error in malloc call; aborting after %d errors\n", errs); + } + return errs; + } + + position = 0; + err = MPI_Pack(typebuf, count, datatype, packbuf, type_size, &position, MPI_COMM_SELF); + + if (position != type_size) { + errs++; + if (verbose) + fprintf(stderr, "position = %d; should be %d (pack)\n", position, type_size); + } + + memset(typebuf, 0, typebufsz); + position = 0; + err = MPI_Unpack(packbuf, type_size, &position, typebuf, count, datatype, MPI_COMM_SELF); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "error in MPI_Unpack call; aborting after %d errors\n", errs); + } + return errs; + } + free(packbuf); + + if (position != type_size) { + errs++; + if (verbose) + fprintf(stderr, "position = %d; should be %d (unpack)\n", position, type_size); + } + + return errs; +} + +int parse_args(int argc, char **argv) +{ + if (argc > 1 && strcmp(argv[1], "-v") == 0) + verbose = 1; + return 0; +} +#endif /*defined(TEST_HINDEXED_BLOCK)*/ diff --git a/teshsuite/smpi/mpich3-test/datatype/hindexed_block_contents.c b/teshsuite/smpi/mpich3-test/datatype/hindexed_block_contents.c new file mode 100644 index 0000000000..e316c70d38 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/hindexed_block_contents.c @@ -0,0 +1,78 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2012 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ + +/* test based on a bug report from Lisandro Dalcin: + * http://lists.mcs.anl.gov/pipermail/mpich-dev/2012-October/000978.html */ + +#include +#include +#include +/* USE_STRICT_MPI may be defined in mpitestconf.h */ +#include "mpitestconf.h" + +/* assert-like macro that bumps the err count and emits a message */ +#define check(x_) \ + do { \ + if (!(x_)) { \ + ++errs; \ + if (errs < 10) { \ + fprintf(stderr, "check failed: (%s), line %d\n", #x_, __LINE__); \ + } \ + } \ + } while (0) + +int main(int argc, char **argv) +{ + int errs = 0; + int rank; + MPI_Datatype t; + int count = 4; + int blocklength = 2; + MPI_Aint displacements[] = {0, 8, 16, 24}; + + MPI_Init(&argc, &argv); + MPI_Comm_rank(MPI_COMM_WORLD, &rank); + + if (!rank) { + MPI_Type_create_hindexed_block(count, blocklength, + displacements, MPI_INT, + &t); + MPI_Type_commit(&t); + { + int ni, na, nd, combiner; + int i[1024]; + MPI_Aint a[1024]; + MPI_Datatype d[1024]; + int k; + MPI_Type_get_envelope(t, &ni, &na, &nd, &combiner); + MPI_Type_get_contents(t, ni, na, nd, i, a, d); + + check(ni == 2); + check(i[0] == 4); + check(i[1] == 2); + + check(na == 4); + for (k=0; k < na; k++) + check(a[k] == (k * 8)); + + check(nd == 1); + check(d[0] == MPI_INT); + } + + MPI_Type_free(&t); + } + + if (rank == 0) { + if (errs) { + printf("found %d errors\n", errs); + } + else { + printf(" No errors\n"); + } + } + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/datatype/indexed-misc.c b/teshsuite/smpi/mpich3-test/datatype/indexed-misc.c new file mode 100644 index 0000000000..bab12d04bc --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/indexed-misc.c @@ -0,0 +1,736 @@ +/* -*- 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 +#include +#include "mpitestconf.h" +#ifdef HAVE_STRING_H +#include +#endif +#include +#include + +static int verbose = 1; + +#define check(cond_) \ + do { \ + if (!(cond_)) { \ + if (verbose) { \ + fprintf(stderr, "condition '%s' does not hold, at line %d\n", #cond_, __LINE__); \ + } \ + errs += 1; \ + } \ + } while (0) + +#define check_err(err_, what_failed_) \ + do { \ + if (err_) { \ + if (verbose) { \ + fprintf(stderr, "error: %s, at line %d\n", (what_failed_), __LINE__); \ + } \ + errs += (err_); \ + } \ + } while (0) + +/* tests */ +int indexed_contig_test(void); +int indexed_zeroblock_first_test(void); +int indexed_zeroblock_middle_test(void); +int indexed_zeroblock_last_test(void); +int indexed_contig_leading_zero_test(void); +int indexed_same_lengths(void); + +/* helper functions */ +int parse_args(int argc, char **argv); +static int pack_and_unpack(char *typebuf, + int count, + MPI_Datatype datatype, + int typebufsz); + +int main(int argc, char **argv) +{ + int err, errs = 0; + + MPI_Init(&argc, &argv); /* MPI-1.2 doesn't allow for MPI_Init(0,0) */ + parse_args(argc, argv); + + /* To improve reporting of problems about operations, we + change the error handler to errors return */ + MPI_Comm_set_errhandler( MPI_COMM_WORLD, MPI_ERRORS_RETURN ); + + /* perform some tests */ + err = indexed_contig_test(); + if (err && verbose) fprintf(stderr, + "%d errors in indexed_contig_test.\n", + err); + errs += err; + + err = indexed_zeroblock_first_test(); + if (err && verbose) fprintf(stderr, + "%d errors in indexed_zeroblock_first_test.\n", + err); + errs += err; + + err = indexed_zeroblock_middle_test(); + if (err && verbose) fprintf(stderr, + "%d errors in indexed_zeroblock_middle_test.\n", + err); + errs += err; + + err = indexed_zeroblock_last_test(); + if (err && verbose) fprintf(stderr, + "%d errors in indexed_zeroblock_last_test.\n", + err); + errs += err; + + err = indexed_contig_leading_zero_test(); + if (err && verbose) fprintf(stderr, + "%d errors in indexed_contig_leading_zero_test.\n", + err); + errs += err; + + err = indexed_same_lengths(); + if (err && verbose) fprintf(stderr, + "%d errors in indexed_contig_leading_zero_test.\n", + err); + errs += err; + + /* print message and exit */ + if (errs) { + fprintf(stderr, "Found %d errors\n", errs); + } + else { + printf(" No Errors\n"); + } + MPI_Finalize(); + return 0; +} + +int indexed_zeroblock_first_test(void) +{ + int err, errs = 0; + + MPI_Datatype type; + int len[3] = { 0, 1, 1 }; + int disp[3] = { 0, 1, 4 }; + MPI_Aint lb, ub; + + err = MPI_Type_indexed(3, len, disp, MPI_INT, &type); + if (err != MPI_SUCCESS) { + if (verbose) { + fprintf(stderr, + "error creating indexed type in indexed_zeroblock_first_test()\n"); + } + errs += 1; + } + + MPI_Type_lb(type, &lb); + if (lb != sizeof(int)) { + if (verbose) { + fprintf(stderr, + "lb mismatch; is %d, should be %d\n", + (int) lb, (int) sizeof(int)); + } + errs++; + } + MPI_Type_ub(type, &ub); + if (ub != 5 * sizeof(int)) { + if (verbose) { + fprintf(stderr, + "ub mismatch; is %d, should be %d\n", + (int) ub, (int) (5 * sizeof(int))); + } + errs++; + } + + MPI_Type_free( &type ); + + return errs; +} + +int indexed_zeroblock_middle_test(void) +{ + int err, errs = 0; + + MPI_Datatype type; + int len[3] = { 1, 0, 1 }; + int disp[3] = { 1, 2, 4 }; + MPI_Aint lb, ub; + + err = MPI_Type_indexed(3, len, disp, MPI_INT, &type); + if (err != MPI_SUCCESS) { + if (verbose) { + fprintf(stderr, + "error creating indexed type in indexed_zeroblock_middle_test()\n"); + } + errs += 1; + } + + MPI_Type_lb(type, &lb); + if (lb != sizeof(int)) { + if (verbose) { + fprintf(stderr, + "lb mismatch; is %d, should be %d\n", + (int) lb, (int) sizeof(int)); + } + errs++; + } + MPI_Type_ub(type, &ub); + if (ub != 5 * sizeof(int)) { + if (verbose) { + fprintf(stderr, + "ub mismatch; is %d, should be %d\n", + (int) ub, (int) (5 * sizeof(int))); + } + errs++; + } + + MPI_Type_free( &type ); + + return errs; +} + +int indexed_zeroblock_last_test(void) +{ + int err, errs = 0; + + MPI_Datatype type; + int len[3] = { 1, 1, 0 }; + int disp[3] = { 1, 4, 8 }; + MPI_Aint lb, ub; + + err = MPI_Type_indexed(3, len, disp, MPI_INT, &type); + if (err != MPI_SUCCESS) { + if (verbose) { + fprintf(stderr, + "error creating indexed type in indexed_zeroblock_last_test()\n"); + } + errs += 1; + } + + MPI_Type_lb(type, &lb); + if (lb != sizeof(int)) { + if (verbose) { + fprintf(stderr, + "lb mismatch; is %d, should be %d\n", + (int) lb, (int) sizeof(int)); + } + errs++; + } + MPI_Type_ub(type, &ub); + if (ub != 5 * sizeof(int)) { + if (verbose) { + fprintf(stderr, + "ub mismatch; is %d, should be %d\n", + (int) ub, (int) (5 * sizeof(int))); + } + errs++; + } + + MPI_Type_free( &type ); + + return errs; +} + +/* indexed_contig_test() + * + * Tests behavior with an indexed array that can be compacted but should + * continue to be stored as an indexed type. Specifically for coverage. + * + * Returns the number of errors encountered. + */ +int indexed_contig_test(void) +{ + int buf[9] = {-1, 1, 2, 3, -2, 4, 5, -3, 6}; + int err, errs = 0; + + int i, count = 5; + int blklen[] = { 1, 2, 1, 1, 1 }; + int disp[] = { 1, 2, 5, 6, 8 }; + MPI_Datatype newtype; + + int size, int_size; + + err = MPI_Type_indexed(count, + blklen, + disp, + MPI_INT, + &newtype); + if (err != MPI_SUCCESS) { + if (verbose) { + fprintf(stderr, + "error creating indexed type in indexed_contig_test()\n"); + } + errs++; + } + + MPI_Type_size(MPI_INT, &int_size); + + err = MPI_Type_size(newtype, &size); + if (err != MPI_SUCCESS) { + if (verbose) { + fprintf(stderr, + "error obtaining type size in indexed_contig_test()\n"); + } + errs++; + } + + if (size != 6 * int_size) { + if (verbose) { + fprintf(stderr, + "error: size != 6 * int_size in indexed_contig_test()\n"); + } + errs++; + } + + MPI_Type_commit(&newtype); + + err = pack_and_unpack((char *) buf, 1, newtype, 9 * sizeof(int)); + if (err != 0) { + if (verbose) { + fprintf(stderr, + "error packing/unpacking in indexed_contig_test()\n"); + } + errs += err; + } + + for (i=0; i < 9; i++) { + int goodval; + + switch(i) { + case 1: + goodval = 1; + break; + case 2: + goodval = 2; + break; + case 3: + goodval = 3; + break; + case 5: + goodval = 4; + break; + case 6: + goodval = 5; + break; + case 8: + goodval = 6; + break; + default: + goodval = 0; /* pack_and_unpack() zeros before unpack */ + break; + } + if (buf[i] != goodval) { + errs++; + if (verbose) fprintf(stderr, "buf[%d] = %d; should be %d\n", + i, buf[i], goodval); + } + } + + MPI_Type_free( &newtype ); + + return errs; +} + +/* very similar to indexed_zeroblock_first_test, but only has a single contig in + * order to catch a particular optimization path in MPICH's + * Dataloop_create_indexed routine */ +int indexed_contig_leading_zero_test(void) +{ + int err, errs = 0; + + int i; + MPI_Datatype type = MPI_DATATYPE_NULL; + MPI_Datatype struct_type = MPI_DATATYPE_NULL; + MPI_Datatype types[2]; + int len[3] = { 0, 4, 0 }; + int disp[3] = { INT_MAX, 2, INT_MAX}; + MPI_Aint adisp[3]; + MPI_Aint lb, ub; + int *buf = NULL; + + err = MPI_Type_indexed(3, len, disp, MPI_INT, &type); + check_err(err, "creating indexed type in indexed_contig_leading_zero_test()"); + err = MPI_Type_commit(&type); + check_err(err, "committing indexed type in indexed_contig_leading_zero_test()"); + + MPI_Type_lb(type, &lb); + check(lb == 2 * sizeof(int)); + MPI_Type_ub(type, &ub); + check(ub == 6 * sizeof(int)); + + /* make sure packing/unpacking works (hits a simple "is_contig" case in + * MPICH's pack/unpack routines) */ + buf = malloc(10*sizeof(int)); + assert(buf != NULL); + for (i = 0; i < 10; ++i) { + buf[i] = i + 1; + } + err = pack_and_unpack((char *) buf, 1, type, 10 * sizeof(int)); + check_err(err, "packing/unpacking in indexed_contig_leading_zero_test()"); + for (i = 0; i < 10; ++i) { + int expected; + if (i >= 2 && i < 6) + expected = i + 1; + else + expected = 0; + check(buf[i] == expected); + } + free(buf); + + /* -------------------------------------------------------------------- */ + /* A more rigorous test of the indexed type. Use a hard-to-optimize struct + * type to force a more complicated datatype processing path + * (MPID_Segment_manipulate in MPICH) */ + len[0] = 1; + len[1] = 1; + adisp[0] = 0; + adisp[1] = 8*sizeof(int); + types[0] = type; + types[1] = MPI_INT; + + /* struct layout: xx0123xx4x ('x' indicates a hole), one char is an + * MPI_INT */ + MPI_Type_create_struct(2, len, adisp, types, &struct_type); + check_err(err, "creating struct type in indexed_contig_leading_zero_test()"); + err = MPI_Type_commit(&struct_type); + check_err(err, "committing struct type in indexed_contig_leading_zero_test()"); + + buf = malloc(10*sizeof(int)); + assert(buf != NULL); + for (i = 0; i < 10; ++i) { + buf[i] = i + 1; + } + err = pack_and_unpack((char *) buf, 1, struct_type, 10 * sizeof(int)); + check_err(err, "packing/unpacking in indexed_contig_test()"); + + for (i = 0; i < 10; ++i) { + int expected; + if ((i >= 2 && i < 6) || i == 8) + expected = i + 1; + else + expected = 0; + check(buf[i] == expected); + } + free(buf); + + MPI_Type_free(&struct_type); + MPI_Type_free( &type ); + + /* -------------------------------------------------------------------- */ + /* now do the same as above, but with hindexed */ + len[0] = 0; + len[1] = 4; + len[2] = 0; + /* use *_MAX vars to improve our chances of hitting any pointer-casting + * bugs in a big way (segfaults, etc.) */ + /* FIXME: This should also look at long, or use a different approach */ +#if defined(HAVE_LONG_LONG) && defined(LLONG_MAX) + if (sizeof(MPI_Aint) == sizeof(long long)) { + adisp[0] = (MPI_Aint)LLONG_MAX; + adisp[1] = 2*sizeof(int); + adisp[2] = (MPI_Aint)LLONG_MAX; + } + else +#endif + { + adisp[0] = (MPI_Aint)INT_MAX; + adisp[1] = 2*sizeof(int); + adisp[2] = (MPI_Aint)INT_MAX; + } + + err = MPI_Type_hindexed(3, len, adisp, MPI_INT, &type); + check_err(err, "creating hindexed type in indexed_contig_leading_zero_test()"); + + err = MPI_Type_commit(&type); + check_err(err, "committing hindexed type in indexed_contig_leading_zero_test()"); + + MPI_Type_lb(type, &lb); + check(lb == 2 * sizeof(int)); + MPI_Type_ub(type, &ub); + check(ub == 6 * sizeof(int)); + + buf = malloc(10*sizeof(int)); + assert(buf != NULL); + for (i = 0; i < 10; ++i) { + buf[i] = i + 1; + } + err = pack_and_unpack((char *) buf, 1, type, 10 * sizeof(int)); + check_err(err, "packing/unpacking in indexed_contig_test()"); + + for (i = 0; i < 10; ++i) { + int expected; + if (i >= 2 && i < 6) + expected = i + 1; + else + expected = 0; + check(buf[i] == expected); + } + free(buf); + + + /* -------------------------------------------------------------------- */ + /* A more rigorous test of the hindexed type. Use a hard-to-optimize struct + * type to force a more complicated datatype processing path + * (MPID_Segment_manipulate in MPICH) */ + len[0] = 1; + len[1] = 1; + adisp[0] = 0; + adisp[1] = 8*sizeof(int); + + /* struct layout: xx0123xx4x ('x' indicates a hole), one char is an + * MPI_INT */ + err = MPI_Type_create_struct(2, len, adisp, types, &struct_type); + check_err(err, "committing struct type in indexed_contig_leading_zero_test()"); + err = MPI_Type_commit(&struct_type); + check_err(err, "committing struct type in indexed_contig_leading_zero_test()"); + + buf = malloc(10*sizeof(int)); + assert(buf != NULL); + for (i = 0; i < 10; ++i) { + buf[i] = i + 1; + } + /* fails in old MPICH (3.0rc1 and earlier), despite correct ub/lb + * determination */ + err = pack_and_unpack((char *) buf, 1, struct_type, 10 * sizeof(int)); + check_err(err, "packing/unpacking in indexed_contig_test()"); + + for (i = 0; i < 10; ++i) { + int expected; + if ((i >= 2 && i < 6) || i == 8) + expected = i + 1; + else + expected = 0; + check(buf[i] == expected); + } + free(buf); + + MPI_Type_free(&struct_type); + MPI_Type_free(&type); + + return errs; +} + +/* Test an indexed (and hindexed) type where the block length is the same for + * all blocks, but with differing displacements so that it cannot directly be + * converted to a vector type. It is also important to add a dummy element at + * the beginning in order to cause int/MPI_Aint misalignment for the + * displacement of the first non-zero-width component. */ +int indexed_same_lengths(void) +{ + int err, errs = 0; + + int i; + MPI_Datatype type = MPI_DATATYPE_NULL; + int len[4]; + int disp[4]; + MPI_Aint adisp[4]; + MPI_Aint lb, ub; + int *buf = NULL; + + len[0] = 0; + len[1] = 1; + len[2] = 1; + len[3] = 1; + + disp[0] = 0; + disp[1] = 1; + disp[2] = 3; + disp[3] = 8; + + err = MPI_Type_indexed(4, len, disp, MPI_INT, &type); + check_err(err, "creating indexed type in indexed_same_lengths()"); + err = MPI_Type_commit(&type); + check_err(err, "committing indexed type in indexed_same_lengths()"); + + MPI_Type_lb(type, &lb); + check(lb == 1 * sizeof(int)); + MPI_Type_ub(type, &ub); + check(ub == 9 * sizeof(int)); + + buf = malloc(10*sizeof(int)); + assert(buf != NULL); + for (i = 0; i < 10; ++i) { + buf[i] = i + 1; + } + err = pack_and_unpack((char *) buf, 1, type, 10 * sizeof(int)); + check_err(err, "packing/unpacking in indexed_same_lengths()"); + for (i = 0; i < 10; ++i) { + int expected; + if (i == 1 || i == 3 || i == 8) + expected = i + 1; + else + expected = 0; + check(buf[i] == expected); + } + free(buf); + + MPI_Type_free(&type); + + /* -------------------------------------------------------------------- */ + /* now do the same as above, but with hindexed */ + len[0] = 0; + len[1] = 1; + len[2] = 1; + len[3] = 1; + + adisp[0] = 0 * sizeof(int); + adisp[1] = 1 * sizeof(int); + adisp[2] = 3 * sizeof(int); + adisp[3] = 8 * sizeof(int); + + err = MPI_Type_hindexed(4, len, adisp, MPI_INT, &type); + check_err(err, "creating hindexed type in indexed_same_lengths()"); + err = MPI_Type_commit(&type); + check_err(err, "committing hindexed type in indexed_same_lengths()"); + + MPI_Type_lb(type, &lb); + check(lb == 1 * sizeof(int)); + MPI_Type_ub(type, &ub); + check(ub == 9 * sizeof(int)); + + buf = malloc(10*sizeof(int)); + assert(buf != NULL); + for (i = 0; i < 10; ++i) { + buf[i] = i + 1; + } + err = pack_and_unpack((char *) buf, 1, type, 10 * sizeof(int)); + check_err(err, "packing/unpacking in indexed_same_lengths()"); + for (i = 0; i < 10; ++i) { + int expected; + if (i == 1 || i == 3 || i == 8) + expected = i + 1; + else + expected = 0; + check(buf[i] == expected); + } + free(buf); + + MPI_Type_free(&type); + + return errs; +} + +/* pack_and_unpack() + * + * Perform packing and unpacking of a buffer for the purposes of checking + * to see if we are processing a type correctly. Zeros the buffer between + * these two operations, so the data described by the type should be in + * place upon return but all other regions of the buffer should be zero. + * + * Parameters: + * typebuf - pointer to buffer described by datatype and count that + * will be packed and then unpacked into + * count, datatype - description of typebuf + * typebufsz - size of typebuf; used specifically to zero the buffer + * between the pack and unpack steps + * + */ +static int pack_and_unpack(char *typebuf, + int count, + MPI_Datatype datatype, + int typebufsz) +{ + char *packbuf; + int err, errs = 0, pack_size, type_size, position; + + err = MPI_Type_size(datatype, &type_size); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, + "error in MPI_Type_size call; aborting after %d errors\n", + errs); + } + return errs; + } + + type_size *= count; + + err = MPI_Pack_size(count, datatype, MPI_COMM_SELF, &pack_size); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, + "error in MPI_Pack_size call; aborting after %d errors\n", + errs); + } + return errs; + } + packbuf = (char *) malloc(pack_size); + if (packbuf == NULL) { + errs++; + if (verbose) { + fprintf(stderr, + "error in malloc call; aborting after %d errors\n", + errs); + } + return errs; + } + + position = 0; + err = MPI_Pack(typebuf, + count, + datatype, + packbuf, + type_size, + &position, + MPI_COMM_SELF); + + if (position != type_size) { + errs++; + if (verbose) fprintf(stderr, "position = %d; should be %d (pack)\n", + position, type_size); + } + + memset(typebuf, 0, typebufsz); + position = 0; + err = MPI_Unpack(packbuf, + type_size, + &position, + typebuf, + count, + datatype, + MPI_COMM_SELF); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, + "error in MPI_Unpack call; aborting after %d errors\n", + errs); + } + return errs; + } + free(packbuf); + + if (position != type_size) { + errs++; + if (verbose) fprintf(stderr, "position = %d; should be %d (unpack)\n", + position, type_size); + } + + return errs; +} + +int parse_args(int argc, char **argv) +{ + /* + int ret; + + while ((ret = getopt(argc, argv, "v")) >= 0) + { + switch (ret) { + case 'v': + verbose = 1; + break; + } + } + */ + if (argc > 1 && strcmp(argv[1], "-v") == 0) + verbose = 1; + return 0; +} + diff --git a/teshsuite/smpi/mpich3-test/datatype/large-count.c b/teshsuite/smpi/mpich3-test/datatype/large-count.c new file mode 100644 index 0000000000..a272f4fdc1 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/large-count.c @@ -0,0 +1,246 @@ +/* -*- Mode: c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2012 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ + +/* This test checks for large count functionality ("MPI_Count") mandated by + * MPI-3, as well as behavior of corresponding pre-MPI-3 interfaces that now + * have better defined behavior when an "int" quantity would overflow. */ + +#include +#include +#include +#include + +/* assert-like macro that bumps the err count and emits a message */ +#define check(x_) \ + do { \ + if (!(x_)) { \ + ++errs; \ + if (errs < 10) { \ + fprintf(stderr, "check failed: (%s), line %d\n", #x_, __LINE__); \ + } \ + } \ + } while (0) + +int main(int argc, char *argv[]) +{ + int errs = 0; + int wrank, wsize; + int size, elements, count; + MPI_Aint lb, extent; + MPI_Count size_x, lb_x, extent_x, elements_x; + double imx4i_true_extent; + MPI_Datatype imax_contig = MPI_DATATYPE_NULL; + MPI_Datatype four_ints = MPI_DATATYPE_NULL; + MPI_Datatype imx4i = MPI_DATATYPE_NULL; + MPI_Datatype imx4i_rsz = MPI_DATATYPE_NULL; + MPI_Status status; + + MPI_Init(&argc, &argv); + MPI_Comm_rank(MPI_COMM_WORLD, &wrank); + MPI_Comm_size(MPI_COMM_WORLD, &wsize); + + check(sizeof(MPI_Count) >= sizeof(int)); + check(sizeof(MPI_Count) >= sizeof(MPI_Aint)); + check(sizeof(MPI_Count) >= sizeof(MPI_Offset)); + + /* the following two checks aren't explicitly required by the standard, but + * it's hard to imagine a world without them holding true and so most of the + * subsequent code probably depends on them to some degree */ + check(sizeof(MPI_Aint) >= sizeof(int)); + check(sizeof(MPI_Offset) >= sizeof(int)); + + /* not much point in checking for integer overflow cases if MPI_Count is + * only as large as an int */ + if (sizeof(MPI_Count) == sizeof(int)) + goto epilogue; + + /* a very large type */ + MPI_Type_contiguous(INT_MAX, MPI_CHAR, &imax_contig); + MPI_Type_commit(&imax_contig); + + /* a small-ish contig */ + MPI_Type_contiguous(4, MPI_INT, &four_ints); + MPI_Type_commit(&four_ints); + + /* a type with size>INT_MAX */ + MPI_Type_vector(INT_MAX/2, 1, 3, four_ints, &imx4i); + MPI_Type_commit(&imx4i); + /* don't forget, ub for dtype w/ stride doesn't include any holes at the end + * of the type, hence the more complicated calculation below */ + imx4i_true_extent = 3LL*4LL*sizeof(int)*((INT_MAX/2)-1) + 4LL*sizeof(int); + + /* sanity check that the MPI_COUNT predefined named datatype exists */ + MPI_Send(&imx4i_true_extent, 1, MPI_COUNT, MPI_PROC_NULL, 0, MPI_COMM_SELF); + + /* the same oversized type but with goofy extents */ + MPI_Type_create_resized(imx4i, /*lb=*/INT_MAX, /*extent=*/-1024, &imx4i_rsz); + MPI_Type_commit(&imx4i_rsz); + + /* MPI_Type_size */ + MPI_Type_size(imax_contig, &size); + check(size == INT_MAX); + MPI_Type_size(four_ints, &size); + check(size == 4*sizeof(int)); + MPI_Type_size(imx4i, &size); + check(size == MPI_UNDEFINED); /* should overflow an int */ + MPI_Type_size(imx4i_rsz, &size); + check(size == MPI_UNDEFINED); /* should overflow an int */ + + /* MPI_Type_size_x */ + MPI_Type_size_x(imax_contig, &size_x); + check(size_x == INT_MAX); + MPI_Type_size_x(four_ints, &size_x); + check(size_x == 4*sizeof(int)); + MPI_Type_size_x(imx4i, &size_x); + check(size_x == 4LL*sizeof(int)*(INT_MAX/2)); /* should overflow an int */ + MPI_Type_size_x(imx4i_rsz, &size_x); + check(size_x == 4LL*sizeof(int)*(INT_MAX/2)); /* should overflow an int */ + + /* MPI_Type_get_extent */ + MPI_Type_get_extent(imax_contig, &lb, &extent); + check(lb == 0); + check(extent == INT_MAX); + MPI_Type_get_extent(four_ints, &lb, &extent); + check(lb == 0); + check(extent == 4*sizeof(int)); + MPI_Type_get_extent(imx4i, &lb, &extent); + check(lb == 0); + if (sizeof(MPI_Aint) == sizeof(int)) + check(extent == MPI_UNDEFINED); + else + check(extent == imx4i_true_extent); + + MPI_Type_get_extent(imx4i_rsz, &lb, &extent); + check(lb == INT_MAX); + check(extent == -1024); + + /* MPI_Type_get_extent_x */ + MPI_Type_get_extent_x(imax_contig, &lb_x, &extent_x); + check(lb_x == 0); + check(extent_x == INT_MAX); + MPI_Type_get_extent_x(four_ints, &lb_x, &extent_x); + check(lb_x == 0); + check(extent_x == 4*sizeof(int)); + MPI_Type_get_extent_x(imx4i, &lb_x, &extent_x); + check(lb_x == 0); + check(extent_x == imx4i_true_extent); + MPI_Type_get_extent_x(imx4i_rsz, &lb_x, &extent_x); + check(lb_x == INT_MAX); + check(extent_x == -1024); + + /* MPI_Type_get_true_extent */ + MPI_Type_get_true_extent(imax_contig, &lb, &extent); + check(lb == 0); + check(extent == INT_MAX); + MPI_Type_get_true_extent(four_ints, &lb, &extent); + check(lb == 0); + check(extent == 4*sizeof(int)); + MPI_Type_get_true_extent(imx4i, &lb, &extent); + check(lb == 0); + if (sizeof(MPI_Aint) == sizeof(int)) + check(extent == MPI_UNDEFINED); + else + check(extent == imx4i_true_extent); + MPI_Type_get_true_extent(imx4i_rsz, &lb, &extent); + check(lb == 0); + if (sizeof(MPI_Aint) == sizeof(int)) + check(extent == MPI_UNDEFINED); + else + check(extent == imx4i_true_extent); + + /* MPI_Type_get_true_extent_x */ + MPI_Type_get_true_extent_x(imax_contig, &lb_x, &extent_x); + check(lb_x == 0); + check(extent_x == INT_MAX); + MPI_Type_get_true_extent_x(four_ints, &lb_x, &extent_x); + check(lb_x == 0); + check(extent_x == 4*sizeof(int)); + MPI_Type_get_true_extent_x(imx4i, &lb_x, &extent_x); + check(lb_x == 0); + check(extent_x == imx4i_true_extent); + MPI_Type_get_true_extent_x(imx4i_rsz, &lb_x, &extent_x); + check(lb_x == 0); + check(extent_x == imx4i_true_extent); + + + /* MPI_{Status_set_elements,Get_elements}{,_x} */ + + /* set simple */ + MPI_Status_set_elements(&status, MPI_INT, 10); + MPI_Get_elements(&status, MPI_INT, &elements); + MPI_Get_elements_x(&status, MPI_INT, &elements_x); + MPI_Get_count(&status, MPI_INT, &count); + check(elements == 10); + check(elements_x == 10); + check(count == 10); + + /* set_x simple */ + MPI_Status_set_elements_x(&status, MPI_INT, 10); + MPI_Get_elements(&status, MPI_INT, &elements); + MPI_Get_elements_x(&status, MPI_INT, &elements_x); + MPI_Get_count(&status, MPI_INT, &count); + check(elements == 10); + check(elements_x == 10); + check(count == 10); + + /* Sets elements corresponding to count=1 of the given MPI datatype, using + * set_elements and set_elements_x. Checks expected values are returned by + * get_elements, get_elements_x, and get_count (including MPI_UNDEFINED + * clipping) */ +#define check_set_elements(type_, elts_) \ + do { \ + elements = elements_x = count = 0xfeedface; \ + /* can't use legacy "set" for large element counts */ \ + if ((elts_) <= INT_MAX) { \ + MPI_Status_set_elements(&status, (type_), 1); \ + MPI_Get_elements(&status, (type_), &elements); \ + MPI_Get_elements_x(&status, (type_), &elements_x); \ + MPI_Get_count(&status, (type_), &count); \ + check(elements == (elts_)); \ + check(elements_x == (elts_)); \ + check(count == 1); \ + } \ + \ + elements = elements_x = count = 0xfeedface; \ + MPI_Status_set_elements_x(&status, (type_), 1); \ + MPI_Get_elements(&status, (type_), &elements); \ + MPI_Get_elements_x(&status, (type_), &elements_x); \ + MPI_Get_count(&status, (type_), &count); \ + if ((elts_) > INT_MAX) { \ + check(elements == MPI_UNDEFINED); \ + } \ + else { \ + check(elements == (elts_)); \ + } \ + check(elements_x == (elts_)); \ + check(count == 1); \ + } while (0) \ + + check_set_elements(imax_contig, INT_MAX); + check_set_elements(four_ints, 4); + check_set_elements(imx4i, 4LL*(INT_MAX/2)); + check_set_elements(imx4i_rsz, 4LL*(INT_MAX/2)); + +epilogue: + if (imax_contig != MPI_DATATYPE_NULL) MPI_Type_free(&imax_contig); + if (four_ints != MPI_DATATYPE_NULL) MPI_Type_free(&four_ints); + if (imx4i != MPI_DATATYPE_NULL) MPI_Type_free(&imx4i); + if (imx4i_rsz != MPI_DATATYPE_NULL) MPI_Type_free(&imx4i_rsz); + + MPI_Reduce((wrank == 0 ? MPI_IN_PLACE : &errs), &errs, 1, MPI_INT, MPI_SUM, 0, MPI_COMM_WORLD); + if (wrank == 0) { + if (errs) { + printf("found %d errors\n", errs); + } + else { + printf(" No errors\n"); + } + } + + MPI_Finalize(); + + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/datatype/lbub.c b/teshsuite/smpi/mpich3-test/datatype/lbub.c new file mode 100644 index 0000000000..366dd6cb43 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/lbub.c @@ -0,0 +1,1305 @@ +/* -*- 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 +#include +#include "mpitest.h" +#include "mpitestconf.h" +#ifdef HAVE_STRING_H +#include +#endif + +/* + The default behavior of the test routines should be to briefly indicate + the cause of any errors - in this test, that means that verbose needs + to be set. Verbose should turn on output that is independent of error + levels. +*/ +static int verbose = 1; + +/* tests */ +int int_with_lb_ub_test(void); +int contig_of_int_with_lb_ub_test(void); +int contig_negextent_of_int_with_lb_ub_test(void); +int vector_of_int_with_lb_ub_test(void); +int vector_blklen_of_int_with_lb_ub_test(void); +int vector_blklen_stride_of_int_with_lb_ub_test(void); +int vector_blklen_stride_negextent_of_int_with_lb_ub_test(void); +int vector_blklen_negstride_negextent_of_int_with_lb_ub_test(void); +int int_with_negextent_test(void); +int vector_blklen_negstride_of_int_with_lb_ub_test(void); + +/* helper functions */ +int parse_args(int argc, char **argv); + +int main(int argc, char **argv) +{ + int err, errs = 0; + + MTest_Init( &argc, &argv ); + parse_args(argc, argv); + + /* To improve reporting of problems about operations, we + change the error handler to errors return */ + MPI_Comm_set_errhandler( MPI_COMM_WORLD, MPI_ERRORS_RETURN ); + + /* perform some tests */ + err = int_with_lb_ub_test(); + if (err && verbose) fprintf(stderr, "found %d errors in simple lb/ub test\n", err); + errs += err; + + err = contig_of_int_with_lb_ub_test(); + if (err && verbose) fprintf(stderr, "found %d errors in contig test\n", err); + errs += err; + + err = contig_negextent_of_int_with_lb_ub_test(); + if (err && verbose) fprintf(stderr, "found %d errors in negextent contig test\n", err); + errs += err; + + err = vector_of_int_with_lb_ub_test(); + if (err && verbose) fprintf(stderr, "found %d errors in simple vector test\n", err); + errs += err; + + err = vector_blklen_of_int_with_lb_ub_test(); + if (err && verbose) fprintf(stderr, "found %d errors in vector blklen test\n", err); + errs += err; + + err = vector_blklen_stride_of_int_with_lb_ub_test(); + if (err && verbose) fprintf(stderr, "found %d errors in strided vector test\n", err); + errs += err; + + err = vector_blklen_negstride_of_int_with_lb_ub_test(); + if (err && verbose) fprintf(stderr, "found %d errors in negstrided vector test\n", err); + errs += err; + + err = int_with_negextent_test(); + if (err && verbose) fprintf(stderr, "found %d errors in negextent lb/ub test\n", err); + errs += err; + + err = vector_blklen_stride_negextent_of_int_with_lb_ub_test(); + if (err && verbose) fprintf(stderr, "found %d errors in strided negextent vector test\n", err); + errs += err; + + err = vector_blklen_negstride_negextent_of_int_with_lb_ub_test(); + if (err && verbose) fprintf(stderr, "found %d errors in negstrided negextent vector test\n", err); + errs += err; + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} + +int parse_args(int argc, char **argv) +{ + /* + int ret; + + while ((ret = getopt(argc, argv, "v")) >= 0) + { + switch (ret) { + case 'v': + verbose = 1; + break; + } + } + */ + if (argc > 1 && strcmp(argv[1], "-v") == 0) + verbose = 1; + return 0; +} + +int int_with_lb_ub_test(void) +{ + int err, errs = 0, val; + MPI_Aint lb, extent, aval, true_lb; + int blocks[3] = { 1, 4, 1 }; + MPI_Aint disps[3] = { -3, 0, 6 }; + MPI_Datatype types[3] = { MPI_LB, MPI_BYTE, MPI_UB }; + + MPI_Datatype eviltype; + + err = MPI_Type_struct(3, blocks, disps, types, &eviltype); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_struct failed.\n"); + if (verbose) MTestPrintError( err ); + } + + err = MPI_Type_size(eviltype, &val); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_size failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (val != 4) { + errs++; + if (verbose) fprintf(stderr, " size of type = %d; should be %d\n", val, 4); + } + + err = MPI_Type_extent(eviltype, &aval); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_extent failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (aval != 9) { + errs++; + if (verbose) fprintf(stderr, " extent of type = %ld; should be %d\n", (long) aval, 9); + } + + err = MPI_Type_lb(eviltype, &aval); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_lb failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (aval != -3) { + errs++; + if (verbose) fprintf(stderr, " lb of type = %d; should be %d\n", (int) aval, -3); + } + + err = MPI_Type_get_extent(eviltype, &lb, &extent); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_get_extent failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (lb != -3) { + errs++; + if (verbose) fprintf(stderr, " lb of type = %d; should be %d\n", + (int) aval, -3); + } + + if (extent != 9) { + errs++; + if (verbose) fprintf(stderr, " extent of type = %d; should be %d\n", + (int) extent, 9); + } + + err = MPI_Type_ub(eviltype, &aval); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_ub failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (aval != 6) { + errs++; + if (verbose) fprintf(stderr, " ub of type = %d; should be %d\n", (int) aval, 6); + } + + err = MPI_Type_get_true_extent(eviltype, &true_lb, &aval); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_get_true_extent failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (true_lb != 0) { + errs++; + if (verbose) fprintf(stderr, " true_lb of type = %d; should be %d\n", (int) true_lb, 0); + } + + if (aval != 4) { + errs++; + if (verbose) fprintf(stderr, " true extent of type = %d; should be %d\n", (int) aval, 4); + } + + MPI_Type_free(&eviltype); + + return errs; +} + +int contig_of_int_with_lb_ub_test(void) +{ + int err, errs = 0, val; + MPI_Aint lb, extent, aval, true_lb; + int blocks[3] = { 1, 4, 1 }; + MPI_Aint disps[3] = { -3, 0, 6 }; + MPI_Datatype types[3] = { MPI_LB, MPI_BYTE, MPI_UB }; + char *typemapstring = 0; + + MPI_Datatype inttype, eviltype; + + /* build same type as in int_with_lb_ub_test() */ + typemapstring = (char*)"{ (LB,-3),4*(BYTE,0),(UB,6) }"; + err = MPI_Type_struct(3, blocks, disps, types, &inttype); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_struct of %s failed.\n", + typemapstring ); + if (verbose) MTestPrintError( err ); + /* no point in continuing */ + return errs; + } + + typemapstring=(char*)"{ (LB,-3),4*(BYTE,0),(UB,6),(LB,6),4*(BYTE,9),(UB,15),(LB,15),4*(BYTE,18),(UB,24)}"; + err = MPI_Type_contiguous(3, inttype, &eviltype); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_contiguous of %s failed.\n", + typemapstring ); + if (verbose) MTestPrintError( err ); + /* no point in continuing */ + return errs; + } + + err = MPI_Type_size(eviltype, &val); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_size of %s failed.\n", + typemapstring ); + if (verbose) MTestPrintError( err ); + } + + if (val != 12) { + errs++; + if (verbose) fprintf(stderr, " size of type = %d; should be %d\n", + val, 12); + } + + err = MPI_Type_extent(eviltype, &aval); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_extent failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (aval != 27) { + errs++; + if (verbose) fprintf(stderr, " extent of type = %d; should be %d\n", (int) aval, 27); + if (verbose) fprintf( stderr, " for type %s\n", typemapstring ); + } + + err = MPI_Type_lb(eviltype, &aval); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_lb failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (aval != -3) { + errs++; + if (verbose) fprintf(stderr, " lb of type = %d from Type_lb; should be %d in %s\n", (int) aval, -3, typemapstring ); + } + + err = MPI_Type_get_extent(eviltype, &lb, &extent); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_get_extent failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (lb != -3) { + errs++; + if (verbose) fprintf(stderr, " lb of type = %d from Type_get_extent; should be %d in %s\n", + (int) aval, -3, typemapstring ); + } + + if (extent != 27) { + errs++; + if (verbose) fprintf(stderr, " extent of type = %d from Type_get_extent; should be %d in %s\n", + (int) extent, 27, typemapstring); + } + + err = MPI_Type_ub(eviltype, &aval); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_ub failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (aval != 24) { + errs++; + if (verbose) fprintf(stderr, " ub of type = %d in Type_ub; should be %din %s\n", (int) aval, 24, typemapstring); + } + + err = MPI_Type_get_true_extent(eviltype, &true_lb, &aval); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_get_true_extent failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (true_lb != 0) { + errs++; + if (verbose) fprintf(stderr, " true_lb of type = %d; should be %d in %s\n", (int) true_lb, 0, typemapstring); + } + + if (aval != 22) { + errs++; + if (verbose) fprintf(stderr, " true extent of type = %d; should be %d in %s\n", (int) aval, 22, typemapstring); + } + + MPI_Type_free( &inttype ); + MPI_Type_free( &eviltype ); + + return errs; +} + +int contig_negextent_of_int_with_lb_ub_test(void) +{ + int err, errs = 0, val; + MPI_Aint lb, extent, aval, true_lb; + int blocks[3] = { 1, 4, 1 }; + MPI_Aint disps[3] = { 6, 0, -3 }; + MPI_Datatype types[3] = { MPI_LB, MPI_BYTE, MPI_UB }; + char *typemapstring = 0; + + MPI_Datatype inttype, eviltype; + + /* build same type as in int_with_lb_ub_test() */ + typemapstring = (char*)"{ (LB,6),4*(BYTE,0),(UB,-3) }"; + err = MPI_Type_struct(3, blocks, disps, types, &inttype); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_struct of %s failed.\n", + typemapstring ); + if (verbose) MTestPrintError( err ); + /* No point in continuing */ + return errs; + } + + typemapstring = (char*)"{ (LB,6),4*(BYTE,0),(UB,-3),(LB,-3),4*(BYTE,-9),(UB,-12),(LB,-12),4*(BYTE,-18),(UB,-21) }"; + err = MPI_Type_contiguous(3, inttype, &eviltype); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_contiguous of %s failed.\n", + typemapstring); + if (verbose) MTestPrintError( err ); + /* No point in continuing */ + return errs; + } + + err = MPI_Type_size(eviltype, &val); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_size of %s failed.\n", + typemapstring); + if (verbose) MTestPrintError( err ); + } + + if (val != 12) { + errs++; + if (verbose) fprintf(stderr, " size of type = %d; should be %d\n", val, 12); + } + + err = MPI_Type_extent(eviltype, &aval); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_extent failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (aval != 9) { + errs++; + if (verbose) fprintf(stderr, " extent of type = %d; should be %d\n", (int) aval, 9); + } + + err = MPI_Type_lb(eviltype, &aval); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_lb failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (aval != -12) { + errs++; + if (verbose) fprintf(stderr, " lb of type = %d; should be %d\n", (int) aval, -12); + } + + err = MPI_Type_get_extent(eviltype, &lb, &extent); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_get_extent failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (lb != -12) { + errs++; + if (verbose) fprintf(stderr, " lb of type = %d; should be %d\n", + (int) aval, -12); + } + + if (extent != 9) { + errs++; + if (verbose) fprintf(stderr, " extent of type = %d; should be %d\n", + (int) extent, 9); + } + + err = MPI_Type_ub(eviltype, &aval); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_ub failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (aval != -3) { + errs++; + if (verbose) fprintf(stderr, " ub of type = %d; should be %d\n", (int) aval, -3); + } + + err = MPI_Type_get_true_extent(eviltype, &true_lb, &aval); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_get_true_extent failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (true_lb != -18) { + errs++; + if (verbose) fprintf(stderr, " true_lb of type = %d; should be %d\n", (int) true_lb, -18); + } + + if (aval != 22) { + errs++; + if (verbose) fprintf(stderr, " true extent of type = %d; should be %d\n", (int) aval, 22); + } + + MPI_Type_free( &inttype ); + MPI_Type_free( &eviltype ); + + return errs; +} + +int vector_of_int_with_lb_ub_test(void) +{ + int err, errs = 0, val; + MPI_Aint lb, extent, aval, true_lb; + int blocks[3] = { 1, 4, 1 }; + MPI_Aint disps[3] = { -3, 0, 6 }; + MPI_Datatype types[3] = { MPI_LB, MPI_BYTE, MPI_UB }; + + MPI_Datatype inttype, eviltype; + + /* build same type as in int_with_lb_ub_test() */ + err = MPI_Type_struct(3, blocks, disps, types, &inttype); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_struct failed.\n"); + if (verbose) MTestPrintError( err ); + /* no point in continuing */ + return errs; + } + + err = MPI_Type_vector(3, 1, 1, inttype, &eviltype); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_vector failed.\n"); + if (verbose) MTestPrintError( err ); + /* no point in continuing */ + return errs; + } + + err = MPI_Type_size(eviltype, &val); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_size failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (val != 12) { + errs++; + if (verbose) fprintf(stderr, " size of type = %d; should be %d\n", val, 12); + } + + err = MPI_Type_extent(eviltype, &aval); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_extent failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (aval != 27) { + errs++; + if (verbose) fprintf(stderr, " extent of type = %d; should be %d\n", (int) aval, 27); + } + + err = MPI_Type_lb(eviltype, &aval); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_lb failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (aval != -3) { + errs++; + if (verbose) fprintf(stderr, " lb of type = %d; should be %d\n", (int) aval, -3); + } + + err = MPI_Type_get_extent(eviltype, &lb, &extent); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_get_extent failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (lb != -3) { + errs++; + if (verbose) fprintf(stderr, " lb of type = %d; should be %d\n", + (int) aval, -3); + } + + if (extent != 27) { + errs++; + if (verbose) fprintf(stderr, " extent of type = %d; should be %d\n", + (int) extent, 27); + } + + err = MPI_Type_ub(eviltype, &aval); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_ub failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (aval != 24) { + errs++; + if (verbose) fprintf(stderr, " ub of type = %d; should be %d\n", (int) aval, 24); + } + + err = MPI_Type_get_true_extent(eviltype, &true_lb, &aval); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_get_true_extent failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (true_lb != 0) { + errs++; + if (verbose) fprintf(stderr, " true_lb of type = %d; should be %d\n", (int) true_lb, 0); + } + + if (aval != 22) { + errs++; + if (verbose) fprintf(stderr, " true extent of type = %d; should be %d\n", (int) aval, 22); + } + + MPI_Type_free( &inttype ); + MPI_Type_free( &eviltype ); + + return errs; +} + +/* + * blklen = 4 + */ +int vector_blklen_of_int_with_lb_ub_test(void) +{ + int err, errs = 0, val; + MPI_Aint lb, extent, aval, true_lb; + int blocks[3] = { 1, 4, 1 }; + MPI_Aint disps[3] = { -3, 0, 6 }; + MPI_Datatype types[3] = { MPI_LB, MPI_BYTE, MPI_UB }; + + MPI_Datatype inttype, eviltype; + + /* build same type as in int_with_lb_ub_test() */ + err = MPI_Type_struct(3, blocks, disps, types, &inttype); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_struct failed.\n"); + if (verbose) MTestPrintError( err ); + /* no point in continuing */ + return errs; + } + + err = MPI_Type_vector(3, 4, 1, inttype, &eviltype); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_vector failed.\n"); + if (verbose) MTestPrintError( err ); + /* no point in continuing */ + return errs; + } + + err = MPI_Type_size(eviltype, &val); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_size failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (val != 48) { + errs++; + if (verbose) fprintf(stderr, " size of type = %d; should be %d\n", val, 48); + } + + err = MPI_Type_extent(eviltype, &aval); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_extent failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (aval != 54) { + errs++; + if (verbose) fprintf(stderr, " extent of type = %d; should be %d\n", (int) aval, 54); + } + + err = MPI_Type_lb(eviltype, &aval); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_lb failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (aval != -3) { + errs++; + if (verbose) fprintf(stderr, " lb of type = %d; should be %d\n", (int) aval, -3); + if (verbose) MTestPrintError( err ); + } + + err = MPI_Type_get_extent(eviltype, &lb, &extent); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_get_extent failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (lb != -3) { + errs++; + if (verbose) fprintf(stderr, " lb of type = %d; should be %d\n", + (int) aval, -3); + } + + if (extent != 54) { + errs++; + if (verbose) fprintf(stderr, " extent of type = %d; should be %d\n", + (int) extent, 54); + } + + err = MPI_Type_ub(eviltype, &aval); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_ub failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (aval != 51) { + errs++; + if (verbose) fprintf(stderr, " ub of type = %d; should be %d\n", (int) aval, 51); + } + + err = MPI_Type_get_true_extent(eviltype, &true_lb, &aval); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_get_true_extent failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (true_lb != 0) { + errs++; + if (verbose) fprintf(stderr, " true_lb of type = %d; should be %d\n", (int) true_lb, 0); + } + + if (aval != 49) { + errs++; + if (verbose) fprintf(stderr, " true extent of type = %d; should be %d\n", (int) aval, 49); + } + + MPI_Type_free( &inttype ); + MPI_Type_free( &eviltype ); + + return errs; +} + +int vector_blklen_stride_of_int_with_lb_ub_test(void) +{ + int err, errs = 0, val; + MPI_Aint lb, extent, aval, true_lb; + int blocks[3] = { 1, 4, 1 }; + MPI_Aint disps[3] = { -3, 0, 6 }; + MPI_Datatype types[3] = { MPI_LB, MPI_BYTE, MPI_UB }; + char *typemapstring = 0; + + MPI_Datatype inttype, eviltype; + + /* build same type as in int_with_lb_ub_test() */ + typemapstring = (char*)"{ (LB,-3),4*(BYTE,0),(UB,6) }"; + err = MPI_Type_struct(3, blocks, disps, types, &inttype); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_struct of %s failed.\n", + typemapstring ); + if (verbose) MTestPrintError( err ); + /* No point in continuing */ + return errs; + } + + err = MPI_Type_vector(3, 4, 5, inttype, &eviltype); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_vector failed.\n"); + if (verbose) MTestPrintError( err ); + /* no point in continuing */ + return errs; + } + + err = MPI_Type_size(eviltype, &val); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_size failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (val != 48) { + errs++; + if (verbose) fprintf(stderr, " size of type = %d; should be %d\n", val, 48); + } + + err = MPI_Type_extent(eviltype, &aval); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_extent failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (aval != 126) { + errs++; + if (verbose) fprintf(stderr, " extent of type = %d; should be %d\n", (int) aval, 126); + } + + err = MPI_Type_lb(eviltype, &aval); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_lb failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (aval != -3) { + errs++; + if (verbose) fprintf(stderr, " lb of type = %d; should be %d\n", (int) aval, -3); + } + + err = MPI_Type_get_extent(eviltype, &lb, &extent); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_get_extent failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (lb != -3) { + errs++; + if (verbose) fprintf(stderr, " lb of type = %d; should be %d\n", + (int) aval, -3); + } + + if (extent != 126) { + errs++; + if (verbose) fprintf(stderr, " extent of type = %d; should be %d\n", + (int) extent, 126); + } + + err = MPI_Type_ub(eviltype, &aval); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_ub failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (aval != 123) { + errs++; + if (verbose) fprintf(stderr, " ub of type = %d; should be %d\n", (int) aval, 123); + } + + err = MPI_Type_get_true_extent(eviltype, &true_lb, &aval); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_get_true_extent failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (true_lb != 0) { + errs++; + if (verbose) fprintf(stderr, " true_lb of type = %d; should be %d\n", (int) true_lb, 0); + } + + if (aval != 121) { + errs++; + if (verbose) fprintf(stderr, " true extent of type = %d; should be %d\n", (int) aval, 121); + } + + MPI_Type_free( &inttype ); + MPI_Type_free( &eviltype ); + + return errs; +} + +int vector_blklen_negstride_of_int_with_lb_ub_test(void) +{ + int err, errs = 0, val; + MPI_Aint lb, extent, aval, true_lb; + int blocks[3] = { 1, 4, 1 }; + MPI_Aint disps[3] = { -3, 0, 6 }; + MPI_Datatype types[3] = { MPI_LB, MPI_BYTE, MPI_UB }; + + MPI_Datatype inttype, eviltype; + + /* build same type as in int_with_lb_ub_test() */ + err = MPI_Type_struct(3, blocks, disps, types, &inttype); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_struct failed.\n"); + if (verbose) MTestPrintError( err ); + /* no point in continuing */ + return errs; + } + + err = MPI_Type_vector(3, 4, -5, inttype, &eviltype); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_vector failed.\n"); + if (verbose) MTestPrintError( err ); + /* no point in continuing */ + return errs; + } + + err = MPI_Type_size(eviltype, &val); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_size failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (val != 48) { + errs++; + if (verbose) fprintf(stderr, " size of type = %d; should be %d\n", val, 48); + } + + err = MPI_Type_extent(eviltype, &aval); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_extent failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (aval != 126) { + errs++; + if (verbose) fprintf(stderr, " extent of type = %d; should be %d\n", (int) aval, 126); + } + + err = MPI_Type_lb(eviltype, &aval); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_lb failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (aval != -93) { + errs++; + if (verbose) fprintf(stderr, " lb of type = %d; should be %d\n", (int) aval, -93); + } + + err = MPI_Type_get_extent(eviltype, &lb, &extent); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_get_extent failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (lb != -93) { + errs++; + if (verbose) fprintf(stderr, " lb of type = %d; should be %d\n", + (int) aval, -93); + } + + if (extent != 126) { + errs++; + if (verbose) fprintf(stderr, " extent of type = %d; should be %d\n", + (int) extent, 126); + } + + err = MPI_Type_ub(eviltype, &aval); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_ub failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (aval != 33) { + errs++; + if (verbose) fprintf(stderr, " ub of type = %d; should be %d\n", (int) aval, 33); + } + + err = MPI_Type_get_true_extent(eviltype, &true_lb, &aval); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_get_true_extent failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (true_lb != -90) { + errs++; + if (verbose) fprintf(stderr, " true_lb of type = %d; should be %d\n", (int) true_lb, -90); + } + + if (aval != 121) { + errs++; + if (verbose) fprintf(stderr, " true extent of type = %d; should be %d\n", (int) aval, 121); + } + + MPI_Type_free( &inttype ); + MPI_Type_free( &eviltype ); + + return errs; +} + +int int_with_negextent_test(void) +{ + int err, errs = 0, val; + MPI_Aint lb, extent, aval, true_lb; + int blocks[3] = { 1, 4, 1 }; + MPI_Aint disps[3] = { 6, 0, -3 }; + MPI_Datatype types[3] = { MPI_LB, MPI_BYTE, MPI_UB }; + char *typemapstring =0; + + MPI_Datatype eviltype; + + typemapstring = (char*)"{ (LB,6),4*(BYTE,0),(UB,-3) }"; + err = MPI_Type_struct(3, blocks, disps, types, &eviltype); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_struct of %s failed.\n", + typemapstring ); + if (verbose) MTestPrintError( err ); + /* No point in contiuing */ + return errs; + } + + err = MPI_Type_size(eviltype, &val); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_size failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (val != 4) { + errs++; + if (verbose) fprintf(stderr, " size of type = %d; should be %d\n", val, 4); + } + + err = MPI_Type_extent(eviltype, &aval); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_extent failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (aval != -9) { + errs++; + if (verbose) fprintf(stderr, " extent of type = %d; should be %d\n", (int) aval, -9); + } + + err = MPI_Type_lb(eviltype, &aval); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_lb failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (aval != 6) { + errs++; + if (verbose) fprintf(stderr, " lb of type = %d; should be %d\n", (int) aval, 6); + } + + err = MPI_Type_get_extent(eviltype, &lb, &extent); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_get_extent failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (lb != 6) { + errs++; + if (verbose) fprintf(stderr, " lb of type = %d; should be %d\n", + (int) aval, 6); + } + + if (extent != -9) { + errs++; + if (verbose) fprintf(stderr, " extent of type = %d; should be %d\n", + (int) extent, -9); + } + + err = MPI_Type_ub(eviltype, &aval); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_ub failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (aval != -3) { + errs++; + if (verbose) fprintf(stderr, " ub of type = %d; should be %d\n", (int) aval, -3); + } + + err = MPI_Type_get_true_extent(eviltype, &true_lb, &aval); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_get_true_extent failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (true_lb != 0) { + errs++; + if (verbose) fprintf(stderr, " true_lb of type = %d; should be %d\n", (int) true_lb, 0); + } + + if (aval != 4) { + errs++; + if (verbose) fprintf(stderr, " true extent of type = %d; should be %d\n", (int) aval, 4); + } + + MPI_Type_free(&eviltype); + + return errs; +} + +int vector_blklen_stride_negextent_of_int_with_lb_ub_test(void) +{ + int err, errs = 0, val; + MPI_Aint lb, extent, true_lb, aval; + int blocks[3] = { 1, 4, 1 }; + MPI_Aint disps[3] = { 6, 0, -3 }; + MPI_Datatype types[3] = { MPI_LB, MPI_BYTE, MPI_UB }; + MPI_Datatype inttype, eviltype; + char *typemapstring = 0; + + /* build same type as in int_with_lb_ub_test() */ + typemapstring = (char*)"{ (LB,6),4*(BYTE,0),(UB,-3) }"; + err = MPI_Type_struct(3, blocks, disps, types, &inttype); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_struct of %s failed.\n", + typemapstring ); + if (verbose) MTestPrintError( err ); + /* No point in continuing */ + return errs; + } + + err = MPI_Type_vector(3, 4, 5, inttype, &eviltype); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_vector failed.\n"); + if (verbose) MTestPrintError( err ); + /* no point in continuing */ + return errs; + } + + err = MPI_Type_size(eviltype, &val); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_size failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (val != 48) { + errs++; + if (verbose) fprintf(stderr, " size of type = %d; should be %d\n", val, 48); + } + + err = MPI_Type_extent(eviltype, &aval); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_extent failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (aval != 108) { + errs++; + if (verbose) fprintf(stderr, " extent of type = %d; should be %d\n", (int) aval, 108); + } + + err = MPI_Type_lb(eviltype, &aval); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_lb failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (aval != -111) { + errs++; + if (verbose) fprintf(stderr, " lb of type = %d; should be %d\n", (int) aval, -111); + } + + err = MPI_Type_get_extent(eviltype, &lb, &extent); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_get_extent failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (lb != -111) { + errs++; + if (verbose) fprintf(stderr, " lb of type = %d; should be %d\n", + (int) aval, -111); + } + + if (extent != 108) { + errs++; + if (verbose) fprintf(stderr, " extent of type = %d; should be %d\n", + (int) extent, 108); + } + + err = MPI_Type_ub(eviltype, &aval); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_ub failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (aval != -3) { + errs++; + if (verbose) fprintf(stderr, " ub of type = %d; should be %d\n", (int) aval, -3); + } + + err = MPI_Type_get_true_extent(eviltype, &true_lb, &aval); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_get_true_extent failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (true_lb != -117) { + errs++; + if (verbose) fprintf(stderr, " true_lb of type = %d; should be %d\n", (int) true_lb, -117); + } + + if (aval != 121) { + errs++; + if (verbose) fprintf(stderr, " true extent of type = %d; should be %d\n", (int) aval, 121); + } + + MPI_Type_free( &inttype ); + MPI_Type_free( &eviltype ); + + return errs; +} + +int vector_blklen_negstride_negextent_of_int_with_lb_ub_test(void) +{ + int err, errs = 0, val; + MPI_Aint extent, lb, aval, true_lb; + int blocks[3] = { 1, 4, 1 }; + MPI_Aint disps[3] = { 6, 0, -3 }; + MPI_Datatype types[3] = { MPI_LB, MPI_BYTE, MPI_UB }; + + MPI_Datatype inttype, eviltype; + + /* build same type as in int_with_lb_ub_test() */ + err = MPI_Type_struct(3, blocks, disps, types, &inttype); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_struct failed.\n"); + if (verbose) MTestPrintError( err ); + /* no point in continuing */ + return errs; + } + + err = MPI_Type_vector(3, 4, -5, inttype, &eviltype); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_vector failed.\n"); + if (verbose) MTestPrintError( err ); + /* no point in continuing */ + return errs; + } + + err = MPI_Type_size(eviltype, &val); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_size failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (val != 48) { + errs++; + if (verbose) fprintf(stderr, " size of type = %d; should be %d\n", val, 48); + } + + err = MPI_Type_extent(eviltype, &aval); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_extent failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (aval != 108) { + errs++; + if (verbose) fprintf(stderr, " extent of type = %ld; should be %d\n", (long) aval, 108); + } + + err = MPI_Type_lb(eviltype, &aval); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_lb failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (aval != -21) { + errs++; + if (verbose) fprintf(stderr, " lb of type = %ld; should be %d\n", (long) aval, -21); + } + + err = MPI_Type_get_extent(eviltype, &lb, &extent); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_get_extent failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (lb != -21) { + errs++; + if (verbose) fprintf(stderr, " lb of type = %ld; should be %d\n", + (long) aval, -21); + } + + if (extent != 108) { + errs++; + if (verbose) fprintf(stderr, " extent of type = %ld; should be %d\n", + (long) extent, 108); + } + + + err = MPI_Type_ub(eviltype, &aval); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_ub failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (aval != 87) { + errs++; + if (verbose) fprintf(stderr, " ub of type = %ld; should be %d\n", (long) aval, 87); + } + + err = MPI_Type_get_true_extent(eviltype, &true_lb, &aval); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, " MPI_Type_get_true_extent failed.\n"); + if (verbose) MTestPrintError( err ); + } + + if (true_lb != -27) { + errs++; + if (verbose) fprintf(stderr, " true_lb of type = %ld; should be %d\n", (long) true_lb, -27); + } + + if (aval != 121) { + errs++; + if (verbose) fprintf(stderr, " true extent of type = %ld; should be %d\n", (long) aval, 121); + } + + MPI_Type_free( &inttype ); + MPI_Type_free( &eviltype ); + + return errs; +} diff --git a/teshsuite/smpi/mpich3-test/datatype/localpack.c b/teshsuite/smpi/mpich3-test/datatype/localpack.c new file mode 100644 index 0000000000..5348d55f14 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/localpack.c @@ -0,0 +1,98 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2001 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +/* based on the pack.c test in the mpich suite. + */ + +#include "mpi.h" +#include +#include +#include +#include "mpitest.h" +#include "mpitestconf.h" +#ifdef HAVE_STRING_H +#include +#endif + +static int verbose = 0; + +#define BUF_SIZE 16384 + +int main(int argc, char *argv[]); +int parse_args(int argc, char **argv); + +int main(int argc, char *argv[]) +{ + int errs = 0; + char buffer[BUF_SIZE]; + int n, size; + double a,b; + int pos; + + /* Initialize MPI */ + MPI_Init(&argc, &argv); + parse_args(argc, argv); + + pos = 0; + n = 10; + a = 1.1; + b = 2.2; + + MPI_Pack(&n, 1, MPI_INT, buffer, BUF_SIZE, &pos, MPI_COMM_WORLD); + MPI_Pack(&a, 1, MPI_DOUBLE, buffer, BUF_SIZE, &pos, MPI_COMM_WORLD); + MPI_Pack(&b, 1, MPI_DOUBLE, buffer, BUF_SIZE, &pos, MPI_COMM_WORLD); + + size = pos; + pos = 0; + n = 0; + a = 0; + b = 0; + + MPI_Unpack(buffer, size, &pos, &n, 1, MPI_INT, MPI_COMM_WORLD); + MPI_Unpack(buffer, size, &pos, &a, 1, MPI_DOUBLE, MPI_COMM_WORLD); + MPI_Unpack(buffer, size, &pos, &b, 1, MPI_DOUBLE, MPI_COMM_WORLD); + /* Check results */ + if (n != 10) { + errs++; + if (verbose) fprintf(stderr, "Wrong value for n; got %d expected %d\n", n, 10 ); + } + if (a != 1.1) { + errs++; + if (verbose) fprintf(stderr, "Wrong value for a; got %f expected %f\n", a, 1.1 ); + } + if (b != 2.2) { + errs++; + if (verbose) fprintf(stderr, "Wrong value for b; got %f expected %f\n", b, 2.2 ); + } + + /* print message and exit */ + if (errs) { + fprintf(stderr, "Found %d errors\n", errs); + } + else { + printf(" No Errors\n"); + } + MPI_Finalize(); + return 0; +} + +int parse_args(int argc, char **argv) +{ + /* + int ret; + + while ((ret = getopt(argc, argv, "v")) >= 0) + { + switch (ret) { + case 'v': + verbose = 1; + break; + } + } + */ + if (argc > 1 && strcmp(argv[1], "-v") == 0) + verbose = 1; + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/datatype/longdouble.c b/teshsuite/smpi/mpich3-test/datatype/longdouble.c new file mode 100644 index 0000000000..7175e910cc --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/longdouble.c @@ -0,0 +1,65 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2012 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ + +#include +#include +#include "mpi.h" +#include "mpitest.h" + +/* Some MPI implementations should not support MPI_LONG_DOUBLE because it has + * different representations/sizes among several concurrently supported + * compilers. For example, a 16-byte GCC implementation and an 8-byte Cray + * compiler implementation. + * + * This test ensures that simplistic build logic/configuration did not result in + * a defined, yet incorrectly sized, MPI predefined datatype for long double and + * long double _Complex. See tt#1671 for more info. + * + * Based on a test suggested by Jim Hoekstra @ Iowa State University. */ + +int main(int argc, char *argv[]) +{ + int rank, size, type_size; + int errs = 0; + + MPI_Init(&argc, &argv); + + MPI_Comm_rank(MPI_COMM_WORLD, &rank); + MPI_Comm_size(MPI_COMM_WORLD, &size); + + if (rank == 0) { +#ifdef HAVE_LONG_DOUBLE + if (MPI_LONG_DOUBLE != MPI_DATATYPE_NULL) { + MPI_Type_size(MPI_LONG_DOUBLE, &type_size); + if (type_size != sizeof(long double)) { + printf("type_size != sizeof(long double) : (%zd != %zd)\n", + (size_t)type_size, sizeof(long double)); + ++errs; + } + } +#endif +#if defined(HAVE_LONG_DOUBLE__COMPLEX) && defined(USE_LONG_DOUBLE_COMPLEX) + if (MPI_C_LONG_DOUBLE_COMPLEX != MPI_DATATYPE_NULL) { + MPI_Type_size(MPI_C_LONG_DOUBLE_COMPLEX, &type_size); + if (type_size != sizeof(long double _Complex)) { + printf("type_size != sizeof(long double _Complex) : (%zd != %zd)\n", + (size_t)type_size, sizeof(long double _Complex)); + ++errs; + } + } +#endif + if (errs) { + printf("found %d errors\n", errs); + } + else { + printf(" No errors\n"); + } + } + + MPI_Finalize(); + return 0; +} + diff --git a/teshsuite/smpi/mpich3-test/datatype/lots-of-types.c b/teshsuite/smpi/mpich3-test/datatype/lots-of-types.c new file mode 100644 index 0000000000..9722167b7e --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/lots-of-types.c @@ -0,0 +1,201 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2001 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include +#include +#include +#include +#include "mpi.h" +#include "mpitest.h" + +/* + The default behavior of the test routines should be to briefly indicate + the cause of any errors - in this test, that means that verbose needs + to be set. Verbose should turn on output that is independent of error + levels. +*/ +static int verbose = 1; + +int main(int argc, char *argv[]); +int parse_args(int argc, char **argv); +int lots_of_types_test(void); + +struct test_struct_1 { + int a,b,c,d; +}; + +int main(int argc, char *argv[]) +{ + int err, errs = 0; + + /* Initialize MPI */ + MTest_Init(&argc, &argv); + parse_args(argc, argv); + + /* To improve reporting of problems about operations, we + change the error handler to errors return */ + MPI_Comm_set_errhandler( MPI_COMM_WORLD, MPI_ERRORS_RETURN ); + + err = lots_of_types_test(); + if (verbose && err) fprintf(stderr, "error in lots_of_types_test\n"); + errs += err; + + /* print message and exit */ + MTest_Finalize( errs ); + + MPI_Finalize(); + return 0; +} + +/* this test allocates 1024 indexed datatypes with 1024 distinct blocks + * each. it's possible that a low memory machine will run out of memory + * running this test; it appears to take ~25MB of memory at this time. + * -- Rob Ross, 11/2/2005 + */ +#define NUM_DTYPES 1024 +#define NUM_BLOCKS 1024 +int lots_of_types_test(void) +{ + int err, errs = 0; + int i; + MPI_Datatype mytypes[NUM_DTYPES]; + + int sendbuf[4] = { 1, 2, 3, 4 }; + + int count, elements; + MPI_Request request; + MPI_Status status; + + /* note: first element of struct has zero blklen and should be dropped */ + int disps[NUM_BLOCKS]; + int blks[NUM_BLOCKS]; + + for (i=0; i < NUM_DTYPES; i++) + mytypes[i] = MPI_DATATYPE_NULL; + + for (i=0; i < NUM_DTYPES; i++) { + int j; + + disps[0] = 0; + blks[0] = 4; + + for (j=1; j < NUM_BLOCKS; j++) { + disps[j] = 4 * j; + blks[j] = (j % 3) + 1; + } + + err = MPI_Type_indexed(NUM_BLOCKS, blks, disps, MPI_INT, &mytypes[i]); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Type_indexed returned error on type %d\n", + i); + } + mytypes[i] = MPI_DATATYPE_NULL; + goto fn_exit; + } + + MPI_Type_commit(&mytypes[i]); + } + + for (i=0; i < NUM_DTYPES; i++) { + int j; + int recvbuf[4] = { -1, -1, -1, -1 }; + + /* we will only receive 4 ints, so short buffer is ok */ + err = MPI_Irecv(recvbuf, 1, mytypes[i], 0, 0, MPI_COMM_SELF, &request); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Irecv returned error\n"); + } + } + + err = MPI_Send(sendbuf, 4, MPI_INT, 0, 0, MPI_COMM_SELF); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Send returned error\n"); + } + } + + err = MPI_Wait(&request, &status); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Wait returned error\n"); + } + } + + /* verify data */ + for (j=0; j < 4; j++) { + if (recvbuf[j] != sendbuf[j]) { + errs++; + if (verbose) { + fprintf(stderr, "recvbuf[%d] = %d; should be %d\n", + j, recvbuf[j], sendbuf[j]); + } + } + } + + /* verify count and elements */ + err = MPI_Get_count(&status, mytypes[i], &count); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Get_count returned error\n"); + } + } + if (count != MPI_UNDEFINED) { + errs++; + if (verbose) { + fprintf(stderr, "count = %d; should be MPI_UNDEFINED (%d)\n", + count, MPI_UNDEFINED); + } + } + + err = MPI_Get_elements(&status, mytypes[i], &elements); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Get_elements returned error\n"); + } + } + if (elements != 4) { + errs++; + if (verbose) { + fprintf(stderr, "elements = %d; should be 4\n", elements); + } + } + } + + fn_exit: + for (i=0; i < NUM_DTYPES; i++) { + if (mytypes[i] != MPI_DATATYPE_NULL) + MPI_Type_free(&mytypes[i]); + } + + return errs; +} + + +int parse_args(int argc, char **argv) +{ + /* + int ret; + + while ((ret = getopt(argc, argv, "v")) >= 0) + { + switch (ret) { + case 'v': + verbose = 1; + break; + } + } + */ + if (argc > 1 && strcmp(argv[1], "-v") == 0) + verbose = 1; + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/datatype/pairtype-pack.c b/teshsuite/smpi/mpich3-test/datatype/pairtype-pack.c new file mode 100644 index 0000000000..8086bd540c --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/pairtype-pack.c @@ -0,0 +1,210 @@ +/* -*- 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 +#include +#include "mpitestconf.h" +#ifdef HAVE_STRING_H +#include +#endif + +static int verbose = 0; + +int short_int_pack_test(void); + +/* helper functions */ +int parse_args(int argc, char **argv); +static int pack_and_unpack(char *typebuf, + int count, + MPI_Datatype datatype, + int typebufsz); + +int main(int argc, char *argv[]) +{ + int err, errs = 0; + + MPI_Init(&argc, &argv); /* MPI-1.2 doesn't allow for MPI_Init(0,0) */ + parse_args(argc, argv); + + /* To improve reporting of problems about operations, we + change the error handler to errors return */ + MPI_Comm_set_errhandler( MPI_COMM_WORLD, MPI_ERRORS_RETURN ); + + err = short_int_pack_test(); + errs += err; + + /* print message and exit */ + if (errs) { + fprintf(stderr, "Found %d errors\n", errs); + } + else { + printf(" No Errors\n"); + } + MPI_Finalize(); + return 0; +} + +int short_int_pack_test(void) +{ + int i, err, errs = 0; + + struct shortint { short a; int b; } sibuf[16]; + + for (i=0; i < 16; i++) { + sibuf[i].a = (short) (i * 2); + sibuf[i].b = i * 2 + 1; + } + + err = pack_and_unpack((char *) sibuf, 16, MPI_SHORT_INT, sizeof(sibuf)); + if (err != 0) { + if (verbose) { + fprintf(stderr, + "error packing/unpacking in short_int_pack_test()\n"); + } + errs += err; + } + + for (i=0; i < 16; i++) { + if (sibuf[i].a != (short) (i * 2)) { + err++; + if (verbose) { + fprintf(stderr, + "buf[%d] has invalid short (%d); should be %d\n", + i, (int) sibuf[i].a, i * 2); + } + } + if (sibuf[i].b != i * 2 + 1) { + err++; + if (verbose) { + fprintf(stderr, + "buf[%d] has invalid int (%d); should be %d\n", + i, (int) sibuf[i].b, i * 2 + 1); + } + } + } + + return errs; +} + +/* pack_and_unpack() + * + * Perform packing and unpacking of a buffer for the purposes of checking + * to see if we are processing a type correctly. Zeros the buffer between + * these two operations, so the data described by the type should be in + * place upon return but all other regions of the buffer should be zero. + * + * Parameters: + * typebuf - pointer to buffer described by datatype and count that + * will be packed and then unpacked into + * count, datatype - description of typebuf + * typebufsz - size of typebuf; used specifically to zero the buffer + * between the pack and unpack steps + * + */ +static int pack_and_unpack(char *typebuf, + int count, + MPI_Datatype datatype, + int typebufsz) +{ + char *packbuf; + int err, errs = 0, pack_size, type_size, position; + + err = MPI_Type_size(datatype, &type_size); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, + "error in MPI_Type_size call; aborting after %d errors\n", + errs); + } + return errs; + } + + type_size *= count; + + err = MPI_Pack_size(count, datatype, MPI_COMM_SELF, &pack_size); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, + "error in MPI_Pack_size call; aborting after %d errors\n", + errs); + } + return errs; + } + packbuf = (char *) malloc(pack_size); + if (packbuf == NULL) { + errs++; + if (verbose) { + fprintf(stderr, + "error in malloc call; aborting after %d errors\n", + errs); + } + return errs; + } + + position = 0; + err = MPI_Pack(typebuf, + count, + datatype, + packbuf, + type_size, + &position, + MPI_COMM_SELF); + + if (position != type_size) { + errs++; + if (verbose) fprintf(stderr, "position = %d; should be %d (pack)\n", + position, type_size); + } + + memset(typebuf, 0, typebufsz); + position = 0; + err = MPI_Unpack(packbuf, + type_size, + &position, + typebuf, + count, + datatype, + MPI_COMM_SELF); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, + "error in MPI_Unpack call; aborting after %d errors\n", + errs); + } + return errs; + } + free(packbuf); + + if (position != type_size) { + errs++; + if (verbose) fprintf(stderr, "position = %d; should be %d (unpack)\n", + position, type_size); + } + + return errs; +} + +int parse_args(int argc, char **argv) +{ + /* + int ret; + + while ((ret = getopt(argc, argv, "v")) >= 0) + { + switch (ret) { + case 'v': + verbose = 1; + break; + } + } + */ + if (argc > 1 && strcmp(argv[1], "-v") == 0) + verbose = 1; + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/datatype/pairtype-size-extent.c b/teshsuite/smpi/mpich3-test/datatype/pairtype-size-extent.c new file mode 100644 index 0000000000..b4a15333ae --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/pairtype-size-extent.c @@ -0,0 +1,143 @@ +/* -*- 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 +#include "mpitestconf.h" +#ifdef HAVE_STRING_H +#include +#endif + +static int verbose = 1; + + + +int parse_args(int argc, char **argv); + +MPI_Aint pairtype_displacement(MPI_Datatype type, int *out_size_p); + +MPI_Aint pairtype_displacement(MPI_Datatype type, int *out_size_p) +{ + MPI_Aint disp; + + /* Note that a portable test may not use a switch statement for + datatypes, as they are not required to be compile-time constants */ + if (type == MPI_FLOAT_INT) { + struct { float a; int b; } foo; + disp = (MPI_Aint) ((char *) &foo.b - (char *) &foo.a); + *out_size_p = sizeof(foo); + } + else if (type == MPI_DOUBLE_INT) { + struct { double a; int b; } foo; + disp = (MPI_Aint) ((char *) &foo.b - (char *) &foo.a); + *out_size_p = sizeof(foo); + } + else if (type == MPI_LONG_INT) { + struct { long a; int b; } foo; + disp = (MPI_Aint) ((char *) &foo.b - (char *) &foo.a); + *out_size_p = sizeof(foo); + } + else if (type == MPI_SHORT_INT) { + struct { short a; int b; } foo; + disp = (MPI_Aint) ((char *) &foo.b - (char *) &foo.a); + *out_size_p = sizeof(foo); + } + else if (type == MPI_LONG_DOUBLE_INT && type != MPI_DATATYPE_NULL) { + struct { long double a; int b; } foo; + disp = (MPI_Aint) ((char *) &foo.b - (char *) &foo.a); + *out_size_p = sizeof(foo); + } + else { + disp = -1; + } + return disp; +} + +int main(int argc, char *argv[]) +{ + +struct { MPI_Datatype atype, ptype; char name[32]; } +pairtypes[] = + { {MPI_FLOAT, MPI_FLOAT_INT, "MPI_FLOAT_INT"}, + {MPI_DOUBLE, MPI_DOUBLE_INT, "MPI_DOUBLE_INT"}, + {MPI_LONG, MPI_LONG_INT, "MPI_LONG_INT"}, + {MPI_SHORT, MPI_SHORT_INT, "MPI_SHORT_INT"}, + {MPI_LONG_DOUBLE, MPI_LONG_DOUBLE_INT, "MPI_LONG_DOUBLE_INT"}, + {(MPI_Datatype) -1, (MPI_Datatype) -1, "end"} + }; + int errs = 0; + + int i; + int blks[2] = {1, 1}; + MPI_Aint disps[2] = {0, 0}; + MPI_Datatype types[2] = {MPI_INT, MPI_INT}; + MPI_Datatype stype; + + MPI_Init(&argc, &argv); + parse_args(argc, argv); + + for (i=0; pairtypes[i].atype != (MPI_Datatype) -1; i++) { + int atype_size, ptype_size, stype_size, handbuilt_extent=0; + MPI_Aint ptype_extent, stype_extent, dummy_lb; + + types[0] = pairtypes[i].atype; + + /* Check for undefined optional types, such as + LONG_DOUBLE_INT (if, for example, long double or + long long are not supported) */ + if (types[0] == MPI_DATATYPE_NULL) continue; + + MPI_Type_size(types[0], &atype_size); + disps[1] = pairtype_displacement(pairtypes[i].ptype, + &handbuilt_extent); + + MPI_Type_create_struct(2, blks, disps, types, &stype); + + MPI_Type_size(stype, &stype_size); + MPI_Type_size(pairtypes[i].ptype, &ptype_size); + if (stype_size != ptype_size) { + errs++; + + if (verbose) fprintf(stderr, + "size of %s (%d) does not match size of hand-built MPI struct (%d)\n", + pairtypes[i].name, ptype_size, stype_size); + } + + MPI_Type_get_extent(stype, &dummy_lb, &stype_extent); + MPI_Type_get_extent(pairtypes[i].ptype, &dummy_lb, &ptype_extent); + if (stype_extent != ptype_extent || stype_extent != handbuilt_extent) { + errs++; + + if (verbose) fprintf(stderr, + "extent of %s (%d) does not match extent of either hand-built MPI struct (%d) or equivalent C struct (%d)\n", + pairtypes[i].name, (int) stype_extent, + (int) ptype_extent, + handbuilt_extent); + } + MPI_Type_free( &stype ); + } + + + /* print message and exit */ + if (errs) { + fprintf(stderr, "Found %d errors\n", errs); + } + else { + printf(" No Errors\n"); + } + MPI_Finalize(); + return 0; +} + +int parse_args(int argc, char **argv) +{ + /* We use a simple test because getopt isn't universally available */ + if (argc > 1 && strcmp(argv[1], "-v") == 0) + verbose = 1; + if (argc > 1 && strcmp(argv[1], "-nov") == 0) + verbose = 0; + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/datatype/simple-commit.c b/teshsuite/smpi/mpich3-test/datatype/simple-commit.c new file mode 100644 index 0000000000..2caa4e8b3a --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/simple-commit.c @@ -0,0 +1,78 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2001 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ + +/* Tests that commit of a couple of basic types succeeds. */ + +#include "mpi.h" +#include +#include "mpitestconf.h" +#ifdef HAVE_STRING_H +#include +#endif + +static int verbose = 0; + +int parse_args(int argc, char **argv); + +int main(int argc, char **argv) +{ + int mpi_err, errs = 0; + MPI_Datatype type; + + MPI_Init(&argc, &argv); + parse_args(argc, argv); + + /* To improve reporting of problems about operations, we + change the error handler to errors return */ + MPI_Comm_set_errhandler( MPI_COMM_WORLD, MPI_ERRORS_RETURN ); + + type = MPI_INT; + mpi_err = MPI_Type_commit(&type); + if (mpi_err != MPI_SUCCESS) { + if (verbose) { + fprintf(stderr, "MPI_Type_commit of MPI_INT failed.\n"); + } + errs++; + } + + type = MPI_FLOAT_INT; + mpi_err = MPI_Type_commit(&type); + if (mpi_err != MPI_SUCCESS) { + if (verbose) { + fprintf(stderr, "MPI_Type_commit of MPI_FLOAT_INT failed.\n"); + } + errs++; + } + + /* print message and exit */ + if (errs) { + fprintf(stderr, "Found %d errors\n", errs); + } + else { + printf(" No Errors\n"); + } + MPI_Finalize(); + return 0; +} + +int parse_args(int argc, char **argv) +{ + /* + int ret; + + while ((ret = getopt(argc, argv, "v")) >= 0) + { + switch (ret) { + case 'v': + verbose = 1; + break; + } + } + */ + if (argc > 1 && strcmp(argv[1], "-v") == 0) + verbose = 1; + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/datatype/simple-pack-external.c b/teshsuite/smpi/mpich3-test/datatype/simple-pack-external.c new file mode 100644 index 0000000000..43f421c7ab --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/simple-pack-external.c @@ -0,0 +1,412 @@ +/* -*- 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 +#include +#include +#include +#include "mpitest.h" + +static int verbose = 0; + +/* tests */ +int builtin_float_test(void); +int vector_of_vectors_test(void); +int optimizable_vector_of_basics_test(void); +int struct_of_basics_test(void); + +/* helper functions */ +int parse_args(int argc, char **argv); + +int main(int argc, char **argv) +{ + int err, errs = 0; + + MTest_Init(&argc, &argv); + parse_args(argc, argv); + + /* To improve reporting of problems about operations, we + change the error handler to errors return */ + MPI_Comm_set_errhandler( MPI_COMM_WORLD, MPI_ERRORS_RETURN ); + + /* perform some tests */ + err = builtin_float_test(); + if (err && verbose) fprintf(stderr, "%d errors in builtin float test.\n", + err); + errs += err; + + err = vector_of_vectors_test(); + if (err && verbose) fprintf(stderr, + "%d errors in vector of vectors test.\n", err); + errs += err; + + err = optimizable_vector_of_basics_test(); + if (err && verbose) fprintf(stderr, + "%d errors in vector of basics test.\n", err); + errs += err; + + err = struct_of_basics_test(); + if (err && verbose) fprintf(stderr, + "%d errors in struct of basics test.\n", err); + errs += err; + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} + +/* builtin_float_test() + * + * Tests functionality of get_envelope() and get_contents() on a MPI_FLOAT. + * + * Returns the number of errors encountered. + */ +int builtin_float_test(void) +{ + int nints, nadds, ntypes, combiner; + + int err, errs = 0; + + err = MPI_Type_get_envelope(MPI_FLOAT, + &nints, + &nadds, + &ntypes, + &combiner); + + if (combiner != MPI_COMBINER_NAMED) errs++; + + /* Note: it is erroneous to call MPI_Type_get_contents() on a basic. */ + return errs; +} + +/* vector_of_vectors_test() + * + * Builds a vector of a vector of ints. Assuming an int array of size 9 + * integers, and treating the array as a 3x3 2D array, this will grab the + * corners. + * + * Returns the number of errors encountered. + */ +int vector_of_vectors_test(void) +{ + MPI_Datatype inner_vector; + MPI_Datatype outer_vector; + int array[9] = { 1, -1, 2, + -2, -3, -4, + 3, -5, 4 }; + + char *buf; + int i, err, errs = 0; + MPI_Aint sizeoftype, position; + + /* set up type */ + err = MPI_Type_vector(2, + 1, + 2, + MPI_INT, + &inner_vector); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, + "error in MPI call; aborting after %d errors\n", + errs+1); + return errs; + } + + err = MPI_Type_vector(2, + 1, + 2, + inner_vector, + &outer_vector); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, + "error in MPI call; aborting after %d errors\n", + errs+1); + return errs; + } + + MPI_Type_commit(&outer_vector); + + MPI_Pack_external_size((char*)"external32", 1, outer_vector, &sizeoftype); + if (sizeoftype != 4*4) { + errs++; + if (verbose) fprintf(stderr, "size of type = %d; should be %d\n", + (int) sizeoftype, 4*4); + return errs; + } + + buf = (char *) malloc(sizeoftype); + + position = 0; + err = MPI_Pack_external((char*)"external32", + array, + 1, + outer_vector, + buf, + sizeoftype, + &position); + + if (position != sizeoftype) { + errs++; + if (verbose) fprintf(stderr, "position = %d; should be %d (pack)\n", + (int) position, (int) sizeoftype); + } + + memset(array, 0, 9*sizeof(int)); + position = 0; + err = MPI_Unpack_external((char*)"external32", + buf, + sizeoftype, + &position, + array, + 1, + outer_vector); + + if (position != sizeoftype) { + errs++; + if (verbose) fprintf(stderr, "position = %d; should be %d (unpack)\n", + (int) position, (int) sizeoftype); + } + + for (i=0; i < 9; i++) { + int goodval; + switch (i) { + case 0: + goodval = 1; + break; + case 2: + goodval = 2; + break; + case 6: + goodval = 3; + break; + case 8: + goodval = 4; + break; + default: + goodval = 0; + break; + } + if (array[i] != goodval) { + errs++; + if (verbose) fprintf(stderr, "array[%d] = %d; should be %d\n", + i, array[i], goodval); + } + } + + MPI_Type_free(&inner_vector); + MPI_Type_free(&outer_vector); + return errs; +} + +/* optimizable_vector_of_basics_test() + * + * Builds a vector of ints. Count is 10, blocksize is 2, stride is 2, so this + * is equivalent to a contig of 20. + * + * Returns the number of errors encountered. + */ +int optimizable_vector_of_basics_test(void) +{ + MPI_Datatype parent_type; + int array[20] = { 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, + 16, 17, 18, 19 }; + char *buf; + int i; + MPI_Aint sizeofint, sizeoftype, position; + + int err, errs = 0; + + MPI_Pack_external_size((char*)"external32", 1, MPI_INT, &sizeofint); + + if (sizeofint != 4) { + errs++; + if (verbose) fprintf(stderr, + "size of external32 MPI_INT = %d; should be %d\n", + (int) sizeofint, 4); + } + + /* set up type */ + err = MPI_Type_vector(10, + 2, + 2, + MPI_INT, + &parent_type); + + MPI_Type_commit(&parent_type); + + MPI_Pack_external_size((char*)"external32", 1, parent_type, &sizeoftype); + + + if (sizeoftype != 20 * sizeofint) { + errs++; + if (verbose) fprintf(stderr, "size of vector = %d; should be %d\n", + (int) sizeoftype, (int) (20 * sizeofint)); + } + + buf = (char *) malloc(sizeoftype); + + position = 0; + err = MPI_Pack_external((char*)"external32", + array, + 1, + parent_type, + buf, + sizeoftype, + &position); + + if (position != sizeoftype) { + errs++; + if (verbose) fprintf(stderr, "position = %d; should be %d (pack)\n", + (int) position, (int) sizeoftype); + } + + memset(array, 0, 20 * sizeof(int)); + position = 0; + err = MPI_Unpack_external((char*)"external32", + buf, + sizeoftype, + &position, + array, + 1, + parent_type); + + if (position != sizeoftype) { + errs++; + if (verbose) fprintf(stderr, + "position = %ld; should be %ld (unpack)\n", + (long) position, (long) sizeoftype); + } + + for (i=0; i < 20; i++) { + if (array[i] != i) { + errs++; + if (verbose) fprintf(stderr, "array[%d] = %d; should be %d\n", + i, array[i], i); + } + } + + MPI_Type_free(&parent_type); + return errs; +} + +/* struct_of_basics_test() + * + * Builds a struct of ints. Count is 10, all blocksizes are 2, all + * strides are 2*sizeofint, so this is equivalent to a contig of 20. + * + * Returns the number of errors encountered. + */ +int struct_of_basics_test(void) +{ + MPI_Datatype parent_type; + int array[20] = { 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, + 16, 17, 18, 19 }; + char *buf; + int i; + MPI_Aint sizeofint, sizeoftype, position; + int blocks[10]; + MPI_Aint indices[10]; + MPI_Datatype types[10]; + + int err, errs = 0; + + MPI_Pack_external_size((char*)"external32", 1, MPI_INT, &sizeofint); + + if (sizeofint != 4) { + errs++; + if (verbose) fprintf(stderr, + "size of external32 MPI_INT = %d; should be %d\n", + (int) sizeofint, 4); + } + + for (i = 0; i < 10; i++) { + blocks[i] = 2; + indices[i] = 2 * i * sizeofint; + /* This will cause MPICH to consider this as a blockindex. We + * need different types here. */ + types[i] = MPI_INT; + } + + /* set up type */ + err = MPI_Type_struct(10, + blocks, + indices, + types, + &parent_type); + + MPI_Type_commit(&parent_type); + + MPI_Pack_external_size((char*)"external32", 1, parent_type, &sizeoftype); + + if (sizeoftype != 20 * sizeofint) { + errs++; + if (verbose) fprintf(stderr, "size of vector = %d; should be %d\n", + (int) sizeoftype, (int) (20 * sizeofint)); + } + + buf = (char *) malloc(sizeoftype); + + position = 0; + err = MPI_Pack_external((char*)"external32", + array, + 1, + parent_type, + buf, + sizeoftype, + &position); + + if (position != sizeoftype) { + errs++; + if (verbose) fprintf(stderr, "position = %d; should be %d (pack)\n", + (int) position, (int) sizeoftype); + } + + memset(array, 0, 20 * sizeof(int)); + position = 0; + err = MPI_Unpack_external((char*)"external32", + buf, + sizeoftype, + &position, + array, + 1, + parent_type); + + if (position != sizeoftype) { + errs++; + if (verbose) fprintf(stderr, + "position = %ld; should be %ld (unpack)\n", + (long) position, (long) sizeoftype); + } + + for (i=0; i < 20; i++) { + if (array[i] != i) { + errs++; + if (verbose) fprintf(stderr, "array[%d] = %d; should be %d\n", + i, array[i], i); + } + } + + MPI_Type_free(&parent_type); + return errs; +} + +int parse_args(int argc, char **argv) +{ + int ret; + + while ((ret = getopt(argc, argv, "v")) >= 0) + { + switch (ret) { + case 'v': + verbose = 1; + break; + } + } + return 0; +} + diff --git a/teshsuite/smpi/mpich3-test/datatype/simple-pack.c b/teshsuite/smpi/mpich3-test/datatype/simple-pack.c new file mode 100644 index 0000000000..d2119cdfb4 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/simple-pack.c @@ -0,0 +1,311 @@ +/* -*- 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 +#include +#include "mpitestconf.h" +#ifdef HAVE_STRING_H +#include +#endif + +static int verbose = 0; + +/* tests */ +int builtin_float_test(void); +int vector_of_vectors_test(void); +int optimizable_vector_of_basics_test(void); + +/* helper functions */ +int parse_args(int argc, char **argv); + +int main(int argc, char **argv) +{ + int err, errs = 0; + + MPI_Init(&argc, &argv); /* MPI-1.2 doesn't allow for MPI_Init(0,0) */ + parse_args(argc, argv); + + /* To improve reporting of problems about operations, we + change the error handler to errors return */ + MPI_Comm_set_errhandler( MPI_COMM_WORLD, MPI_ERRORS_RETURN ); + + /* perform some tests */ + err = builtin_float_test(); + if (err && verbose) fprintf(stderr, "%d errors in builtin float test.\n", + err); + errs += err; + + err = vector_of_vectors_test(); + if (err && verbose) fprintf(stderr, + "%d errors in vector of vectors test.\n", err); + errs += err; + + err = optimizable_vector_of_basics_test(); + if (err && verbose) fprintf(stderr, + "%d errors in vector of basics test.\n", err); + errs += err; + + /* print message and exit */ + if (errs) { + fprintf(stderr, "Found %d errors\n", errs); + } + else { + printf(" No Errors\n"); + } + MPI_Finalize(); + return 0; +} + +/* builtin_float_test() + * + * Tests functionality of get_envelope() and get_contents() on a MPI_FLOAT. + * + * Returns the number of errors encountered. + */ +int builtin_float_test(void) +{ + int nints, nadds, ntypes, combiner; + + int err, errs = 0; + + err = MPI_Type_get_envelope(MPI_FLOAT, + &nints, + &nadds, + &ntypes, + &combiner); + + if (combiner != MPI_COMBINER_NAMED) errs++; + + /* Note: it is erroneous to call MPI_Type_get_contents() on a basic. */ + return errs; +} + +/* vector_of_vectors_test() + * + * Builds a vector of a vector of ints. Assuming an int array of size 9 + * integers, and treating the array as a 3x3 2D array, this will grab the + * corners. + * + * Returns the number of errors encountered. + */ +int vector_of_vectors_test(void) +{ + MPI_Datatype inner_vector; + MPI_Datatype outer_vector; + int array[9] = { 1, -1, 2, + -2, -3, -4, + 3, -5, 4 }; + + char *buf; + int i, err, errs = 0, sizeoftype, position; + + /* set up type */ + err = MPI_Type_vector(2, + 1, + 2, + MPI_INT, + &inner_vector); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, + "error in MPI call; aborting after %d errors\n", + errs+1); + return errs; + } + + err = MPI_Type_vector(2, + 1, + 2, + inner_vector, + &outer_vector); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) fprintf(stderr, + "error in MPI call; aborting after %d errors\n", + errs+1); + return errs; + } + + MPI_Type_commit(&outer_vector); + MPI_Type_size(outer_vector, &sizeoftype); + if (sizeoftype != 4*sizeof(int)) { + errs++; + if (verbose) fprintf(stderr, "size of type = %d; should be %d\n", + (int) sizeoftype, (int) (4*sizeof(int))); + return errs; + } + + buf = (char *) malloc(sizeoftype); + + position = 0; + err = MPI_Pack(array, + 1, + outer_vector, + buf, + sizeoftype, + &position, + MPI_COMM_WORLD); + + if (position != sizeoftype) { + errs++; + if (verbose) fprintf(stderr, "position = %d; should be %d (pack)\n", + position, sizeoftype); + } + + memset(array, 0, 9*sizeof(int)); + position = 0; + err = MPI_Unpack(buf, + sizeoftype, + &position, + array, + 1, + outer_vector, + MPI_COMM_WORLD); + + if (position != sizeoftype) { + errs++; + if (verbose) fprintf(stderr, "position = %d; should be %d (unpack)\n", + position, sizeoftype); + } + + for (i=0; i < 9; i++) { + int goodval; + switch (i) { + case 0: + goodval = 1; + break; + case 2: + goodval = 2; + break; + case 6: + goodval = 3; + break; + case 8: + goodval = 4; + break; + default: + goodval = 0; + break; + } + if (array[i] != goodval) { + errs++; + if (verbose) fprintf(stderr, "array[%d] = %d; should be %d\n", + i, array[i], goodval); + } + } + + MPI_Type_free(&inner_vector); + MPI_Type_free(&outer_vector); + return errs; +} + +/* optimizable_vector_of_basics_test() + * + * Builds a vector of ints. Count is 10, blocksize is 2, stride is 2, so this + * is equivalent to a contig of 20. + * + * Returns the number of errors encountered. + */ +int optimizable_vector_of_basics_test(void) +{ + MPI_Datatype parent_type; + int array[20] = { 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, + 16, 17, 18, 19 }; + char *buf; + int i, sizeofint, sizeoftype, position; + + int err, errs = 0; + + MPI_Type_size(MPI_INT, &sizeofint); + + if (sizeofint != sizeof(int)) { + errs++; + if (verbose) fprintf(stderr, "size of MPI_Int = %d; should be %d\n", + sizeofint, (int) sizeof(int)); + } + + /* set up type */ + err = MPI_Type_vector(10, + 2, + 2, + MPI_INT, + &parent_type); + + MPI_Type_commit(&parent_type); + + MPI_Type_size(parent_type, &sizeoftype); + + if (sizeoftype != 20 * sizeof(int)) { + errs++; + if (verbose) fprintf(stderr, "size of vector = %d; should be %d\n", + (int) sizeoftype, (int) (20 * sizeof(int))); + } + + buf = (char *) malloc(sizeoftype); + + position = 0; + err = MPI_Pack(array, + 1, + parent_type, + buf, + sizeoftype, + &position, + MPI_COMM_WORLD); + + if (position != sizeoftype) { + errs++; + if (verbose) fprintf(stderr, "position = %d; should be %d (pack)\n", + position, sizeoftype); + } + + memset(array, 0, 20 * sizeof(int)); + position = 0; + err = MPI_Unpack(buf, + sizeoftype, + &position, + array, + 1, + parent_type, + MPI_COMM_WORLD); + + if (position != sizeoftype) { + errs++; + if (verbose) fprintf(stderr, "position = %d; should be %d (unpack)\n", + position, sizeoftype); + } + + for (i=0; i < 20; i++) { + if (array[i] != i) { + errs++; + if (verbose) fprintf(stderr, "array[%d] = %d; should be %d\n", + i, array[i], i); + } + } + + MPI_Type_free(&parent_type); + return errs; +} + + +int parse_args(int argc, char **argv) +{ + /* + int ret; + + while ((ret = getopt(argc, argv, "v")) >= 0) + { + switch (ret) { + case 'v': + verbose = 1; + break; + } + } + */ + if (argc > 1 && strcmp(argv[1], "-v") == 0) + verbose = 1; + return 0; +} + diff --git a/teshsuite/smpi/mpich3-test/datatype/simple-resized.c b/teshsuite/smpi/mpich3-test/datatype/simple-resized.c new file mode 100644 index 0000000000..83aa629a8e --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/simple-resized.c @@ -0,0 +1,143 @@ +/* -*- 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 +#include +#include "mpitestconf.h" +#ifdef HAVE_STRING_H +#include +#endif + +static int verbose = 0; + +/* tests */ +int derived_resized_test(void); + +/* helper functions */ +int parse_args(int argc, char **argv); + +int main(int argc, char **argv) +{ + int err, errs = 0; + + MPI_Init(&argc, &argv); /* MPI-1.2 doesn't allow for MPI_Init(0,0) */ + parse_args(argc, argv); + + /* To improve reporting of problems about operations, we + change the error handler to errors return */ + MPI_Comm_set_errhandler( MPI_COMM_WORLD, MPI_ERRORS_RETURN ); + + /* perform some tests */ + err = derived_resized_test(); + if (err && verbose) fprintf(stderr, "%d errors in derived_resized test.\n", + err); + errs += err; + + /* print message and exit */ + if (errs) { + fprintf(stderr, "Found %d errors\n", errs); + } + else { + printf(" No Errors\n"); + } + MPI_Finalize(); + return 0; +} + +/* derived_resized_test() + * + * Tests behavior with resizing of a simple derived type. + * + * Returns the number of errors encountered. + */ +int derived_resized_test(void) +{ + int err, errs = 0; + + int count = 2; + MPI_Datatype newtype, resizedtype; + + int size; + MPI_Aint extent; + + err = MPI_Type_contiguous(count, + MPI_INT, + &newtype); + if (err != MPI_SUCCESS) { + if (verbose) { + fprintf(stderr, + "error creating type in derived_resized_test()\n"); + } + errs++; + } + + err = MPI_Type_create_resized(newtype, + (MPI_Aint) 0, + (MPI_Aint) (2*sizeof(int) + 10), + &resizedtype); + + err = MPI_Type_size(resizedtype, &size); + if (err != MPI_SUCCESS) { + if (verbose) { + fprintf(stderr, + "error obtaining type size in derived_resized_test()\n"); + } + errs++; + } + + if (size != 2*sizeof(int)) { + if (verbose) { + fprintf(stderr, + "error: size != %d in derived_resized_test()\n", (int) (2*sizeof(int))); + } + errs++; + } + + err = MPI_Type_extent(resizedtype, &extent); + if (err != MPI_SUCCESS) { + if (verbose) { + fprintf(stderr, + "error obtaining type extent in derived_resized_test()\n"); + } + errs++; + } + + if (extent != 2*sizeof(int) + 10) { + if (verbose) { + fprintf(stderr, + "error: invalid extent (%d) in derived_resized_test(); should be %d\n", + (int) extent, + (int) (2*sizeof(int) + 10)); + } + errs++; + } + + MPI_Type_free( &newtype ); + MPI_Type_free( &resizedtype ); + + return errs; +} + + +int parse_args(int argc, char **argv) +{ + /* + int ret; + + while ((ret = getopt(argc, argv, "v")) >= 0) + { + switch (ret) { + case 'v': + verbose = 1; + break; + } + } + */ + if (argc > 1 && strcmp(argv[1], "-v") == 0) + verbose = 1; + return 0; +} + diff --git a/teshsuite/smpi/mpich3-test/datatype/simple-size-extent.c b/teshsuite/smpi/mpich3-test/datatype/simple-size-extent.c new file mode 100644 index 0000000000..bde5592b5b --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/simple-size-extent.c @@ -0,0 +1,167 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2001 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ + +/* Tests that Type_get_extent of a couple of basic types succeeds. */ + +#include "mpi.h" +#include +#include "mpitestconf.h" +#ifdef HAVE_STRING_H +#include +#endif + +static int verbose = 0; + +int parse_args(int argc, char **argv); + +int main(int argc, char **argv) +{ + int mpi_err, errs = 0, size; + MPI_Aint lb, ub, extent; + MPI_Datatype type; + + struct { float a; int b; } foo; + + MPI_Init(&argc, &argv); + parse_args(argc, argv); + + /* To improve reporting of problems about operations, we + change the error handler to errors return */ + MPI_Comm_set_errhandler( MPI_COMM_WORLD, MPI_ERRORS_RETURN ); + + type = MPI_INT; + mpi_err = MPI_Type_size(type, &size); + if (mpi_err != MPI_SUCCESS) { + if (verbose) { + fprintf(stderr, "MPI_Type_size of MPI_INT failed.\n"); + } + errs++; + } + if (size != sizeof(int)) { + if (verbose) { + fprintf(stderr, "MPI_Type_size of MPI_INT incorrect size (%d); should be %d.\n", + size, (int) sizeof(int)); + } + errs++; + } + + mpi_err = MPI_Type_get_extent(type, &lb, &extent); + if (mpi_err != MPI_SUCCESS) { + if (verbose) { + fprintf(stderr, "MPI_Type_get_extent of MPI_INT failed.\n"); + } + errs++; + } + if (extent != sizeof(int)) { + if (verbose) { + fprintf(stderr, "MPI_Type_get_extent of MPI_INT returned incorrect extent (%d); should be %d.\n", + (int) extent, (int) sizeof(int)); + } + errs++; + } + if (lb != 0) { + if (verbose) { + fprintf(stderr, "MPI_Type_get_extent of MPI_INT returned incorrect lb (%d); should be 0.\n", + (int) lb); + } + errs++; + } + mpi_err = MPI_Type_ub(type, &ub); + if (mpi_err != MPI_SUCCESS) { + if (verbose) { + fprintf(stderr, "MPI_Type_ub of MPI_INT failed.\n"); + } + errs++; + } + if (ub != extent - lb) { + if (verbose) { + fprintf(stderr, "MPI_Type_ub of MPI_INT returned incorrect ub (%d); should be %d.\n", + (int) ub, (int) (extent - lb)); + } + errs++; + } + + type = MPI_FLOAT_INT; + mpi_err = MPI_Type_size(type, &size); + if (mpi_err != MPI_SUCCESS) { + if (verbose) { + fprintf(stderr, "MPI_Type_size of MPI_FLOAT_INT failed.\n"); + } + errs++; + } + if (size != sizeof(float) + sizeof(int)) { + if (verbose) { + fprintf(stderr, "MPI_Type_size of MPI_FLOAT_INT returned incorrect size (%d); should be %d.\n", + size, (int) (sizeof(float) + sizeof(int))); + } + errs++; + } + + mpi_err = MPI_Type_get_extent(type, &lb, &extent); + if (mpi_err != MPI_SUCCESS) { + if (verbose) { + fprintf(stderr, "MPI_Type_get_extent of MPI_FLOAT_INT failed.\n"); + } + errs++; + } + if (extent != sizeof(foo)) { + if (verbose) { + fprintf(stderr, "MPI_Type_get_extent of MPI_FLOAT_INT returned incorrect extent (%d); should be %d.\n", + (int) extent, (int) sizeof(foo)); + } + errs++; + } + if (lb != 0) { + if (verbose) { + fprintf(stderr, "MPI_Type_get_extent of MPI_FLOAT_INT returned incorrect lb (%d); should be 0.\n", + (int) lb); + } + errs++; + } + mpi_err = MPI_Type_ub(type, &ub); + if (mpi_err != MPI_SUCCESS) { + if (verbose) { + fprintf(stderr, "MPI_Type_ub of MPI_FLOAT_INT failed.\n"); + } + errs++; + } + if (ub != extent - lb) { + if (verbose) { + fprintf(stderr, "MPI_Type_ub of MPI_FLOAT_INT returned incorrect ub (%d); should be %d.\n", + (int) ub, (int) (extent - lb)); + } + errs++; + } + + /* print message and exit */ + if (errs) { + fprintf(stderr, "Found %d errors\n", errs); + } + else { + printf(" No Errors\n"); + } + MPI_Finalize(); + return 0; +} + +int parse_args(int argc, char **argv) +{ + /* + int ret; + + while ((ret = getopt(argc, argv, "v")) >= 0) + { + switch (ret) { + case 'v': + verbose = 1; + break; + } + } + */ + if (argc > 1 && strcmp(argv[1], "-v") == 0) + verbose = 1; + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/datatype/sizedtypes.c b/teshsuite/smpi/mpich3-test/datatype/sizedtypes.c new file mode 100644 index 0000000000..42bec068ce --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/sizedtypes.c @@ -0,0 +1,94 @@ +/* -*- 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 +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Test of the sized types, supported in MPI-2"; +*/ + +int main( int argc, char *argv[] ) +{ + int errs = 0; + int size; + + MTest_Init( &argc, &argv ); + + MPI_Type_size( MPI_REAL4, &size ); + if (size != 4) { + errs ++; + printf( "MPI_REAL4 has size %d\n", size ); + } + MPI_Type_size( MPI_REAL8, &size ); + if (size != 8) { + errs ++; + printf( "MPI_REAL8 has size %d\n", size ); + } + if (MPI_REAL16 != MPI_DATATYPE_NULL) { + MPI_Type_size( MPI_REAL16, &size ); + if (size != 16) { + errs ++; + printf( "MPI_REAL16 has size %d\n", size ); + } + } + + MPI_Type_size( MPI_COMPLEX8, &size ); + if (size != 8) { + errs ++; + printf( "MPI_COMPLEX8 has size %d\n", size ); + } + MPI_Type_size( MPI_COMPLEX16, &size ); + if (size != 16) { + errs ++; + printf( "MPI_COMPLEX16 has size %d\n", size ); + } + if (MPI_COMPLEX32 != MPI_DATATYPE_NULL) { + MPI_Type_size( MPI_COMPLEX32, &size ); + if (size != 32) { + errs ++; + printf( "MPI_COMPLEX32 has size %d\n", size ); + } + } + + MPI_Type_size( MPI_INTEGER1, &size ); + if (size != 1) { + errs ++; + printf( "MPI_INTEGER1 has size %d\n", size ); + } + MPI_Type_size( MPI_INTEGER2, &size ); + if (size != 2) { + errs ++; + printf( "MPI_INTEGER2 has size %d\n", size ); + } + MPI_Type_size( MPI_INTEGER4, &size ); + if (size != 4) { + errs ++; + printf( "MPI_INTEGER4 has size %d\n", size ); + } + if (MPI_INTEGER8 != MPI_DATATYPE_NULL) { + MPI_Type_size( MPI_INTEGER8, &size ); + if (size != 8) { + errs ++; + printf( "MPI_INTEGER8 has size %d\n", size ); + } + } +#ifdef HAVE_MPI_INTEGER16 + if (MPI_INTEGER16 != MPI_DATATYPE_NULL) { + MPI_Type_size( MPI_INTEGER16, &size ); + if (size != 16) { + errs ++; + printf( "MPI_INTEGER16 has size %d\n", size ); + } + } +#endif + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/datatype/slice-pack-external.c b/teshsuite/smpi/mpich3-test/datatype/slice-pack-external.c new file mode 100644 index 0000000000..8f4c004f93 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/slice-pack-external.c @@ -0,0 +1,131 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2001 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include +#include +#include +#include +#include "mpi.h" + +static int verbose = 0; +int a[100][100][100], e[9][9][9]; + +int main(int argc, char *argv[]); + +/* helper functions */ +static int parse_args(int argc, char **argv); + +int main(int argc, char *argv[]) +{ + /* Variable declarations */ + MPI_Datatype oneslice, twoslice, threeslice; + int errs = 0; + MPI_Aint sizeofint, bufsize, position; + void *buffer; + + int i, j, k; + + /* Initialize a to some known values. */ + for (i = 0; i < 100; i++) { + for (j = 0; j < 100; j++) { + for (k = 0; k < 100; k++) { + a[i][j][k] = i*1000000+j*1000+k; + } + } + } + + /* Initialize MPI */ + MPI_Init(&argc, &argv); + MPI_Type_extent(MPI_INT, &sizeofint); + + parse_args(argc, argv); + + /* Create data types. */ + /* NOTE: This differs from the way that it's done on the sheet. */ + /* On the sheet, the slice is a[0, 2, 4, ..., 16][2-10][1-9]. */ + /* Below, the slice is a[0-8][2-10][1, 3, 5, ..., 17]. */ + MPI_Type_vector(9, 1, 2, MPI_INT, &oneslice); + MPI_Type_hvector(9, 1, 100*sizeofint, oneslice, &twoslice); + MPI_Type_hvector(9, 1, 100*100*sizeofint, twoslice, &threeslice); + + MPI_Type_commit(&threeslice); + + /* Pack it into a buffer. */ + position = 0; +/* MPI_Pack_size(1, threeslice, MPI_COMM_WORLD, &bufsize); */ + MPI_Pack_external_size((char*)"external32", 1, threeslice, &bufsize); + if (bufsize != 2916) + { + fprintf(stderr," Error on pack size! Got %d; expecting %d\n", (int) bufsize, 2916); + } + buffer = (void *) malloc((unsigned) bufsize); + + /* -1 to indices on sheet to compensate for Fortran --> C */ + MPI_Pack_external((char*)"external32", + &(a[0][2][1]), + 1, threeslice, + buffer, + bufsize, + &position); + + /* Unpack the buffer into e. */ + position = 0; + MPI_Unpack_external((char*)"external32", + buffer, + bufsize, + &position, + e, 9*9*9, + MPI_INT); + + /* Display errors, if any. */ + for (i = 0; i < 9; i++) { + for (j = 0; j < 9; j++) { + for (k = 0; k < 9; k++) { + /* The truncation in integer division makes this safe. */ + if (e[i][j][k] != a[i][j+2][k*2+1]) { + errs++; + if (verbose) { + printf("Error in location %d x %d x %d: %d, should be %d.\n", + i, j, k, e[i][j][k], a[i][j+2][k*2+1]); + } + } + } + } + } + + /* Release memory. */ + free(buffer); + + if (errs) { + fprintf(stderr, "Found %d errors\n", errs); + } + else { + printf(" No Errors\n"); + } + + MPI_Type_free(&oneslice); + MPI_Type_free(&twoslice); + MPI_Type_free(&threeslice); + + MPI_Finalize(); + return 0; +} + +/* parse_args() + */ +static int parse_args(int argc, char **argv) +{ + int ret; + + while ((ret = getopt(argc, argv, "v")) >= 0) + { + switch (ret) { + case 'v': + verbose = 1; + break; + } + } + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/datatype/slice-pack.c b/teshsuite/smpi/mpich3-test/datatype/slice-pack.c new file mode 100644 index 0000000000..8fcd3b596d --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/slice-pack.c @@ -0,0 +1,136 @@ +/* -*- 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 +#include +#include +#include "mpitest.h" +#include "mpitestconf.h" +#ifdef HAVE_STRING_H +#include +#endif + +static int verbose = 0; +int a[100][100][100], e[9][9][9]; + +int main(int argc, char *argv[]); + +/* helper functions */ +static int parse_args(int argc, char **argv); + +int main(int argc, char *argv[]) +{ + /* Variable declarations */ + MPI_Datatype oneslice, twoslice, threeslice; + int errs = 0; + MPI_Aint sizeofint; + + int bufsize, position; + void *buffer; + + int i, j, k; + + /* Initialize a to some known values. */ + for (i = 0; i < 100; i++) { + for (j = 0; j < 100; j++) { + for (k = 0; k < 100; k++) { + a[i][j][k] = i*1000000+j*1000+k; + } + } + } + + /* Initialize MPI */ + MPI_Init(&argc, &argv); + MPI_Type_extent(MPI_INT, &sizeofint); + + parse_args(argc, argv); + + /* Create data types. */ + /* NOTE: This differs from the way that it's done on the sheet. */ + /* On the sheet, the slice is a[0, 2, 4, ..., 16][2-10][1-9]. */ + /* Below, the slice is a[0-8][2-10][1, 3, 5, ..., 17]. */ + MPI_Type_vector(9, 1, 2, MPI_INT, &oneslice); + MPI_Type_hvector(9, 1, 100*sizeofint, oneslice, &twoslice); + MPI_Type_hvector(9, 1, 100*100*sizeofint, twoslice, &threeslice); + + MPI_Type_commit(&threeslice); + + /* Pack it into a buffer. */ + position = 0; + MPI_Pack_size(1, threeslice, MPI_COMM_WORLD, &bufsize); + buffer = (void *) malloc((unsigned) bufsize); + + /* -1 to indices on sheet to compensate for Fortran --> C */ + MPI_Pack(&(a[0][2][1]), + 1, threeslice, + buffer, + bufsize, + &position, + MPI_COMM_WORLD); + + /* Unpack the buffer into e. */ + position = 0; + MPI_Unpack(buffer, + bufsize, + &position, + e, 9*9*9, + MPI_INT, + MPI_COMM_WORLD); + + /* Display errors, if any. */ + for (i = 0; i < 9; i++) { + for (j = 0; j < 9; j++) { + for (k = 0; k < 9; k++) { + /* The truncation in integer division makes this safe. */ + if (e[i][j][k] != a[i][j+2][k*2+1]) { + errs++; + if (verbose) { + printf("Error in location %d x %d x %d: %d, should be %d.\n", + i, j, k, e[i][j][k], a[i][j+2][k*2+1]); + } + } + } + } + } + + /* Release memory. */ + free(buffer); + + if (errs) { + fprintf(stderr, "Found %d errors\n", errs); + } + else { + printf(" No Errors\n"); + } + + MPI_Type_free(&oneslice); + MPI_Type_free(&twoslice); + MPI_Type_free(&threeslice); + + MPI_Finalize(); + return 0; +} + +/* parse_args() + */ +static int parse_args(int argc, char **argv) +{ + /* + int ret; + + while ((ret = getopt(argc, argv, "v")) >= 0) + { + switch (ret) { + case 'v': + verbose = 1; + break; + } + } + */ + if (argc > 1 && strcmp(argv[1], "-v") == 0) + verbose = 1; + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/datatype/struct-derived-zeros.c b/teshsuite/smpi/mpich3-test/datatype/struct-derived-zeros.c new file mode 100644 index 0000000000..f07841af64 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/struct-derived-zeros.c @@ -0,0 +1,61 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2001 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +/* Based on code from Jeff Parker at IBM. */ + +#include + +#include +#include "mpitest.h" + +int main(int argc, char *argv[]) +{ + MPI_Datatype mystruct, vecs[3]; + MPI_Aint stride = 5, displs[3]; + int i=0, blockcount[3]; + int errs=0; + + MTest_Init( &argc, &argv ); + + for(i = 0; i < 3; i++) + { + MPI_Type_hvector(i, 1, stride, MPI_INT, &vecs[i]); + MPI_Type_commit(&vecs[i]); + blockcount[i]=1; + } + displs[0]=0; displs[1]=-100; displs[2]=-200; /* irrelevant */ + + MPI_Type_struct(3, blockcount, displs, vecs, &mystruct); + MPI_Type_commit(&mystruct); + + MPI_Type_free(&mystruct); + for(i = 0; i < 3; i++) + { + MPI_Type_free(&vecs[i]); + } + + /* this time with the first argument always 0 */ + for(i = 0; i < 3; i++) + { + MPI_Type_hvector(0, 1, stride, MPI_INT, &vecs[i]); + MPI_Type_commit(&vecs[i]); + blockcount[i]=1; + } + displs[0]=0; displs[1]=-100; displs[2]=-200; /* irrelevant */ + + MPI_Type_struct(3, blockcount, displs, vecs, &mystruct); + MPI_Type_commit(&mystruct); + + MPI_Type_free(&mystruct); + for(i = 0; i < 3; i++) + { + MPI_Type_free(&vecs[i]); + } + + MTest_Finalize( errs ); + MPI_Finalize(); + + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/datatype/struct-empty-el.c b/teshsuite/smpi/mpich3-test/datatype/struct-empty-el.c new file mode 100644 index 0000000000..3704293a61 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/struct-empty-el.c @@ -0,0 +1,210 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2001 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include +#include +#include +#include +#include "mpi.h" + +static int verbose = 0; + +int main(int argc, char *argv[]); +int parse_args(int argc, char **argv); +int single_struct_test(void); + +struct test_struct_1 { + int a,b,c,d; +}; + +int main(int argc, char *argv[]) +{ + int err, errs = 0; + + /* Initialize MPI */ + MPI_Init(&argc, &argv); + parse_args(argc, argv); + + /* To improve reporting of problems about operations, we + change the error handler to errors return */ + MPI_Comm_set_errhandler( MPI_COMM_WORLD, MPI_ERRORS_RETURN ); + + err = single_struct_test(); + if (verbose && err) fprintf(stderr, "error in single_struct_test\n"); + errs += err; + + /* print message and exit */ + if (errs) { + fprintf(stderr, "Found %d errors\n", errs); + } + else { + printf(" No Errors\n"); + } + MPI_Finalize(); + return 0; +} + +int single_struct_test(void) +{ + int err, errs = 0; + int count, elements; + int sendbuf[6] = { 1, 2, 3, 4, 5, 6 }; + struct test_struct_1 ts1[2]; + MPI_Datatype mystruct; + MPI_Request request; + MPI_Status status; + + /* note: first element of struct has zero blklen and should be dropped */ + MPI_Aint disps[3] = { 2*sizeof(float), 0, 2*sizeof(int) }; + int blks[3] = { 0, 1, 2 }; + MPI_Datatype types[3] = { MPI_FLOAT, MPI_INT, MPI_INT }; + + ts1[0].a = -1; + ts1[0].b = -1; + ts1[0].c = -1; + ts1[0].d = -1; + + ts1[1].a = -1; + ts1[1].b = -1; + ts1[1].c = -1; + ts1[1].d = -1; + + err = MPI_Type_struct(3, blks, disps, types, &mystruct); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Type_struct returned error\n"); + } + } + + MPI_Type_commit(&mystruct); + + err = MPI_Irecv(ts1, 2, mystruct, 0, 0, MPI_COMM_SELF, &request); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Irecv returned error\n"); + } + } + + err = MPI_Send(sendbuf, 6, MPI_INT, 0, 0, MPI_COMM_SELF); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Send returned error\n"); + } + } + + err = MPI_Wait(&request, &status); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Wait returned error\n"); + } + } + + /* verify data */ + if (ts1[0].a != 1) { + errs++; + if (verbose) { + fprintf(stderr, "ts1[0].a = %d; should be %d\n", ts1[0].a, 1); + } + } + if (ts1[0].b != -1) { + errs++; + if (verbose) { + fprintf(stderr, "ts1[0].b = %d; should be %d\n", ts1[0].b, -1); + } + } + if (ts1[0].c != 2) { + errs++; + if (verbose) { + fprintf(stderr, "ts1[0].c = %d; should be %d\n", ts1[0].c, 2); + } + } + if (ts1[0].d != 3) { + errs++; + if (verbose) { + fprintf(stderr, "ts1[0].d = %d; should be %d\n", ts1[0].d, 3); + } + } + if (ts1[1].a != 4) { + errs++; + if (verbose) { + fprintf(stderr, "ts1[1].a = %d; should be %d\n", ts1[1].a, 4); + } + } + if (ts1[1].b != -1) { + errs++; + if (verbose) { + fprintf(stderr, "ts1[1].b = %d; should be %d\n", ts1[1].b, -1); + } + } + if (ts1[1].c != 5) { + errs++; + if (verbose) { + fprintf(stderr, "ts1[1].c = %d; should be %d\n", ts1[1].c, 5); + } + } + if (ts1[1].d != 6) { + errs++; + if (verbose) { + fprintf(stderr, "ts1[1].d = %d; should be %d\n", ts1[1].d, 6); + } + } + + /* verify count and elements */ + err = MPI_Get_count(&status, mystruct, &count); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Get_count returned error\n"); + } + } + if (count != 2) { + errs++; + if (verbose) { + fprintf(stderr, "count = %d; should be 2\n", count); + } + } + + err = MPI_Get_elements(&status, mystruct, &elements); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Get_elements returned error\n"); + } + } + if (elements != 6) { + errs++; + if (verbose) { + fprintf(stderr, "elements = %d; should be 6\n", elements); + } + } + + MPI_Type_free(&mystruct); + + return errs; +} + + +int parse_args(int argc, char **argv) +{ + /* + int ret; + + while ((ret = getopt(argc, argv, "v")) >= 0) + { + switch (ret) { + case 'v': + verbose = 1; + break; + } + } + */ + if (argc > 1 && strcmp(argv[1], "-v") == 0) + verbose = 1; + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/datatype/struct-ezhov.c b/teshsuite/smpi/mpich3-test/datatype/struct-ezhov.c new file mode 100644 index 0000000000..036eaf6417 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/struct-ezhov.c @@ -0,0 +1,59 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2008 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include +#include +#include "mpi.h" +#include + +#define COUNT 14 +#define SIZE 340 +#define EL_COUNT 1131 + +char s_buf[EL_COUNT*SIZE]; +char r_buf[EL_COUNT*SIZE]; + +int main( int argc, char **argv ) +{ + int rank, size, ret; + MPI_Status Status; + MPI_Request request; + MPI_Datatype struct_type, type1[COUNT]; + MPI_Aint disp1[COUNT] = {0, 0, 332, 340}; + int block1[COUNT] = {1, 56, 2, 1}; + + MPI_Init(&argc, &argv); + MPI_Comm_rank(MPI_COMM_WORLD, &rank); + MPI_Comm_size(MPI_COMM_WORLD, &size); + + type1[0] = MPI_LB; + type1[1] = MPI_FLOAT; + type1[2] = MPI_FLOAT; + type1[3] = MPI_UB; + + MPI_Type_struct(4, block1, disp1, type1, &struct_type); + + ret = MPI_Type_commit(&struct_type); + if (ret != MPI_SUCCESS) + { + fprintf(stderr, "Could not make struct type."), fflush(stderr); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + + memset(s_buf, 0, EL_COUNT*SIZE); + memset(r_buf, 0, EL_COUNT*SIZE); + + MPI_Isend(s_buf, EL_COUNT, struct_type, 0, 4, MPI_COMM_WORLD, &request); + MPI_Recv(r_buf, EL_COUNT, struct_type, 0, 4, MPI_COMM_WORLD, &Status ); + MPI_Wait(&request, &Status); + + MPI_Type_free(&struct_type); + + MPI_Finalize(); + + printf(" No Errors\n"); + + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/datatype/struct-no-real-types.c b/teshsuite/smpi/mpich3-test/datatype/struct-no-real-types.c new file mode 100644 index 0000000000..a1bded089c --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/struct-no-real-types.c @@ -0,0 +1,147 @@ +/* -*- 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 +#include +#include "mpitest.h" +#include "mpitestconf.h" +#ifdef HAVE_STRING_H +#include +#endif + +/* + The default behavior of the test routines should be to briefly indicate + the cause of any errors - in this test, that means that verbose needs + to be set. Verbose should turn on output that is independent of error + levels. +*/ +static int verbose = 1; + +/* tests */ +int no_real_types_test(void); + +/* helper functions */ +int parse_args(int argc, char **argv); + +int main(int argc, char **argv) +{ + int err, errs = 0; + + MTest_Init(&argc, &argv); + parse_args(argc, argv); + + /* To improve reporting of problems about operations, we + change the error handler to errors return */ + MPI_Comm_set_errhandler( MPI_COMM_WORLD, MPI_ERRORS_RETURN ); + + /* perform some tests */ + err = no_real_types_test(); + if (err && verbose) fprintf(stderr, "%d errors in blockindexed test.\n", + err); + errs += err; + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} + +/* no_real_types_test() + * + * Tests behavior with an empty struct type + * + * Returns the number of errors encountered. + */ +int no_real_types_test(void) +{ + int err, errs = 0; + + int count = 1; + int len = 1; + MPI_Aint disp = 10; + MPI_Datatype type = MPI_LB; + MPI_Datatype newtype; + + int size; + MPI_Aint extent; + + err = MPI_Type_create_struct(count, + &len, + &disp, + &type, + &newtype); + if (err != MPI_SUCCESS) { + if (verbose) { + fprintf(stderr, + "error creating struct type no_real_types_test()\n"); + } + MTestPrintError( err ); + errs++; + } + + err = MPI_Type_size(newtype, &size); + if (err != MPI_SUCCESS) { + if (verbose) { + fprintf(stderr, + "error obtaining type size in no_real_types_test()\n"); + } + MTestPrintError( err ); + errs++; + } + + if (size != 0) { + if (verbose) { + fprintf(stderr, + "error: size != 0 in no_real_types_test()\n"); + } + errs++; + } + + err = MPI_Type_extent(newtype, &extent); + if (err != MPI_SUCCESS) { + if (verbose) { + fprintf(stderr, + "error obtaining type extent in no_real_types_test()\n"); + } + MTestPrintError( err ); + errs++; + } + + if (extent != -10) { + if (verbose) { + fprintf(stderr, + "error: extent is %ld but should be -10 in no_real_types_test()\n", + (long) extent ); + fprintf( stderr, + "type map is { (LB,10) }, so UB is 0 and extent is ub-lb\n" ); + } + errs++; + } + + MPI_Type_free( &newtype ); + + return errs; +} + + +int parse_args(int argc, char **argv) +{ + /* + int ret; + + while ((ret = getopt(argc, argv, "v")) >= 0) + { + switch (ret) { + case 'v': + verbose = 1; + break; + } + } + */ + if (argc > 1 && strcmp(argv[1], "-v") == 0) + verbose = 1; + return 0; +} + diff --git a/teshsuite/smpi/mpich3-test/datatype/struct-pack.c b/teshsuite/smpi/mpich3-test/datatype/struct-pack.c new file mode 100644 index 0000000000..d7b5719a44 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/struct-pack.c @@ -0,0 +1,417 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2001 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include +#include +#include +#include +#include "mpi.h" + +static int verbose = 0; + +int main(int argc, char *argv[]); +int parse_args(int argc, char **argv); +int single_struct_test(void); +int array_of_structs_test(void); +int struct_of_structs_test(void); + +struct test_struct_1 { + int a,b; + char c,d; + int e; +}; + +int main(int argc, char *argv[]) +{ + int err, errs = 0; + + /* Initialize MPI */ + MPI_Init(&argc, &argv); + parse_args(argc, argv); + + /* To improve reporting of problems about operations, we + change the error handler to errors return */ + MPI_Comm_set_errhandler( MPI_COMM_WORLD, MPI_ERRORS_RETURN ); + + err = single_struct_test(); + if (verbose && err) fprintf(stderr, "error in single_struct_test\n"); + errs += err; + + err = array_of_structs_test(); + if (verbose && err) fprintf(stderr, "error in array_of_structs_test\n"); + errs += err; + + err = struct_of_structs_test(); + if (verbose && err) fprintf(stderr, "error in struct_of_structs_test\n"); + errs += err; + + /* print message and exit */ + if (errs) { + fprintf(stderr, "Found %d errors\n", errs); + } + else { + printf(" No Errors\n"); + } + MPI_Finalize(); + return 0; +} + +int single_struct_test(void) +{ + int err, errs = 0; + int bufsize, position = 0; + struct test_struct_1 ts1, ts2; + MPI_Datatype mystruct; + char *buffer; + + MPI_Aint disps[3] = {0, 2*sizeof(int), 3*sizeof(int)}; /* guessing... */ + int blks[3] = { 2, 2, 1 }; + MPI_Datatype types[3] = { MPI_INT, MPI_CHAR, MPI_INT }; + + ts1.a = 1; + ts1.b = 2; + ts1.c = 3; + ts1.d = 4; + ts1.e = 5; + + err = MPI_Type_struct(3, blks, disps, types, &mystruct); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Type_struct returned error\n"); + } + } + + MPI_Type_commit(&mystruct); + + MPI_Pack_size(1, mystruct, MPI_COMM_WORLD, &bufsize); + buffer = (char *) malloc(bufsize); + + err = MPI_Pack(&ts1, + 1, + mystruct, + buffer, + bufsize, + &position, + MPI_COMM_WORLD); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Pack returned error\n"); + } + } + + position = 0; + err = MPI_Unpack(buffer, + bufsize, + &position, + &ts2, + 1, + mystruct, + MPI_COMM_WORLD); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Unpack returned error\n"); + } + } + + MPI_Type_free(&mystruct); + free(buffer); + + if (ts1.a != ts2.a) { + errs++; + if (verbose) { + fprintf(stderr, "ts2.a = %d; should be %d\n", ts2.a, ts1.a); + } + } + if (ts1.b != ts2.b) { + errs++; + if (verbose) { + fprintf(stderr, "ts2.b = %d; should be %d\n", ts2.b, ts1.b); + } + } + if (ts1.c != ts2.c) { + errs++; + if (verbose) { + fprintf(stderr, "ts2.c = %d; should be %d\n", + (int) ts2.c, (int) ts1.c); + } + } + if (ts1.d != ts2.d) { + errs++; + if (verbose) { + fprintf(stderr, "ts2.d = %d; should be %d\n", + (int) ts2.d, (int) ts1.d); + } + } + if (ts1.e != ts2.e) { + errs++; + if (verbose) { + fprintf(stderr, "ts2.e = %d; should be %d\n", ts2.e, ts1.e); + } + } + + return errs; +} + +int array_of_structs_test(void) +{ + int i, err, errs = 0; + int bufsize, position = 0; + struct test_struct_1 ts1[10], ts2[10]; + MPI_Datatype mystruct; + char *buffer; + + MPI_Aint disps[3] = {0, 2*sizeof(int), 3*sizeof(int)}; /* guessing... */ + int blks[3] = { 2, 2, 1 }; + MPI_Datatype types[3] = { MPI_INT, MPI_CHAR, MPI_INT }; + + for (i=0; i < 10; i++) { + ts1[i].a = 10*i + 1; + ts1[i].b = 10*i + 2; + ts1[i].c = 10*i + 3; + ts1[i].d = 10*i + 4; + ts1[i].e = 10*i + 5; + + ts2[i].a = -13; + ts2[i].b = -13; + ts2[i].c = -13; + ts2[i].d = -13; + ts2[i].e = -13; + } + + err = MPI_Type_struct(3, blks, disps, types, &mystruct); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Type_struct returned error\n"); + } + } + + MPI_Type_commit(&mystruct); + + MPI_Pack_size(10, mystruct, MPI_COMM_WORLD, &bufsize); + buffer = (char *) malloc(bufsize); + + err = MPI_Pack(ts1, + 10, + mystruct, + buffer, + bufsize, + &position, + MPI_COMM_WORLD); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Pack returned error\n"); + } + } + + position = 0; + err = MPI_Unpack(buffer, + bufsize, + &position, + ts2, + 10, + mystruct, + MPI_COMM_WORLD); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Unpack returned error\n"); + } + } + + MPI_Type_free(&mystruct); + free(buffer); + + for (i=0; i < 10; i++) { + if (ts1[i].a != ts2[i].a) { + errs++; + if (verbose) { + fprintf(stderr, "ts2[%d].a = %d; should be %d\n", + i, ts2[i].a, ts1[i].a); + } + } + if (ts1[i].b != ts2[i].b) { + errs++; + if (verbose) { + fprintf(stderr, "ts2[%d].b = %d; should be %d\n", + i, ts2[i].b, ts1[i].b); + } + } + if (ts1[i].c != ts2[i].c) { + errs++; + if (verbose) { + fprintf(stderr, "ts2[%d].c = %d; should be %d\n", + i, (int) ts2[i].c, (int) ts1[i].c); + } + } + if (ts1[i].d != ts2[i].d) { + errs++; + if (verbose) { + fprintf(stderr, "ts2[%d].d = %d; should be %d\n", + i, (int) ts2[i].d, (int) ts1[i].d); + } + } + if (ts1[i].e != ts2[i].e) { + errs++; + if (verbose) { + fprintf(stderr, "ts2[%d].e = %d; should be %d\n", + i, ts2[i].e, ts1[i].e); + } + } + } + + return errs; +} + +int struct_of_structs_test(void) +{ + int i, j, err, errs = 0, bufsize, position; + + char buf[50], buf2[50], *packbuf; + + MPI_Aint disps[3] = {0, 3, 0}; + int blks[3] = {2, 1, 0}; + MPI_Datatype types[3], chartype, tiletype1, tiletype2, finaltype; + + /* build a contig of one char to try to keep optimizations + * from being applied. + */ + err = MPI_Type_contiguous(1, MPI_CHAR, &chartype); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "chartype create failed\n"); + } + return errs; + } + + /* build a type that we can tile a few times */ + types[0] = MPI_CHAR; + types[1] = chartype; + + err = MPI_Type_struct(2, blks, disps, types, &tiletype1); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "tiletype1 create failed\n"); + } + return errs; + } + + /* build the same type again, again to avoid optimizations */ + err = MPI_Type_struct(2, blks, disps, types, &tiletype2); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "tiletype2 create failed\n"); + } + return errs; + } + + /* build a combination of those two tiletypes */ + disps[0] = 0; + disps[1] = 5; + disps[2] = 10; + blks[0] = 1; + blks[1] = 1; + blks[2] = 1; + types[0] = tiletype1; + types[1] = tiletype2; + types[2] = MPI_UB; + err = MPI_Type_struct(3, blks, disps, types, &finaltype); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "finaltype create failed\n"); + } + return errs; + } + + MPI_Type_commit(&finaltype); + MPI_Type_free(&chartype); + MPI_Type_free(&tiletype1); + MPI_Type_free(&tiletype2); + + MPI_Pack_size(5, finaltype, MPI_COMM_WORLD, &bufsize); + + packbuf = malloc(bufsize); + if (packbuf == NULL) { + errs++; + if (verbose) { + fprintf(stderr, "pack buffer allocation (%d bytes) failed\n", bufsize); + } + return errs; + } + + for (j=0; j < 10; j++) { + for (i=0; i < 5; i++) { + if (i == 2 || i == 4) buf[5*j + i] = 0; + else buf[5*j + i] = i; + } + } + + position = 0; + err = MPI_Pack(buf, 5, finaltype, packbuf, bufsize, &position, MPI_COMM_WORLD); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "pack failed\n"); + } + return errs; + } + + memset(buf2, 0, 50); + position = 0; + err = MPI_Unpack(packbuf, bufsize, &position, buf2, 5, finaltype, MPI_COMM_WORLD); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "unpack failed\n"); + } + return errs; + } + + for (j=0; j < 10; j++) { + for (i=0; i < 5; i++) { + if (buf[5*j + i] != buf2[5*j + i]) { + errs++; + if (verbose) { + fprintf(stderr, + "buf2[%d] = %d; should be %d\n", + 5*j + i, + (int) buf2[5*j+i], + (int) buf[5*j+i]); + } + } + } + } + + free(packbuf); + MPI_Type_free(&finaltype); + return errs; +} + +int parse_args(int argc, char **argv) +{ + /* + int ret; + + while ((ret = getopt(argc, argv, "v")) >= 0) + { + switch (ret) { + case 'v': + verbose = 1; + break; + } + } + */ + if (argc > 1 && strcmp(argv[1], "-v") == 0) + verbose = 1; + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/datatype/struct-verydeep.c b/teshsuite/smpi/mpich3-test/datatype/struct-verydeep.c new file mode 100644 index 0000000000..f8bf884e85 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/struct-verydeep.c @@ -0,0 +1,187 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2009 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +/* Regression test for MPICH trac ticket #972, originally written by + * Rob Latham as a simplification of a type + * encountered by the HDF5 library. + * + * Should be run with 1 process. */ + +#include +#include "mpi.h" + +/* uncomment to use debugging routine in MPICH +extern int MPIDU_Datatype_debug(MPI_Datatype type, int depth); +*/ + +int makeHDF5type0(MPI_Datatype *type); +int makeHDF5type0(MPI_Datatype *type) +{ + MPI_Datatype ctg, vect, structype, vec2, structype2, + vec3, structype3, vec4, structype4, vec5; + + int b[3]; + MPI_Aint d[3]; + MPI_Datatype t[3]; + + MPI_Type_contiguous(4, MPI_BYTE, &ctg); + + MPI_Type_vector(1, 5, 1, ctg, &vect); + + b[0] = b[1] = b[2] = 1; + d[0] = 0; d[1] = 0; d[2] = 40; + t[0] = MPI_LB; t[1] = vect; t[2] = MPI_UB; + MPI_Type_create_struct(3, b, d, t, &structype); + + MPI_Type_vector(1, 5, 1, structype, &vec2); + + b[0] = b[1] = b[2] = 1; + d[0] = 0; d[1] = 2000; d[2] = 400; + t[0] = MPI_LB; t[1] = vec2; t[2] = MPI_UB; + MPI_Type_create_struct(3, b, d, t, &structype2); + + MPI_Type_vector(1, 5, 1, structype2, &vec3); + + b[0] = b[1] = b[2] = 1; + d[0] = 0; d[1] = 0; d[2] = 4000; + t[0] = MPI_LB; t[1] = vec3; t[2] = MPI_UB; + MPI_Type_create_struct(3, b, d, t, &structype3); + + MPI_Type_vector(1, 5, 1, structype3, &vec4); + + b[0] = b[1] = b[2] = 1; + d[0] = 0; d[1] = 0; d[2] = 40000; + t[0] = MPI_LB; t[1] = vec4; t[2] = MPI_UB; + MPI_Type_create_struct(3, b, d, t, &structype4); + + MPI_Type_vector(1, 1, 1, structype4, &vec5); + + b[0] = b[1] = b[2] = 1; + d[0] = 0; d[1] = 160000; d[2] = 200000; + t[0] = MPI_LB; t[1] = vec5; t[2] = MPI_UB; + MPI_Type_create_struct(3, b, d, t, type); + + MPI_Type_free(&ctg); + MPI_Type_free(&vect); + MPI_Type_free(&structype); + MPI_Type_free(&vec2); + MPI_Type_free(&structype2); + MPI_Type_free(&vec3); + MPI_Type_free(&structype3); + MPI_Type_free(&vec4); + MPI_Type_free(&structype4); + MPI_Type_free(&vec5); + MPI_Type_commit(type); + + return 0; +} + +int makeHDF5type1(MPI_Datatype *type); +int makeHDF5type1(MPI_Datatype *type) +{ + MPI_Datatype ctg, vect, structype, vec2, structype2, + vec3, structype3, vec4, structype4, vec5; + + int b[3]; + MPI_Aint d[3]; + MPI_Datatype t[3]; + + MPI_Type_contiguous(4, MPI_BYTE, &ctg); + + MPI_Type_vector(1, 5, 1, ctg, &vect); + + b[0] = b[1] = b[2] = 1; + d[0] = 0; d[1] = 20; d[2] = 40; + t[0] = MPI_LB; t[1] = vect; t[2] = MPI_UB; + MPI_Type_create_struct(3, b, d, t, &structype); + + MPI_Type_vector(1, 5, 1, structype, &vec2); + + b[0] = b[1] = b[2] = 1; + d[0] = 0; d[1] = 0; d[2] = 400; + t[0] = MPI_LB; t[1] = vec2; t[2] = MPI_UB; + MPI_Type_create_struct(3, b, d, t, &structype2); + + MPI_Type_vector(1, 5, 1, structype2, &vec3); + + b[0] = b[1] = b[2] = 1; + d[0] = 0; d[1] = 0; d[2] = 4000; + t[0] = MPI_LB; t[1] = vec3; t[2] = MPI_UB; + MPI_Type_create_struct(3, b, d, t, &structype3); + + MPI_Type_vector(1, 5, 1, structype3, &vec4); + + b[0] = b[1] = b[2] = 1; + d[0] = 0; d[1] = 0; d[2] = 40000; + t[0] = MPI_LB; t[1] = vec4; t[2] = MPI_UB; + MPI_Type_create_struct(3, b, d, t, &structype4); + + MPI_Type_vector(1, 1, 1, structype4, &vec5); + + b[0] = b[1] = b[2] = 1; + d[0] = 0; d[1] = 160000; d[2] = 200000; + t[0] = MPI_LB; t[1] = vec5; t[2] = MPI_UB; + MPI_Type_create_struct(3, b, d, t, type); + + MPI_Type_free(&ctg); + MPI_Type_free(&vect); + MPI_Type_free(&structype); + MPI_Type_free(&vec2); + MPI_Type_free(&structype2); + MPI_Type_free(&vec3); + MPI_Type_free(&structype3); + MPI_Type_free(&vec4); + MPI_Type_free(&structype4); + MPI_Type_free(&vec5); + MPI_Type_commit(type); + + return 0; +} + +int makeHDF5type(MPI_Datatype *type); +int makeHDF5type(MPI_Datatype *type) +{ + int i; + +#define NTYPES 2 + + int blocklens[NTYPES]; + MPI_Aint disps[NTYPES]; + + MPI_Datatype types[NTYPES]; + makeHDF5type0(&(types[0])); + makeHDF5type1(&(types[1])); + + for (i=0; i< NTYPES; i++) { + blocklens[i] = 1; + disps[i] = 0; + } + + MPI_Type_create_struct(NTYPES, blocklens, disps, types, type); + MPI_Type_commit(type); + + for(i=0; i +#include +#include "mpitestconf.h" +#ifdef HAVE_STRING_H +#include +#endif + +static int verbose = 0; + +/* tests */ +int builtin_struct_test(void); + +/* helper functions */ +int parse_args(int argc, char **argv); + +int main(int argc, char **argv) +{ + int err, errs = 0; + + MPI_Init(&argc, &argv); /* MPI-1.2 doesn't allow for MPI_Init(0,0) */ + parse_args(argc, argv); + + /* To improve reporting of problems about operations, we + change the error handler to errors return */ + MPI_Comm_set_errhandler( MPI_COMM_WORLD, MPI_ERRORS_RETURN ); + + /* perform some tests */ + err = builtin_struct_test(); + if (err && verbose) fprintf(stderr, "%d errors in builtin struct test.\n", err); + errs += err; + + /* print message and exit */ + if (errs) { + fprintf(stderr, "Found %d errors\n", errs); + } + else { + printf(" No Errors\n"); + } + MPI_Finalize(); + return 0; +} + +/* builtin_struct_test() + * + * Tests behavior with a zero-count struct of builtins. + * + * Returns the number of errors encountered. + */ +int builtin_struct_test(void) +{ + int err, errs = 0; + + int count = 0; + MPI_Datatype newtype; + + int size; + MPI_Aint extent; + + err = MPI_Type_create_struct(count, + (int *) 0, + (MPI_Aint *) 0, + (MPI_Datatype *) 0, + &newtype); + if (err != MPI_SUCCESS) { + if (verbose) { + fprintf(stderr, + "error creating struct type in builtin_struct_test()\n"); + } + errs++; + } + + err = MPI_Type_size(newtype, &size); + if (err != MPI_SUCCESS) { + if (verbose) { + fprintf(stderr, + "error obtaining type size in builtin_struct_test()\n"); + } + errs++; + } + + if (size != 0) { + if (verbose) { + fprintf(stderr, + "error: size != 0 in builtin_struct_test()\n"); + } + errs++; + } + + err = MPI_Type_extent(newtype, &extent); + if (err != MPI_SUCCESS) { + if (verbose) { + fprintf(stderr, + "error obtaining type extent in builtin_struct_test()\n"); + } + errs++; + } + + if (extent != 0) { + if (verbose) { + fprintf(stderr, + "error: extent != 0 in builtin_struct_test()\n"); + } + errs++; + } + + MPI_Type_free( &newtype ); + + return errs; +} + + +int parse_args(int argc, char **argv) +{ + /* + int ret; + + while ((ret = getopt(argc, argv, "v")) >= 0) + { + switch (ret) { + case 'v': + verbose = 1; + break; + } + } + */ + if (argc > 1 && strcmp(argv[1], "-v") == 0) + verbose = 1; + return 0; +} + diff --git a/teshsuite/smpi/mpich3-test/datatype/subarray-pack.c b/teshsuite/smpi/mpich3-test/datatype/subarray-pack.c new file mode 100644 index 0000000000..79cd40be3d --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/subarray-pack.c @@ -0,0 +1,748 @@ +/* -*- 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 +#include +#include + +static int verbose = 0; + +/* tests */ +int subarray_1d_c_test1(void); +int subarray_1d_fortran_test1(void); +int subarray_2d_c_test1(void); +int subarray_4d_c_test1(void); +int subarray_2d_c_test2(void); +int subarray_2d_fortran_test1(void); +int subarray_4d_fortran_test1(void); + +/* helper functions */ +static int parse_args(int argc, char **argv); +static int pack_and_unpack(char *typebuf, + int count, + MPI_Datatype datatype, + int typebufsz); + +int main(int argc, char **argv) +{ + int err, errs = 0; + + MPI_Init(&argc, &argv); /* MPI-1.2 doesn't allow for MPI_Init(0,0) */ + parse_args(argc, argv); + + /* To improve reporting of problems about operations, we + change the error handler to errors return */ + MPI_Comm_set_errhandler( MPI_COMM_WORLD, MPI_ERRORS_RETURN ); + + /* perform some tests */ + err = subarray_1d_c_test1(); + if (err && verbose) fprintf(stderr, + "%d errors in 1d subarray c test 1.\n", err); + errs += err; + + err = subarray_1d_fortran_test1(); + if (err && verbose) fprintf(stderr, + "%d errors in 1d subarray fortran test 1.\n", + err); + errs += err; + + err = subarray_2d_c_test1(); + if (err && verbose) fprintf(stderr, + "%d errors in 2d subarray c test 1.\n", err); + errs += err; + + err = subarray_2d_fortran_test1(); + if (err && verbose) fprintf(stderr, + "%d errors in 2d subarray fortran test 1.\n", + err); + errs += err; + + err = subarray_2d_c_test2(); + if (err && verbose) fprintf(stderr, + "%d errors in 2d subarray c test 2.\n", err); + errs += err; + + err = subarray_4d_c_test1(); + if (err && verbose) fprintf(stderr, + "%d errors in 4d subarray c test 1.\n", err); + errs += err; + + err = subarray_4d_fortran_test1(); + if (err && verbose) fprintf(stderr, + "%d errors in 4d subarray fortran test 1.\n", err); + errs += err; + + /* print message and exit */ + if (errs) { + fprintf(stderr, "Found %d errors\n", errs); + } + else { + printf(" No Errors\n"); + } + MPI_Finalize(); + return 0; +} + +/* subarray_1d_c_test1() + * + * Returns the number of errors encountered. + */ +int subarray_1d_c_test1(void) +{ + MPI_Datatype subarray; + int array[9] = { -1, 1, 2, 3, -2, -3, -4, -5, -6 }; + int array_size[] = {9}; + int array_subsize[] = {3}; + int array_start[] = {1}; + + int i, err, errs = 0, sizeoftype; + + /* set up type */ + err = MPI_Type_create_subarray(1, /* dims */ + array_size, + array_subsize, + array_start, + MPI_ORDER_C, + MPI_INT, + &subarray); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, + "error in MPI_Type_create_subarray call; aborting after %d errors\n", + errs); + } + return errs; + } + + MPI_Type_commit(&subarray); + MPI_Type_size(subarray, &sizeoftype); + if (sizeoftype != 3 * sizeof(int)) { + errs++; + if (verbose) fprintf(stderr, "size of type = %d; should be %d\n", + sizeoftype, (int) (3 * sizeof(int))); + return errs; + } + + err = pack_and_unpack((char *) array, 1, subarray, 9 * sizeof(int)); + + for (i=0; i < 9; i++) { + int goodval; + switch (i) { + case 1: + goodval = 1; + break; + case 2: + goodval = 2; + break; + case 3: + goodval = 3; + break; + default: + goodval = 0; /* pack_and_unpack() zeros before unpacking */ + break; + } + if (array[i] != goodval) { + errs++; + if (verbose) fprintf(stderr, "array[%d] = %d; should be %d\n", + i, array[i], goodval); + } + } + + MPI_Type_free(&subarray); + return errs; +} + +/* subarray_1d_fortran_test1() + * + * Returns the number of errors encountered. + */ +int subarray_1d_fortran_test1(void) +{ + MPI_Datatype subarray; + int array[9] = { -1, 1, 2, 3, -2, -3, -4, -5, -6 }; + int array_size[] = {9}; + int array_subsize[] = {3}; + int array_start[] = {1}; + + int i, err, errs = 0, sizeoftype; + + /* set up type */ + err = MPI_Type_create_subarray(1, /* dims */ + array_size, + array_subsize, + array_start, + MPI_ORDER_FORTRAN, + MPI_INT, + &subarray); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, + "error in MPI_Type_create_subarray call; aborting after %d errors\n", + errs); + } + return errs; + } + + MPI_Type_commit(&subarray); + MPI_Type_size(subarray, &sizeoftype); + if (sizeoftype != 3 * sizeof(int)) { + errs++; + if (verbose) fprintf(stderr, "size of type = %d; should be %d\n", + sizeoftype, (int) (3 * sizeof(int))); + return errs; + } + + err = pack_and_unpack((char *) array, 1, subarray, 9 * sizeof(int)); + + for (i=0; i < 9; i++) { + int goodval; + switch (i) { + case 1: + goodval = 1; + break; + case 2: + goodval = 2; + break; + case 3: + goodval = 3; + break; + default: + goodval = 0; /* pack_and_unpack() zeros before unpacking */ + break; + } + if (array[i] != goodval) { + errs++; + if (verbose) fprintf(stderr, "array[%d] = %d; should be %d\n", + i, array[i], goodval); + } + } + + MPI_Type_free(&subarray); + return errs; +} + + +/* subarray_2d_test() + * + * Returns the number of errors encountered. + */ +int subarray_2d_c_test1(void) +{ + MPI_Datatype subarray; + int array[9] = { -1, -2, -3, + -4, 1, 2, + -5, 3, 4 }; + int array_size[2] = {3, 3}; + int array_subsize[2] = {2, 2}; + int array_start[2] = {1, 1}; + + int i, err, errs = 0, sizeoftype; + + /* set up type */ + err = MPI_Type_create_subarray(2, /* dims */ + array_size, + array_subsize, + array_start, + MPI_ORDER_C, + MPI_INT, + &subarray); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, + "error in MPI_Type_create_subarray call; aborting after %d errors\n", + errs); + } + return errs; + } + + MPI_Type_commit(&subarray); + MPI_Type_size(subarray, &sizeoftype); + if (sizeoftype != 4*sizeof(int)) { + errs++; + if (verbose) fprintf(stderr, "size of type = %d; should be %d\n", + sizeoftype, (int) (4*sizeof(int))); + return errs; + } + + err = pack_and_unpack((char *) array, 1, subarray, 9*sizeof(int)); + + for (i=0; i < 9; i++) { + int goodval; + switch (i) { + case 4: + goodval = 1; + break; + case 5: + goodval = 2; + break; + case 7: + goodval = 3; + break; + case 8: + goodval = 4; + break; + default: + goodval = 0; + break; + } + if (array[i] != goodval) { + errs++; + if (verbose) fprintf(stderr, "array[%d] = %d; should be %d\n", + i, array[i], goodval); + } + } + + MPI_Type_free(&subarray); + return errs; +} + +/* subarray_2d_c_test2() + * + * Returns the number of errors encountered. + */ +int subarray_2d_c_test2(void) +{ + MPI_Datatype subarray; + int array[12] = { -1, -2, -3, -4, 1, 2, + -5, -6, -7, -8, -9, -10 }; + int array_size[2] = {2, 6}; + int array_subsize[2] = {1, 2}; + int array_start[2] = {0, 4}; + + int i, err, errs = 0, sizeoftype; + + /* set up type */ + err = MPI_Type_create_subarray(2, /* dims */ + array_size, + array_subsize, + array_start, + MPI_ORDER_C, + MPI_INT, + &subarray); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, + "error in MPI_Type_create_subarray call; aborting after %d errors\n", + errs); + } + return errs; + } + + MPI_Type_commit(&subarray); + MPI_Type_size(subarray, &sizeoftype); + if (sizeoftype != 2*sizeof(int)) { + errs++; + if (verbose) fprintf(stderr, "size of type = %d; should be %d\n", + sizeoftype, (int) (2*sizeof(int))); + return errs; + } + + err = pack_and_unpack((char *) array, 1, subarray, 12*sizeof(int)); + + for (i=0; i < 12; i++) { + int goodval; + switch (i) { + case 4: + goodval = 1; + break; + case 5: + goodval = 2; + break; + default: + goodval = 0; + break; + } + if (array[i] != goodval) { + errs++; + if (verbose) fprintf(stderr, "array[%d] = %d; should be %d\n", + i, array[i], goodval); + } + } + + MPI_Type_free(&subarray); + return errs; +} + +/* subarray_4d_c_test1() + * + * Returns the number of errors encountered. + */ +int subarray_4d_c_test1(void) +{ + MPI_Datatype subarray; + int array[] = { + -1111, -1112, -1113, -1114, -1115, -1116, + -1121, -1122, -1123, -1124, -1125, -1126, + -1131, -1132, -1133, -1134, -1135, -1136, + -1211, -1212, -1213, -1214, -1215, -1216, + -1221, -1222, -1223, -1224, -1225, -1226, + -1231, -1232, -1233, -1234, -1235, -1236, + -2111, -2112, -2113, -2114, 1, -2116, + -2121, -2122, -2123, -2124, 2, -2126, + -2131, -2132, -2133, -2134, 3, -2136, + -2211, -2212, -2213, -2214, 4, -2216, + -2221, -2222, -2223, -2224, 5, -2226, + -2231, -2232, -2233, -2234, 6, -2236 + }; + + int array_size[4] = {2, 2, 3, 6}; + int array_subsize[4] = {1, 2, 3, 1}; + int array_start[4] = {1, 0, 0, 4}; + + int i, err, errs = 0, sizeoftype; + + /* set up type */ + err = MPI_Type_create_subarray(4, /* dims */ + array_size, + array_subsize, + array_start, + MPI_ORDER_C, + MPI_INT, + &subarray); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, + "error in MPI_Type_create_subarray call; aborting after %d errors\n", + errs); + } + return errs; + } + + MPI_Type_commit(&subarray); + MPI_Type_size(subarray, &sizeoftype); + if (sizeoftype != 6*sizeof(int)) { + errs++; + if (verbose) fprintf(stderr, "size of type = %d; should be %d\n", + sizeoftype, (int) (6*sizeof(int))); + return errs; + } + + err = pack_and_unpack((char *) array, 1, subarray, 72*sizeof(int)); + + for (i=0; i < 72; i++) { + int goodval; + switch (i) { + case 40: + goodval = 1; + break; + case 46: + goodval = 2; + break; + case 52: + goodval = 3; + break; + case 58: + goodval = 4; + break; + case 64: + goodval = 5; + break; + case 70: + goodval = 6; + break; + default: + goodval = 0; + break; + } + if (array[i] != goodval) { + errs++; + if (verbose) fprintf(stderr, "array[%d] = %d; should be %d\n", + i, array[i], goodval); + } + } + + MPI_Type_free(&subarray); + return errs; +} +/* subarray_4d_fortran_test1() + * + * Returns the number of errors encountered. + */ +int subarray_4d_fortran_test1(void) +{ + MPI_Datatype subarray; + int array[] = { + -1111, -1112, -1113, -1114, -1115, -1116, + -1121, -1122, -1123, -1124, -1125, -1126, + -1131, -1132, -1133, -1134, -1135, -1136, + -1211, -1212, -1213, -1214, -1215, -1216, + -1221, -1222, -1223, -1224, -1225, -1226, + -1231, -1232, -1233, -1234, -1235, -1236, + -2111, -2112, -2113, -2114, 1, -2116, + -2121, -2122, -2123, -2124, 2, -2126, + -2131, -2132, -2133, -2134, 3, -2136, + -2211, -2212, -2213, -2214, 4, -2216, + -2221, -2222, -2223, -2224, 5, -2226, + -2231, -2232, -2233, -2234, 6, -2236 + }; + + int array_size[4] = {6, 3, 2, 2}; + int array_subsize[4] = {1, 3, 2, 1}; + int array_start[4] = {4, 0, 0, 1}; + + int i, err, errs = 0, sizeoftype; + + /* set up type */ + err = MPI_Type_create_subarray(4, /* dims */ + array_size, + array_subsize, + array_start, + MPI_ORDER_FORTRAN, + MPI_INT, + &subarray); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, + "error in MPI_Type_create_subarray call; aborting after %d errors\n", + errs); + } + return errs; + } + + MPI_Type_commit(&subarray); + MPI_Type_size(subarray, &sizeoftype); + if (sizeoftype != 6*sizeof(int)) { + errs++; + if (verbose) fprintf(stderr, "size of type = %d; should be %d\n", + sizeoftype, (int) (6*sizeof(int))); + return errs; + } + + err = pack_and_unpack((char *) array, 1, subarray, 72*sizeof(int)); + + for (i=0; i < 72; i++) { + int goodval; + switch (i) { + case 40: + goodval = 1; + break; + case 46: + goodval = 2; + break; + case 52: + goodval = 3; + break; + case 58: + goodval = 4; + break; + case 64: + goodval = 5; + break; + case 70: + goodval = 6; + break; + default: + goodval = 0; + break; + } + if (array[i] != goodval) { + errs++; + if (verbose) fprintf(stderr, "array[%d] = %d; should be %d\n", + i, array[i], goodval); + } + } + + MPI_Type_free(&subarray); + return errs; +} + + +/* subarray_2d_fortran_test1() + * + * Returns the number of errors encountered. + */ +int subarray_2d_fortran_test1(void) +{ + MPI_Datatype subarray; + int array[12] = { -1, -2, -3, -4, 1, 2, + -5, -6, -7, -8, -9, -10 }; + int array_size[2] = {6, 2}; + int array_subsize[2] = {2, 1}; + int array_start[2] = {4, 0}; + + int i, err, errs = 0, sizeoftype; + + /* set up type */ + err = MPI_Type_create_subarray(2, /* dims */ + array_size, + array_subsize, + array_start, + MPI_ORDER_FORTRAN, + MPI_INT, + &subarray); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, + "error in MPI_Type_create_subarray call; aborting after %d errors\n", + errs); + } + return errs; + } + + MPI_Type_commit(&subarray); + MPI_Type_size(subarray, &sizeoftype); + if (sizeoftype != 2*sizeof(int)) { + errs++; + if (verbose) fprintf(stderr, "size of type = %d; should be %d\n", + sizeoftype, (int) (2*sizeof(int))); + return errs; + } + + err = pack_and_unpack((char *) array, 1, subarray, 12*sizeof(int)); + + for (i=0; i < 12; i++) { + int goodval; + switch (i) { + case 4: + goodval = 1; + break; + case 5: + goodval = 2; + break; + default: + goodval = 0; + break; + } + if (array[i] != goodval) { + errs++; + if (verbose) fprintf(stderr, "array[%d] = %d; should be %d\n", + i, array[i], goodval); + } + } + + MPI_Type_free(&subarray); + return errs; +} + +/******************************************************************/ + +/* pack_and_unpack() + * + * Perform packing and unpacking of a buffer for the purposes of checking + * to see if we are processing a type correctly. Zeros the buffer between + * these two operations, so the data described by the type should be in + * place upon return but all other regions of the buffer should be zero. + * + * Parameters: + * typebuf - pointer to buffer described by datatype and count that + * will be packed and then unpacked into + * count, datatype - description of typebuf + * typebufsz - size of typebuf; used specifically to zero the buffer + * between the pack and unpack steps + * + */ +static int pack_and_unpack(char *typebuf, + int count, + MPI_Datatype datatype, + int typebufsz) +{ + char *packbuf; + int err, errs = 0, pack_size, type_size, position; + + err = MPI_Type_size(datatype, &type_size); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, + "error in MPI_Type_size call; aborting after %d errors\n", + errs); + } + return errs; + } + + type_size *= count; + + err = MPI_Pack_size(count, datatype, MPI_COMM_SELF, &pack_size); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, + "error in MPI_Pack_size call; aborting after %d errors\n", + errs); + } + return errs; + } + packbuf = (char *) malloc(pack_size); + if (packbuf == NULL) { + errs++; + if (verbose) { + fprintf(stderr, + "error in malloc call; aborting after %d errors\n", + errs); + } + return errs; + } + + position = 0; + err = MPI_Pack(typebuf, + count, + datatype, + packbuf, + type_size, + &position, + MPI_COMM_SELF); + + if (position != type_size) { + errs++; + if (verbose) fprintf(stderr, "position = %d; should be %d (pack)\n", + position, type_size); + } + + memset(typebuf, 0, typebufsz); + position = 0; + err = MPI_Unpack(packbuf, + type_size, + &position, + typebuf, + count, + datatype, + MPI_COMM_SELF); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, + "error in MPI_Unpack call; aborting after %d errors\n", + errs); + } + return errs; + } + free(packbuf); + + if (position != type_size) { + errs++; + if (verbose) fprintf(stderr, "position = %d; should be %d (unpack)\n", + position, type_size); + } + + return errs; +} + +static int parse_args(int argc, char **argv) +{ + /* + int ret; + + while ((ret = getopt(argc, argv, "v")) >= 0) + { + switch (ret) { + case 'v': + verbose = 1; + break; + } + } + */ + if (argc > 1 && strcmp(argv[1], "-v") == 0) + verbose = 1; + return 0; +} + diff --git a/teshsuite/smpi/mpich3-test/datatype/subarray.c b/teshsuite/smpi/mpich3-test/datatype/subarray.c new file mode 100644 index 0000000000..d726b5a23d --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/subarray.c @@ -0,0 +1,71 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2001 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ + +#include +#include +#include "mpi.h" + +#define X 64 +#define Y 8 +#define Z 512 + +double array[X][Y][Z]; + +int main(int argc, char *argv[]) +{ + int myrank; + MPI_Datatype subarray; + int array_size[] = {X, Y, Z}; + int array_subsize[] = {X/2, Y/2, Z}; + int array_start[] = {0, 0, 0}; + int i, j, k; + int errs = 0; + + MPI_Init(&argc, &argv); + MPI_Comm_rank(MPI_COMM_WORLD, &myrank); + + for (i = 0; i < X; ++i) { + for (j = 0; j < Y; ++j) { + for (k = 0; k < Z; ++k) { + if (myrank == 0) + array[i][j][k] = 2.0; + else + array[i][j][k] = -2.0; + } + } + } + + MPI_Type_create_subarray(3, array_size, array_subsize, array_start, MPI_ORDER_C, + MPI_DOUBLE, &subarray); + MPI_Type_commit(&subarray); + + if(myrank == 0) + MPI_Send(array, 1, subarray, 1, 0, MPI_COMM_WORLD); + else { + MPI_Recv(array, 1, subarray, 0, 0, MPI_COMM_WORLD, MPI_STATUS_IGNORE); + for (i = array_start[0]; i < array_subsize[0]; ++i) { + for (j = array_start[1]; j < array_subsize[1]; ++j) { + for (k = array_start[2]; k < array_subsize[2]; ++k) { + if (array[i][j][k] != 2.0) + ++errs; + } + } + } + } + + MPI_Type_free(&subarray); + + MPI_Allreduce(MPI_IN_PLACE, &errs, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD); + if (myrank == 0) { + if (errs) + printf("Found %d errors\n", errs); + else + printf(" No Errors\n"); + } + MPI_Finalize(); + + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/datatype/testlist b/teshsuite/smpi/mpich3-test/datatype/testlist new file mode 100644 index 0000000000..6c35b3d497 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/testlist @@ -0,0 +1,70 @@ +#needs PMPI_Type_get_envelope, PMPI_Type_get_contents +#contents 1 +gaddress 1 +#complex games with negative extents... +#lbub 1 +#needs MPI_Pack, MPI_Unpack +#localpack 1 +#simple-pack 1 +#simple-pack-external 1 +#transpose-pack 1 +#slice-pack 1 +#struct-pack 1 +typecommit 1 +#needs MPI_Type_get_name +#typename 1 +#needs MPI_Type_dup +#typefree 1 +zeroparms 1 +#getpartelm 2 +#needs MPI_Type_create_resized +#tresized 2 +#tresized2 2 +#needs MPI_Type_match_size +#tmatchsize 1 +tfree 2 +typelb 1 +#needs MPI_Pack_size +#contigstruct 1 +struct-zero-count 1 +blockindexed-zero-count 1 +#needs MPI_Pack, MPI_unpack, MPI_Pack_size +#blockindexed-misc 1 +#needs MPI_Pack, MPI_unpack, MPI_Pack_size +#indexed-misc 1 +#nees MPI_Type_create_subarray +#subarray-pack 1 +#subarray 2 +#nees MPI_Type_create_darray +#darray-pack 1 +#darray-pack 9 +# darray-pack 72 +#darray-cyclic 12 +#gcc alignment games +#pairtype-size-extent 1 +simple-commit 1 +simple-size-extent 1 +#struct-no-real-types 1 +#needs MPI_Get_elements +#struct-empty-el 1 +contig-zero-count 1 +#needs MPI_Type_create_resized +#simple-resized 1 +#needs MPI_Pack +#unusual-noncontigs 1 +#buggy, and needs MPI_Get_elements +#hindexed-zeros 1 +#lots-of-types 1 +#get-elements-pairtype 1 +#unpack 1 +struct-ezhov 1 +#needs MPI_Pack, MPI_Unpack +#zeroblks 1 +struct-derived-zeros 1 +struct-verydeep 1 +#get-elements 1 +hindexed_block 1 mpiversion=3.0 +hindexed_block_contents 1 mpiversion=3.0 +longdouble 1 +#large-count 1 mpiversion=3.0 xfail=ticket1767 +cxx-types 1 mpiversion=3.0 diff --git a/teshsuite/smpi/mpich3-test/datatype/tfree.c b/teshsuite/smpi/mpich3-test/datatype/tfree.c new file mode 100644 index 0000000000..d38fb7ff09 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/tfree.c @@ -0,0 +1,105 @@ +/* -*- 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 +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Test that freed datatypes have reference count semantics"; +*/ + +#define VEC_NELM 128 +#define VEC_STRIDE 8 + +int main( int argc, char *argv[] ) +{ + int errs = 0; + int rank, size, source, dest, i; + MPI_Comm comm; + MPI_Status status; + MPI_Request req; + MPI_Datatype strideType; + MPI_Datatype tmpType[1024]; + int *buf = 0; + + MTest_Init( &argc, &argv ); + + comm = MPI_COMM_WORLD; + + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + + if (size < 2) { + fprintf( stderr, "This test requires at least two processes." ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + + source = 0; + dest = size - 1; + + /* + The idea here is to create a simple but non-contig datatype, + perform an irecv with it, free it, and then create + many new datatypes. While not a complete test, if the datatype + was freed and the space was reused, this test may detect + that error + A similar test for sends might work by sending a large enough message + to force the use of rendezvous send. + */ + MPI_Type_vector( VEC_NELM, 1, VEC_STRIDE, MPI_INT, &strideType ); + MPI_Type_commit( &strideType ); + + if (rank == dest) { + buf = (int *)malloc( VEC_NELM * VEC_STRIDE * sizeof(int) ); + for (i=0; i +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Test of type_match_size"; +*/ + +/* + * type match size is part of the extended Fortran support, and may not + * be present in + */ + +int main( int argc, char *argv[] ) +{ + int errs = 0, err; + int dsize; + MPI_Datatype newtype; + + MTest_Init( &argc, &argv ); + + /* Check the most likely cases. Note that it is an error to + free the type returned by MPI_Type_match_size. Also note + that it is an error to request a size not supported by the compiler, + so Type_match_size should generate an error in that case */ + MPI_Comm_set_errhandler( MPI_COMM_WORLD, MPI_ERRORS_RETURN ); + + err = MPI_Type_match_size( MPI_TYPECLASS_REAL, sizeof(float), &newtype ); + if (err) { + errs++; + MTestPrintErrorMsg( "Float: ", err ); + } + else { + err = MPI_Type_size( newtype, &dsize ); + if (err) { + errs++; + MTestPrintErrorMsg( "Float type: ", err ); + } + else { + if (dsize != sizeof(float)) { + errs++; + printf( "Unexpected size for float (%d != %d)\n", + dsize, (int) sizeof(float) ); + } + } + } + + err = MPI_Type_match_size( MPI_TYPECLASS_REAL, sizeof(double), &newtype ); + if (err) { + errs++; + MTestPrintErrorMsg( "Double: ", err ); + } + else { + MPI_Type_size( newtype, &dsize ); + if (dsize != sizeof(double)) { + errs++; + printf( "Unexpected size for double\n" ); + } + } +#ifdef HAVE_LONG_DOUBLE + err = MPI_Type_match_size( MPI_TYPECLASS_REAL, sizeof(long double), &newtype ); + if (err) { + errs++; + MTestPrintErrorMsg( "Long double: ", err ); + } + else { + MPI_Type_size( newtype, &dsize ); + if (dsize != sizeof(long double)) { + errs++; + printf( "Unexpected size for long double\n" ); + } + } +#endif + + err = MPI_Type_match_size( MPI_TYPECLASS_INTEGER, sizeof(short), &newtype ); + if (err) { + errs++; + MTestPrintErrorMsg( "Short: ", err ); + } + else { + MPI_Type_size( newtype, &dsize ); + if (dsize != sizeof(short)) { + errs++; + printf( "Unexpected size for short\n" ); + } + } + + err = MPI_Type_match_size( MPI_TYPECLASS_INTEGER, sizeof(int), &newtype ); + if (err) { + errs++; + MTestPrintErrorMsg( "Int: ", err ); + } + else { + MPI_Type_size( newtype, &dsize ); + if (dsize != sizeof(int)) { + errs++; + printf( "Unexpected size for int\n" ); + } + } + + err = MPI_Type_match_size( MPI_TYPECLASS_INTEGER, sizeof(long), &newtype ); + if (err) { + errs++; + MTestPrintErrorMsg( "Long: ", err ); + } + else { + MPI_Type_size( newtype, &dsize ); + if (dsize != sizeof(long)) { + errs++; + printf( "Unexpected size for long\n" ); + } + } +#ifdef HAVE_LONG_LONG + err = MPI_Type_match_size( MPI_TYPECLASS_INTEGER, sizeof(long long), &newtype ); + if (err) { + errs++; + MTestPrintErrorMsg( "Long long: ", err ); + } + else { + MPI_Type_size( newtype, &dsize ); + if (dsize != sizeof(long long)) { + errs++; + printf( "Unexpected size for long long\n" ); + } + } +#endif + + /* COMPLEX is a FORTRAN type. The MPICH Type_match_size attempts + to give a valid datatype, but if Fortran is not available, + MPI_COMPLEX and MPI_DOUBLE_COMPLEX are not supported. + Allow this case by testing for MPI_DATATYPE_NULL */ + if (MPI_COMPLEX != MPI_DATATYPE_NULL) { + err = MPI_Type_match_size( MPI_TYPECLASS_COMPLEX, 2*sizeof(float), &newtype ); + if (err) { + errs++; + MTestPrintErrorMsg( "Complex: ", err ); + } + else { + MPI_Type_size( newtype, &dsize ); + if (dsize != 2*sizeof(float)) { + errs++; + printf( "Unexpected size for complex\n" ); + } + } + } + + if (MPI_COMPLEX != MPI_DATATYPE_NULL && + MPI_DOUBLE_COMPLEX != MPI_DATATYPE_NULL) { + err = MPI_Type_match_size( MPI_TYPECLASS_COMPLEX, 2*sizeof(double), &newtype ); + if (err) { + errs++; + MTestPrintErrorMsg( "Double complex: ", err ); + } + else { + MPI_Type_size( newtype, &dsize ); + if (dsize != 2*sizeof(double)) { + errs++; + printf( "Unexpected size for double complex\n" ); + } + } + } + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/datatype/transpose-pack.c b/teshsuite/smpi/mpich3-test/datatype/transpose-pack.c new file mode 100644 index 0000000000..5bd6a7244e --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/transpose-pack.c @@ -0,0 +1,121 @@ +/* -*- 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 +#include +#include +#include "mpitest.h" +#include "mpitestconf.h" +#ifdef HAVE_STRING_H +#include +#endif + +static int verbose = 0; + +int main(int argc, char *argv[]); +int parse_args(int argc, char **argv); + +int main(int argc, char *argv[]) +{ + /* Variable declarations */ + int a[100][100], b[100][100]; + MPI_Datatype row, xpose; + MPI_Aint sizeofint; + + int err, errs = 0; + int bufsize, position = 0; + void *buffer; + + int i, j; + + /* Initialize a to some known values. */ + for(i = 0; i < 100; i++) { + for(j = 0; j < 100; j++) { + a[i][j] = i*1000+j; + b[i][j] = -1; + } + } + + /* Initialize MPI */ + MPI_Init(&argc, &argv); + parse_args(argc, argv); + + MPI_Type_extent(MPI_INT, &sizeofint); + + /* Create datatypes. */ + MPI_Type_vector(100, 1, 100, MPI_INT, &row); + MPI_Type_hvector(100, 1, sizeofint, row, &xpose); + MPI_Type_commit(&xpose); + + /* Pack it. */ + MPI_Pack_size(1, xpose, MPI_COMM_WORLD, &bufsize); + buffer = (char *) malloc((unsigned) bufsize); + + /* To improve reporting of problems about operations, we + change the error handler to errors return */ + MPI_Comm_set_errhandler( MPI_COMM_WORLD, MPI_ERRORS_RETURN ); + + err = MPI_Pack(a, + 1, + xpose, + buffer, + bufsize, + &position, + MPI_COMM_WORLD); + + /* Unpack the buffer into b. */ + position = 0; + err = MPI_Unpack(buffer, + bufsize, + &position, + b, + 100*100, + MPI_INT, + MPI_COMM_WORLD); + + for (i = 0; i < 100; i++) { + for (j = 0; j < 100; j++) { + if(b[i][j] != a[j][i]) { + errs++; + if (verbose) fprintf(stderr, "b[%d][%d] = %d, should be %d\n", + i, j, b[i][j], a[j][i]); + } + } + } + + MPI_Type_free(&xpose); + MPI_Type_free(&row); + + /* print message and exit */ + if (errs) { + fprintf(stderr, "Found %d errors\n", errs); + } + else { + printf(" No Errors\n"); + } + MPI_Finalize(); + return 0; +} + + +int parse_args(int argc, char **argv) +{ + /* + int ret; + + while ((ret = getopt(argc, argv, "v")) >= 0) + { + switch (ret) { + case 'v': + verbose = 1; + break; + } + } + */ + if (argc > 1 && strcmp(argv[1], "-v") == 0) + verbose = 1; + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/datatype/tresized.c b/teshsuite/smpi/mpich3-test/datatype/tresized.c new file mode 100644 index 0000000000..069fddcecd --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/tresized.c @@ -0,0 +1,77 @@ +/* -*- 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 +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Test of type resized"; +*/ + +int main( int argc, char *argv[] ) +{ + int errs = 0, i; + int rank, size, source, dest; + int count; + int *buf; + MPI_Comm comm; + MPI_Status status; + MPI_Datatype newtype; + + MTest_Init( &argc, &argv ); + + comm = MPI_COMM_WORLD; + + /* Determine the sender and receiver */ + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + source = 0; + dest = size - 1; + + MPI_Type_create_resized( MPI_INT, 0, 3 * sizeof(int), &newtype ); + MPI_Type_commit( &newtype ); + for (count = 1; count < 65000; count = count * 2) { + buf = (int *)malloc( count * 3 * sizeof(int) ); + if (!buf) { + MPI_Abort( comm, 1 ); + } + for (i=0; i<3*count; i++) buf[i] = -1; + if (rank == source) { + for (i=0; i +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Test of type resized with non-zero LB"; +*/ + +int main( int argc, char *argv[] ) +{ + int errs = 0, i; + int rank, size, source, dest; + int count; + int *buf; + MPI_Comm comm; + MPI_Status status; + MPI_Datatype newtype; + + MTest_Init( &argc, &argv ); + + comm = MPI_COMM_WORLD; + + /* Determine the sender and receiver */ + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + source = 0; + dest = size - 1; + + /* Create an type that is "* INT * " + that is, there is a int-sized pad at the beginning of the type, + and the extent is still 3 ints. Note, however, that the INT + is still at displacement 0, so the effective pattern i*/ + MPI_Type_create_resized( MPI_INT, -(int)sizeof(int), 3 * sizeof(int), &newtype ); + MPI_Type_commit( &newtype ); + for (count = 1; count < 65000; count = count * 2) { + buf = (int *)malloc( count * 3 * sizeof(int) ); + if (!buf) { + MPI_Abort( comm, 1 ); + } + for (i=0; i<3*count; i++) buf[i] = -1; + if (rank == source) { + for (i=0; i +#include +#include +#include +#include "mpi.h" +#include "mpitest.h" + +int main(int argc, char *argv[]); + +/* helper functions */ +int parse_args(int argc, char **argv); + +static int verbose = 0; + +int main(int argc, char *argv[]) +{ + /* Variable declarations */ + int a[100][100], b[100][100]; + int disp[100], block[100]; + MPI_Datatype ltype; + + int bufsize, position = 0; + void *buffer; + + int i, j, errs = 0; + + /* Initialize a to some known values and zero out b. */ + for(i = 0; i < 100; i++) { + for(j = 0; j < 100; j++) { + a[i][j] = 1000*i + j; + b[i][j] = 0; + } + } + + /* Initialize MPI */ + MTest_Init( &argc, &argv ); + + parse_args(argc, argv); + + for(i = 0; i < 100; i++) { + /* Fortran version has disp(i) = 100*(i-1) + i and block(i) = 100-i. */ + /* This code here is wrong. It compacts everything together, + * which isn't what we want. + * What we want is to put the lower triangular values into b and leave + * the rest of it unchanged, right? + */ + block[i] = i+1; + disp[i] = 100*i; + } + + /* Create datatype for lower triangular part. */ + MPI_Type_indexed(100, block, disp, MPI_INT, <ype); + MPI_Type_commit(<ype); + + /* Pack it. */ + MPI_Pack_size(1, ltype, MPI_COMM_WORLD, &bufsize); + buffer = (void *) malloc((unsigned) bufsize); + MPI_Pack( a, 1, ltype, buffer, bufsize, &position, MPI_COMM_WORLD ); + + /* Unpack the buffer into b. */ + position = 0; + MPI_Unpack(buffer, bufsize, &position, b, 1, ltype, MPI_COMM_WORLD); + + for(i = 0; i < 100; i++) { + for(j = 0; j < 100; j++) { + if (j > i && b[i][j] != 0) { + errs++; + if (verbose) fprintf(stderr, "b[%d][%d] = %d; should be %d\n", + i, j, b[i][j], 0); + } + else if (j <= i && b[i][j] != 1000*i + j) { + errs++; + if (verbose) fprintf(stderr, "b[%d][%d] = %d; should be %d\n", + i, j, b[i][j], 1000*i + j); + } + } + } + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} + +int parse_args(int argc, char **argv) +{ + int ret; + + while ((ret = getopt(argc, argv, "v")) >= 0) + { + switch (ret) { + case 'v': + verbose = 1; + break; + } + } + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/datatype/typecommit.c b/teshsuite/smpi/mpich3-test/datatype/typecommit.c new file mode 100644 index 0000000000..61fb7b5361 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/typecommit.c @@ -0,0 +1,53 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2006 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include +#include +#include "mpitest.h" + +void foo(void *sendbuf, MPI_Datatype sendtype, void *recvbuf, + MPI_Datatype recvtype); +void foo(void *sendbuf, MPI_Datatype sendtype, void *recvbuf, + MPI_Datatype recvtype) +{ + int blocks[2]; + MPI_Aint struct_displs[2]; + MPI_Datatype types[2], tmp_type; + + blocks[0] = 256; + MPI_Get_address( sendbuf, &struct_displs[0] ); + types[0] = sendtype; + blocks[1] = 256; + MPI_Get_address( recvbuf, &struct_displs[1] ); + types[1] = MPI_BYTE; + + MPI_Type_create_struct(2, blocks, struct_displs, types, &tmp_type); + MPI_Type_commit(&tmp_type); + MPI_Type_free(&tmp_type); +} + +int main(int argc, char **argv) +{ + int errs = 0; + + MTest_Init(&argc, &argv); + + foo((void*) 0x1, MPI_FLOAT_INT, (void*) 0x2, MPI_BYTE); + foo((void*) 0x1, MPI_DOUBLE_INT, (void*) 0x2, MPI_BYTE); + foo((void*) 0x1, MPI_LONG_INT, (void*) 0x2, MPI_BYTE); + foo((void*) 0x1, MPI_SHORT_INT, (void*) 0x2, MPI_BYTE); + foo((void*) 0x1, MPI_2INT, (void*) 0x2, MPI_BYTE); +#ifdef HAVE_LONG_DOUBLE + /* Optional type may be NULL */ + if (MPI_LONG_DOUBLE_INT != MPI_DATATYPE_NULL) { + foo((void*) 0x1, MPI_LONG_DOUBLE_INT, (void*) 0x2, MPI_BYTE); + } +#endif + + MTest_Finalize(errs); + MPI_Finalize(); + + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/datatype/typefree.c b/teshsuite/smpi/mpich3-test/datatype/typefree.c new file mode 100644 index 0000000000..83a09ddb08 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/typefree.c @@ -0,0 +1,35 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2007 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include "mpi.h" +#include "mpitest.h" +#include +#include +#include + +/* + * This test may be used to confirm that memory is properly recovered from + * freed datatypes. To test this, build the MPI implementation with memory + * leak checking. As this program may be run with a single process, it should + * also be easy to run it under valgrind or a similar program. With MPICH, + * you can configure with the option + * + * --enable-g=mem + * + * to turn on MPICH's internal memory checking. + */ + +int main( int argc, char *argv[] ) +{ + int errs = 0; + MPI_Datatype type; + + MTest_Init( &argc, &argv ); + MPI_Type_dup( MPI_INT, &type ); + MPI_Type_free( &type ); + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/datatype/typelb.c b/teshsuite/smpi/mpich3-test/datatype/typelb.c new file mode 100644 index 0000000000..2dedadbca9 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/typelb.c @@ -0,0 +1,54 @@ +/* -*- 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 + +int main( int argc, char **argv) +{ + int blockcnt[2], rank; + MPI_Aint offsets[2], lb, ub, extent; + MPI_Datatype tmp_type, newtype; + + MPI_Init(&argc, &argv); + + /* Set some values in locations that should not be accessed */ + blockcnt[1] = -1; + offsets[1] = -1; + + MPI_Comm_rank( MPI_COMM_WORLD, &rank ); + if (rank == 0) { + blockcnt[0] = 1; + offsets[0] = 3; + MPI_Type_hindexed(1, blockcnt, offsets, MPI_BYTE, &tmp_type); + blockcnt[0] = 1; + offsets[0] = 1; + MPI_Type_hindexed(1, blockcnt, offsets, tmp_type, &newtype); + MPI_Type_commit(&newtype); + + MPI_Type_lb(newtype, &lb); + MPI_Type_extent(newtype, &extent); + MPI_Type_ub(newtype, &ub); + + /* Check that the results are correct */ +#ifdef DEBUG + printf("lb=%ld, ub=%ld, extent=%ld\n", lb, ub, extent); + printf("Should be lb=4, ub=5, extent=1\n"); +#endif + if (lb != 4 || ub != 5 || extent != 1) { + printf ("lb = %d (should be 4), ub = %d (should be 5) extent = %d should be 1\n", (int)lb, (int)ub, (int)extent) ; + } + else { + printf( " No Errors\n" ); + } + + MPI_Type_free(&tmp_type); + MPI_Type_free(&newtype); + } + + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/datatype/typename.c b/teshsuite/smpi/mpich3-test/datatype/typename.c new file mode 100644 index 0000000000..60845c16f4 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/typename.c @@ -0,0 +1,194 @@ +/* -*- 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 + +/* Create an array with all of the MPI names in it */ + +typedef struct mpi_names_t { MPI_Datatype dtype; const char *name; } mpi_names_t; + +/* The MPI standard specifies that the names must be the MPI names, +not the related language names (e.g., MPI_CHAR, not char) */ + +int main( int argc, char **argv ) +{ + +mpi_names_t mpi_names[] = { + { MPI_CHAR, "MPI_CHAR" }, + { MPI_SIGNED_CHAR, "MPI_SIGNED_CHAR" }, + { MPI_UNSIGNED_CHAR, "MPI_UNSIGNED_CHAR" }, + { MPI_BYTE, "MPI_BYTE" }, + { MPI_WCHAR, "MPI_WCHAR" }, + { MPI_SHORT, "MPI_SHORT" }, + { MPI_UNSIGNED_SHORT, "MPI_UNSIGNED_SHORT" }, + { MPI_INT, "MPI_INT" }, + { MPI_UNSIGNED, "MPI_UNSIGNED" }, + { MPI_LONG, "MPI_LONG" }, + { MPI_UNSIGNED_LONG, "MPI_UNSIGNED_LONG" }, + { MPI_FLOAT, "MPI_FLOAT" }, + { MPI_DOUBLE, "MPI_DOUBLE" }, +#if MTEST_HAVE_MIN_MPI_VERSION(2,2) + /* these two types were added in MPI-2.2 */ + { MPI_AINT, "MPI_AINT" }, + { MPI_OFFSET, "MPI_OFFSET" }, +#endif + + { MPI_PACKED, "MPI_PACKED" }, + { MPI_LB, "MPI_LB" }, + { MPI_UB, "MPI_UB" }, + { MPI_FLOAT_INT, "MPI_FLOAT_INT" }, + { MPI_DOUBLE_INT, "MPI_DOUBLE_INT" }, + { MPI_LONG_INT, "MPI_LONG_INT" }, + { MPI_SHORT_INT, "MPI_SHORT_INT" }, + { MPI_2INT, "MPI_2INT" }, + /* Fortran */ +#ifdef HAVE_FORTRAN_BINDING + { MPI_COMPLEX, "MPI_COMPLEX" }, + { MPI_DOUBLE_COMPLEX, "MPI_DOUBLE_COMPLEX" }, + { MPI_LOGICAL, "MPI_LOGICAL" }, + { MPI_REAL, "MPI_REAL" }, + { MPI_DOUBLE_PRECISION, "MPI_DOUBLE_PRECISION" }, + { MPI_INTEGER, "MPI_INTEGER" }, + { MPI_2INTEGER, "MPI_2INTEGER" }, + /* 2COMPLEX (and the 2DOUBLE_COMPLEX) were in MPI 1.0 but not later */ +#ifdef HAVE_MPI_2COMPLEX + { MPI_2COMPLEX, "MPI_2COMPLEX" }, +#endif +#ifdef HAVE_MPI_2DOUBLE_COMPLEX + /* MPI_2DOUBLE_COMPLEX is an extension - it is not part of MPI 2.1 */ + { MPI_2DOUBLE_COMPLEX, "MPI_2DOUBLE_COMPLEX" }, +#endif + { MPI_2REAL, "MPI_2REAL" }, + { MPI_2DOUBLE_PRECISION, "MPI_2DOUBLE_PRECISION" }, + { MPI_CHARACTER, "MPI_CHARACTER" }, +#endif +#if MTEST_HAVE_MIN_MPI_VERSION(2,2) + /* these C99 types were added in MPI-2.2 */ + { MPI_INT8_T, "MPI_INT8_T" }, + { MPI_INT16_T, "MPI_INT16_T" }, + { MPI_INT32_T, "MPI_INT32_T" }, + { MPI_INT64_T, "MPI_INT64_T" }, + { MPI_UINT8_T, "MPI_UINT8_T" }, + { MPI_UINT16_T, "MPI_UINT16_T" }, + { MPI_UINT32_T, "MPI_UINT32_T" }, + { MPI_UINT64_T, "MPI_UINT64_T" }, + { MPI_C_BOOL, "MPI_C_BOOL" }, + { MPI_C_FLOAT_COMPLEX, "MPI_C_FLOAT_COMPLEX" }, + { MPI_C_DOUBLE_COMPLEX, "MPI_C_DOUBLE_COMPLEX" }, + { MPI_AINT, "MPI_AINT" }, + { MPI_OFFSET, "MPI_OFFSET" }, +#endif + /* Size-specific types */ + /* Do not move MPI_REAL4 - this is used to indicate the very first + optional type. In addition, you must not add any required types + after this type */ + /* See MPI 2.1, Section 16.2. These are required, predefined types. + If the type is not available (e.g., *only* because the Fortran + compiler does not support it), the value may be MPI_DATATYPE_NULL */ + { MPI_REAL4, "MPI_REAL4" }, + { MPI_REAL8, "MPI_REAL8" }, + { MPI_REAL16, "MPI_REAL16" }, + { MPI_COMPLEX8, "MPI_COMPLEX8" }, + { MPI_COMPLEX16, "MPI_COMPLEX16" }, + { MPI_COMPLEX32, "MPI_COMPLEX32" }, + { MPI_INTEGER1, "MPI_INTEGER1" }, + { MPI_INTEGER2, "MPI_INTEGER2" }, + { MPI_INTEGER4, "MPI_INTEGER4" }, + { MPI_INTEGER8, "MPI_INTEGER8" }, +#ifdef HAVE_MPI_INTEGER16 + /* MPI_INTEGER16 is not included in most of the tables in MPI 2.1, + and some implementations omit it. An error will be reported, but + this ifdef allows the test to be built and run. */ + { MPI_INTEGER16, "MPI_INTEGER16" }, +#endif + /* Semi-optional types - if the compiler doesn't support long double + or long long, these might be MPI_DATATYPE_NULL */ + { MPI_LONG_DOUBLE, "MPI_LONG_DOUBLE" }, + { MPI_LONG_LONG_INT, "MPI_LONG_LONG_INT" }, + { MPI_LONG_LONG, "MPI_LONG_LONG" }, + { MPI_UNSIGNED_LONG_LONG, "MPI_UNSIGNED_LONG_LONG" }, + { MPI_LONG_DOUBLE_INT, "MPI_LONG_DOUBLE_INT" }, +#if MTEST_HAVE_MIN_MPI_VERSION(2,2) + /* added in MPI-2.2 */ + { MPI_C_LONG_DOUBLE_COMPLEX, "MPI_C_LONG_DOUBLE_COMPLEX" }, + { MPI_AINT, "MPI_AINT" }, + { MPI_OFFSET, "MPI_OFFSET" }, +#endif +#if MTEST_HAVE_MIN_MPI_VERSION(3,0) + /* added in MPI 3 */ + { MPI_COUNT, "MPI_COUNT" }, +#endif + { 0, (char *)0 }, /* Sentinal used to indicate the last element */ +}; + + char name[MPI_MAX_OBJECT_NAME]; + int namelen, i, inOptional; + int errs = 0; + + MTest_Init( &argc, &argv ); + + /* Sample some datatypes */ + /* See 8.4, "Naming Objects" in MPI-2. The default name is the same + as the datatype name */ + MPI_Type_get_name( MPI_DOUBLE, name, &namelen ); + if (strncmp( name, "MPI_DOUBLE", MPI_MAX_OBJECT_NAME )) { + errs++; + fprintf( stderr, "Expected MPI_DOUBLE but got :%s:\n", name ); + } + + MPI_Type_get_name( MPI_INT, name, &namelen ); + if (strncmp( name, "MPI_INT", MPI_MAX_OBJECT_NAME )) { + errs++; + fprintf( stderr, "Expected MPI_INT but got :%s:\n", name ); + } + + /* Now we try them ALL */ + inOptional = 0; + for (i=0; mpi_names[i].name != 0; i++) { + /* Are we in the optional types? */ + if (strcmp( mpi_names[i].name, "MPI_REAL4" ) == 0) + inOptional = 1; + /* If this optional type is not supported, skip it */ + if (inOptional && mpi_names[i].dtype == MPI_DATATYPE_NULL) continue; + if (mpi_names[i].dtype == MPI_DATATYPE_NULL) { + /* Report an error because all of the standard types + must be supported */ + errs++; + fprintf( stderr, "MPI Datatype %s is MPI_DATATYPE_NULL\n", + mpi_names[i].name ); + continue; + } + MTestPrintfMsg( 10, "Checking type %s\n", mpi_names[i].name ); + name[0] = 0; + MPI_Type_get_name( mpi_names[i].dtype, name, &namelen ); + if (strncmp( name, mpi_names[i].name, namelen )) { + errs++; + fprintf( stderr, "Expected %s but got %s\n", + mpi_names[i].name, name ); + } + } + + /* Try resetting the name */ + MPI_Type_set_name( MPI_INT, (char*)"int" ); + name[0] = 0; + MPI_Type_get_name( MPI_INT, name, &namelen ); + if (strncmp( name, "int", MPI_MAX_OBJECT_NAME )) { + errs++; + fprintf( stderr, "Expected int but got :%s:\n", name ); + } + +#ifndef HAVE_MPI_INTEGER16 + errs++; + fprintf( stderr, "MPI_INTEGER16 is not available\n" ); +#endif + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/datatype/unpack.c b/teshsuite/smpi/mpich3-test/datatype/unpack.c new file mode 100644 index 0000000000..839b8fc590 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/unpack.c @@ -0,0 +1,111 @@ +/* -*- 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 +#include "mpitest.h" +#include +#include + +/* Test sent in by Avery Ching to report a bug in MPICH. + Adding it as a regression test. */ + +/* +static void print_char_buf(char *buf_name, char *buf, int buf_len) +{ + int i; + + printf("print_char_buf: %s\n", buf_name); + for (i = 0; i < buf_len; i++) + { + printf("%c ", buf[i]); + if (((i + 1) % 10) == 0) + printf("\n"); + else if (((i + 1) % 5) == 0) + printf(" "); + } + printf("\n"); +} +*/ + +char correct_buf[] = {'a', '_', 'b', 'c', '_', '_', '_', '_', 'd', '_', + 'e', 'f', 'g', '_', 'h', 'i', 'j', '_', 'k', 'l', + '_', '_', '_', '_', 'm', '_', 'n', 'o', 'p', '_', + 'q', 'r'}; + +#define COUNT 2 + +int main(int argc, char **argv) +{ + int myid, numprocs, i; + char *mem_buf = NULL, *unpack_buf = NULL; + MPI_Datatype tmp_dtype, mem_dtype; + MPI_Aint mem_dtype_ext = -1; + int mem_dtype_sz = -1; + int mem_buf_sz = -1, unpack_buf_sz = -1, buf_pos = 0; + + int blk_arr[COUNT] = {1, 2}; + int dsp_arr[COUNT] = {0, 2}; + int errs = 0; + + MTest_Init(&argc, &argv); + MPI_Comm_rank(MPI_COMM_WORLD, &myid); + MPI_Comm_size(MPI_COMM_WORLD, &numprocs); + + /* Creating the datatype to use for unpacking */ + MPI_Type_indexed(COUNT, blk_arr, dsp_arr, + MPI_CHAR, &tmp_dtype); + MPI_Type_commit(&tmp_dtype); + MPI_Type_indexed(COUNT, blk_arr, dsp_arr, + tmp_dtype, &mem_dtype); + MPI_Type_free( &tmp_dtype ); + MPI_Type_commit(&mem_dtype); + + MPI_Type_size(mem_dtype, &mem_dtype_sz); + MPI_Type_extent(mem_dtype, &mem_dtype_ext); + + mem_buf_sz = 2 * mem_dtype_ext; + unpack_buf_sz = 2 * mem_dtype_sz; + + if ((mem_buf = (char *) malloc(mem_buf_sz)) == NULL) + { + fprintf(stderr, "malloc mem_buf of size %d failed\n", mem_buf_sz); + return -1; + } + memset(mem_buf, '_', mem_buf_sz); + + if ((unpack_buf = (char *) malloc(unpack_buf_sz)) == NULL) + { + fprintf(stderr, "malloc unpack_buf of size %d failed\n", + unpack_buf_sz); + return -1; + } + + for (i = 0; i < unpack_buf_sz; i++) + unpack_buf[i] = 'a' + i; + + /* print_char_buf("mem_buf before unpack", mem_buf, 2 * mem_dtype_ext); */ + + MPI_Unpack(unpack_buf, unpack_buf_sz, &buf_pos, + mem_buf, 2, mem_dtype, MPI_COMM_SELF); + /* Note: Unpack without a Pack is not technically correct, but should work + * with MPICH. */ + + /* print_char_buf("mem_buf after unpack", mem_buf, 2 * mem_dtype_ext); + print_char_buf("correct buffer should be", + correct_buf, 2 * mem_dtype_ext); */ + + if (memcmp(mem_buf, correct_buf, 2 * mem_dtype_ext)) { + printf("Unpacked buffer does not match expected buffer\n"); + errs++; + } + + MPI_Type_free(&mem_dtype); + + MTest_Finalize(errs); + MPI_Finalize(); + + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/datatype/unusual-noncontigs.c b/teshsuite/smpi/mpich3-test/datatype/unusual-noncontigs.c new file mode 100644 index 0000000000..5c608f8ee8 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/unusual-noncontigs.c @@ -0,0 +1,653 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2001 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include +#include +#include +#include +#include +#include "mpi.h" + +/* + The default behavior of the test routines should be to briefly indicate + the cause of any errors - in this test, that means that verbose needs + to be set. Verbose should turn on output that is independent of error + levels. +*/ +static int verbose = 1; + +int main(int argc, char *argv[]); +int parse_args(int argc, char **argv); +int struct_negdisp_test(void); +int vector_negstride_test(void); +int indexed_negdisp_test(void); +int struct_struct_test(void); +int flatten_test(void); + +int build_array_section_type(MPI_Aint aext, MPI_Aint astart, MPI_Aint aend, MPI_Datatype *datatype); + +int main(int argc, char *argv[]) +{ + int err, errs = 0; + + /* Initialize MPI */ + MPI_Init(&argc, &argv); + parse_args(argc, argv); + + /* To improve reporting of problems about operations, we + change the error handler to errors return */ + MPI_Comm_set_errhandler( MPI_COMM_WORLD, MPI_ERRORS_RETURN ); + + err = struct_negdisp_test(); + if (verbose && err) fprintf(stderr, "error in struct_negdisp_test\n"); + errs += err; + + err = vector_negstride_test(); + if (verbose && err) fprintf(stderr, "error in vector_negstride_test\n"); + errs += err; + + err = indexed_negdisp_test(); + if (verbose && err) fprintf(stderr, "error in indexed_negdisp_test\n"); + errs += err; + + err = struct_struct_test(); + if (verbose && err) fprintf(stderr, "error in struct_struct_test\n"); + errs += err; + + err = flatten_test(); + if (verbose && err) fprintf(stderr, "error in flatten_test\n"); + errs += err; + + /* print message and exit */ + if (errs) { + fprintf(stderr, "Found %d errors\n", errs); + } + else { + printf(" No Errors\n"); + } + MPI_Finalize(); + return 0; +} + +/* test uses a struct type that describes data that is contiguous, + * but processed in a noncontiguous way. + */ +int struct_negdisp_test(void) +{ + int err, errs = 0; + int sendbuf[6] = { 1, 2, 3, 4, 5, 6 }; + int recvbuf[6] = { -1, -2, -3, -4, -5, -6 }; + MPI_Datatype mystruct; + MPI_Request request; + MPI_Status status; + + MPI_Aint disps[2] = { 0, -1*((int) sizeof(int)) }; + int blks[2] = { 1, 1, }; + MPI_Datatype types[2] = { MPI_INT, MPI_INT }; + + err = MPI_Type_struct(2, blks, disps, types, &mystruct); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Type_struct returned error\n"); + } + } + + MPI_Type_commit(&mystruct); + + err = MPI_Irecv(recvbuf+1, 4, MPI_INT, 0, 0, MPI_COMM_SELF, &request); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Irecv returned error\n"); + } + } + + err = MPI_Send(sendbuf+2, 2, mystruct, 0, 0, MPI_COMM_SELF); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Send returned error\n"); + } + } + + err = MPI_Wait(&request, &status); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Wait returned error\n"); + } + } + + /* verify data */ + if (recvbuf[0] != -1) { + errs++; + if (verbose) { + fprintf(stderr, "recvbuf[0] = %d; should be %d\n", recvbuf[0], -1); + } + } + if (recvbuf[1] != 3) { + errs++; + if (verbose) { + fprintf(stderr, "recvbuf[1] = %d; should be %d\n", recvbuf[1], 3); + } + } + if (recvbuf[2] != 2) { + errs++; + if (verbose) { + fprintf(stderr, "recvbuf[2] = %d; should be %d\n", recvbuf[2], 2); + } + } + if (recvbuf[3] != 5) { + errs++; + if (verbose) { + fprintf(stderr, "recvbuf[3] = %d; should be %d\n", recvbuf[3], 5); + } + } + if (recvbuf[4] != 4) { + errs++; + if (verbose) { + fprintf(stderr, "recvbuf[4] = %d; should be %d\n", recvbuf[4], 4); + } + } + if (recvbuf[5] != -6) { + errs++; + if (verbose) { + fprintf(stderr, "recvbuf[5] = %d; should be %d\n", recvbuf[5], -6); + } + } + + MPI_Type_free(&mystruct); + + return errs; +} + +/* test uses a vector type that describes data that is contiguous, + * but processed in a noncontiguous way. this is effectively the + * same type as in the struct_negdisp_test above. + */ +int vector_negstride_test(void) +{ + int err, errs = 0; + int sendbuf[6] = { 1, 2, 3, 4, 5, 6 }; + int recvbuf[6] = { -1, -2, -3, -4, -5, -6 }; + MPI_Datatype myvector; + MPI_Request request; + MPI_Status status; + + err = MPI_Type_vector(2, 1, -1, MPI_INT, &myvector); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Type_vector returned error\n"); + } + } + + MPI_Type_commit(&myvector); + + err = MPI_Irecv(recvbuf+1, 4, MPI_INT, 0, 0, MPI_COMM_SELF, &request); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Irecv returned error\n"); + } + } + + err = MPI_Send(sendbuf+2, 2, myvector, 0, 0, MPI_COMM_SELF); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Send returned error\n"); + } + } + + err = MPI_Wait(&request, &status); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Wait returned error\n"); + } + } + + /* verify data */ + if (recvbuf[0] != -1) { + errs++; + if (verbose) { + fprintf(stderr, "recvbuf[0] = %d; should be %d\n", recvbuf[0], -1); + } + } + if (recvbuf[1] != 3) { + errs++; + if (verbose) { + fprintf(stderr, "recvbuf[1] = %d; should be %d\n", recvbuf[1], 3); + } + } + if (recvbuf[2] != 2) { + errs++; + if (verbose) { + fprintf(stderr, "recvbuf[2] = %d; should be %d\n", recvbuf[2], 2); + } + } + if (recvbuf[3] != 5) { + errs++; + if (verbose) { + fprintf(stderr, "recvbuf[3] = %d; should be %d\n", recvbuf[3], 5); + } + } + if (recvbuf[4] != 4) { + errs++; + if (verbose) { + fprintf(stderr, "recvbuf[4] = %d; should be %d\n", recvbuf[4], 4); + } + } + if (recvbuf[5] != -6) { + errs++; + if (verbose) { + fprintf(stderr, "recvbuf[5] = %d; should be %d\n", recvbuf[5], -6); + } + } + + MPI_Type_free(&myvector); + + return errs; +} + +/* test uses a indexed type that describes data that is contiguous, + * but processed in a noncontiguous way. this is effectively the same + * type as in the two tests above. + */ +int indexed_negdisp_test(void) +{ + int err, errs = 0; + int sendbuf[6] = { 1, 2, 3, 4, 5, 6 }; + int recvbuf[6] = { -1, -2, -3, -4, -5, -6 }; + MPI_Datatype myindexed; + MPI_Request request; + MPI_Status status; + + int disps[2] = { 0, -1 }; + int blks[2] = { 1, 1 }; + + err = MPI_Type_indexed(2, blks, disps, MPI_INT, &myindexed); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Type_indexed returned error\n"); + } + } + + MPI_Type_commit(&myindexed); + + err = MPI_Irecv(recvbuf+1, 4, MPI_INT, 0, 0, MPI_COMM_SELF, &request); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Irecv returned error\n"); + } + } + + err = MPI_Send(sendbuf+2, 2, myindexed, 0, 0, MPI_COMM_SELF); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Send returned error\n"); + } + } + + err = MPI_Wait(&request, &status); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Wait returned error\n"); + } + } + + /* verify data */ + if (recvbuf[0] != -1) { + errs++; + if (verbose) { + fprintf(stderr, "recvbuf[0] = %d; should be %d\n", recvbuf[0], -1); + } + } + if (recvbuf[1] != 3) { + errs++; + if (verbose) { + fprintf(stderr, "recvbuf[1] = %d; should be %d\n", recvbuf[1], 3); + } + } + if (recvbuf[2] != 2) { + errs++; + if (verbose) { + fprintf(stderr, "recvbuf[2] = %d; should be %d\n", recvbuf[2], 2); + } + } + if (recvbuf[3] != 5) { + errs++; + if (verbose) { + fprintf(stderr, "recvbuf[3] = %d; should be %d\n", recvbuf[3], 5); + } + } + if (recvbuf[4] != 4) { + errs++; + if (verbose) { + fprintf(stderr, "recvbuf[4] = %d; should be %d\n", recvbuf[4], 4); + } + } + if (recvbuf[5] != -6) { + errs++; + if (verbose) { + fprintf(stderr, "recvbuf[5] = %d; should be %d\n", recvbuf[5], -6); + } + } + + MPI_Type_free(&myindexed); + + return errs; +} + +#define check_err(fn_name_) \ + do { \ + if (err != MPI_SUCCESS) { \ + errs++; \ + if (verbose) { \ + int len_; \ + char err_str_[MPI_MAX_ERROR_STRING]; \ + MPI_Error_string(err, err_str_, &len_); \ + fprintf(stderr, #fn_name_ " failed at line %d, err=%d: %s\n", \ + __LINE__, err, err_str_); \ + } \ + } \ + } while (0) +/* test case from tt#1030 ported to C + * + * Thanks to Matthias Lieber for reporting the bug and providing a good test + * program. */ +int struct_struct_test(void) +{ + int err, errs = 0; + int i, j, dt_size = 0; + MPI_Request req[2]; + + +#define COUNT (2) + MPI_Aint displ[COUNT]; + int blens[COUNT]; + MPI_Datatype types[COUNT]; + MPI_Datatype datatype; + + /* A slight difference from the F90 test: F90 arrays are column-major, C + * arrays are row-major. So we invert the order of dimensions. */ +#define N (2) +#define M (4) + int array[N][M] = { {-1, -1, -1, -1}, {-1, -1, -1, -1} }; + int expected[N][M] = { {-1, 1, 2, 5}, {-1, 3, 4, 6} }; + int seq_array[N*M]; + MPI_Aint astart, aend; + MPI_Aint size_exp = 0; + + /* 1st section selects elements 1 and 2 out of 2nd dimension, complete 1st dim. + * should receive the values 1, 2, 3, 4 */ + astart = 1; + aend = 2; + err = build_array_section_type(M, astart, aend, &types[0]); + if (err) { + errs++; + if (verbose) fprintf(stderr, "build_array_section_type failed\n"); + return errs; + } + blens[0] = N; + displ[0] = 0; + size_exp = size_exp + N * (aend-astart+1) * sizeof(int); + + /* 2nd section selects last element of 2nd dimension, complete 1st dim. + * should receive the values 5, 6 */ + astart = 3; + aend = 3; + err = build_array_section_type(M, astart, aend, &types[1]); + if (err) { + errs++; + if (verbose) fprintf(stderr, "build_array_section_type failed\n"); + return errs; + } + blens[1] = N; + displ[1] = 0; + size_exp = size_exp + N * (aend-astart+1) * sizeof(int); + + /* create type */ + err = MPI_Type_create_struct(COUNT, blens, displ, types, &datatype); + check_err(MPI_Type_create_struct); + err = MPI_Type_commit(&datatype); + check_err(MPI_Type_commit); + + err = MPI_Type_size(datatype, &dt_size); + check_err(MPI_Type_size); + if (dt_size != size_exp) { + errs++; + if (verbose) fprintf(stderr, "unexpected type size\n"); + } + + + /* send the type to ourselves to make sure that the type describes data correctly */ + for (i = 0; i < (N*M) ; ++i) + seq_array[i] = i + 1; /* source values 1..(N*M) */ + err = MPI_Isend(&seq_array[0], dt_size/sizeof(int), MPI_INT, 0, 42, MPI_COMM_SELF, &req[0]); + check_err(MPI_Isend); + err = MPI_Irecv(&array[0][0], 1, datatype, 0, 42, MPI_COMM_SELF, &req[1]); + check_err(MPI_Irecv); + err = MPI_Waitall(2, req, MPI_STATUSES_IGNORE); + check_err(MPI_Waitall); + + /* check against expected */ + for (i = 0; i < N; ++i) { + for (j = 0; j < M; ++j) { + if (array[i][j] != expected[i][j]) { + errs++; + if (verbose) + fprintf(stderr, "array[%d][%d]=%d, should be %d\n", i, j, array[i][j], expected[i][j]); + } + } + } + + err = MPI_Type_free(&datatype); + check_err(MPI_Type_free); + err = MPI_Type_free(&types[0]); + check_err(MPI_Type_free); + err = MPI_Type_free(&types[1]); + check_err(MPI_Type_free); + + return errs; +#undef M +#undef N +#undef COUNT +} + +/* create a datatype for a 1D int array subsection + + - a subsection of the first dimension is defined via astart, aend + - indexes are assumed to start with 0, that means: + - 0 <= astart <= aend < aext + - astart and aend are inclusive + + example: + + aext = 8, astart=2, aend=4 would produce: + + index | 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | + 1D array ############################### + datatype LB ########### UB + */ +int build_array_section_type(MPI_Aint aext, MPI_Aint astart, MPI_Aint aend, MPI_Datatype *datatype) +{ +#define COUNT (3) + int err, errs = 0; + MPI_Aint displ[COUNT]; + int blens[COUNT]; + MPI_Datatype types[COUNT]; + + *datatype = MPI_DATATYPE_NULL; + + /* lower bound marker */ + types[0] = MPI_LB; + displ[0] = 0; + blens[0] = 1; + + /* subsection starting at astart */ + displ[1] = astart * sizeof(int); + types[1] = MPI_INT; + blens[1] = aend - astart + 1; + + /* upper bound marker */ + types[2] = MPI_UB; + displ[2] = aext * sizeof(int); + blens[2] = 1; + + err = MPI_Type_create_struct(COUNT, blens, displ, types, datatype); + if (err != MPI_SUCCESS) { + errs++; + if (verbose) { + fprintf(stderr, "MPI_Type_create_struct failed, err=%d\n", err); + } + } + + return errs; +#undef COUNT +} + +/* start_idx is the "zero" point for the unpack */ +static int pack_and_check_expected(MPI_Datatype type, const char *name, + int start_idx, int size, + int *array, int *expected) +{ + int i; + int err, errs = 0; + int pack_size = -1; + int *pack_buf = NULL; + int pos; + int type_size = -1; + int sendbuf[8] = {0,1,2,3,4,5,6,7}; + + err = MPI_Type_size(type, &type_size); + check_err(MPI_Type_size); + assert(sizeof(sendbuf) >= type_size); + + err = MPI_Pack_size(type_size/sizeof(int), MPI_INT, MPI_COMM_SELF, &pack_size); + check_err(MPI_Pack_size); + pack_buf = malloc(pack_size); + assert(pack_buf); + + pos = 0; + err = MPI_Pack(&sendbuf[0], type_size/sizeof(int), MPI_INT, pack_buf, pack_size, &pos, MPI_COMM_SELF); + check_err(MPI_Pack); + pos = 0; + err = MPI_Unpack(pack_buf, pack_size, &pos, &array[start_idx], 1, type, MPI_COMM_SELF); + check_err(MPI_Unpack); + free(pack_buf); + + /* check against expected */ + for (i = 0; i < size; ++i) { + if (array[i] != expected[i]) { + errs++; + if (verbose) + fprintf(stderr, "%s: array[%d]=%d, should be %d\n", name, i, array[i], expected[i]); + } + } + + return errs; +} + +/* regression for tt#1030, checks for bad offset math in the + * blockindexed and indexed dataloop flattening code */ +int flatten_test(void) +{ + int err, errs = 0; +#define ARR_SIZE (9) + /* real indices 0 1 2 3 4 5 6 7 8 + * indices w/ &array[3] -3 -2 -1 0 1 2 3 4 5 */ + int array[ARR_SIZE] = {-1,-1,-1,-1,-1,-1,-1,-1,-1}; + int expected[ARR_SIZE] = {-1, 0, 1,-1, 2,-1, 3,-1, 4}; + MPI_Datatype idx_type = MPI_DATATYPE_NULL; + MPI_Datatype blkidx_type = MPI_DATATYPE_NULL; + MPI_Datatype combo = MPI_DATATYPE_NULL; +#define COUNT (2) + int displ[COUNT]; + MPI_Aint adispl[COUNT]; + int blens[COUNT]; + MPI_Datatype types[COUNT]; + + /* indexed type layout: + * XX_X + * 2101 <-- pos (left of 0 is neg) + * + * different blens to prevent optimization into a blockindexed + */ + blens[0] = 2; + displ[0] = -2; /* elements, puts byte after block end at 0 */ + blens[1] = 1; + displ[1] = 1; /*elements*/ + + err = MPI_Type_indexed(COUNT, blens, displ, MPI_INT, &idx_type); + check_err(MPI_Type_indexed); + err = MPI_Type_commit(&idx_type); + check_err(MPI_Type_commit); + + /* indexed type layout: + * _X_X + * 2101 <-- pos (left of 0 is neg) + */ + displ[0] = -1; + displ[1] = 1; + err = MPI_Type_create_indexed_block(COUNT, 1, displ, MPI_INT, &blkidx_type); + check_err(MPI_Type_indexed_block); + err = MPI_Type_commit(&blkidx_type); + check_err(MPI_Type_commit); + + /* struct type layout: + * II_I_B_B (I=idx_type, B=blkidx_type) + * 21012345 <-- pos (left of 0 is neg) + */ + blens[0] = 1; + adispl[0] = 0; /*bytes*/ + types[0] = idx_type; + + blens[1] = 1; + adispl[1] = 4 * sizeof(int); /* bytes */ + types[1] = blkidx_type; + + /* must be a struct in order to trigger flattening code */ + err = MPI_Type_create_struct(COUNT, blens, adispl, types, &combo); + check_err(MPI_Type_indexed); + err = MPI_Type_commit(&combo); + check_err(MPI_Type_commit); + + /* pack/unpack with &array[3] */ + errs += pack_and_check_expected(combo, "combo", 3, ARR_SIZE, array, expected); + + MPI_Type_free(&combo); + MPI_Type_free(&idx_type); + MPI_Type_free(&blkidx_type); + + return errs; +#undef COUNT +} +#undef check_err + +int parse_args(int argc, char **argv) +{ + /* + int ret; + + while ((ret = getopt(argc, argv, "v")) >= 0) + { + switch (ret) { + case 'v': + verbose = 1; + break; + } + } + */ + if (argc > 1 && strcmp(argv[1], "-v") == 0) + verbose = 1; + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/datatype/zero-blklen-vector.c b/teshsuite/smpi/mpich3-test/datatype/zero-blklen-vector.c new file mode 100644 index 0000000000..ce51f19e33 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/zero-blklen-vector.c @@ -0,0 +1,38 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2003 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ + +#include +#include +int main(int argc, char* argv[]) +{ + int iam, np; + int m = 2, n = 0, lda = 1; + double A[2]; + MPI_Comm comm = MPI_COMM_WORLD; + MPI_Datatype type = MPI_DOUBLE, vtype; + + MPI_Init(&argc,&argv); + MPI_Comm_size(comm, &np); + MPI_Comm_rank(comm, &iam); + if (np < 2) { + printf( "Should be at least 2 processes for the test\n"); + } else { + MPI_Type_vector(n, m, lda, type, &vtype); + MPI_Type_commit(&vtype); + A[0] = -1.0-0.1*iam; + A[1] = 0.5+0.1*iam; + printf("In process %i of %i before Bcast: A = %f,%f\n", + iam, np, A[0], A[1] ); + MPI_Bcast(A, 1, vtype, 0, comm); + printf("In process %i of %i after Bcast: A = %f,%f\n", + iam, np, A[0], A[1]); + MPI_Type_free(&vtype); + } + + MPI_Finalize(); + return(0); +} diff --git a/teshsuite/smpi/mpich3-test/datatype/zeroblks.c b/teshsuite/smpi/mpich3-test/datatype/zeroblks.c new file mode 100644 index 0000000000..0c5d39084b --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/zeroblks.c @@ -0,0 +1,69 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2001 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include +#include "mpi.h" +#include "mpitest.h" + +int main( int argc, char *argv[] ) +{ + int errs = 0; + int position, pack_size, i; + int dis[2], blklens[2]; + MPI_Datatype type; + int send_buffer[60]; + int recv_buffer[60]; + int pack_buffer[1000]; + + MTest_Init( &argc, &argv ); + + /* Initialize data in the buffers */ + for (i=0; i<60; i++) { + send_buffer[i] = i; + recv_buffer[i] = -1; + pack_buffer[i] = -2; + } + + /* Create an indexed type with an empty first block */ + dis[0] = 0; + dis[1] = 20; + + blklens[0] = 0; + blklens[1] = 40; + + MPI_Type_indexed(2, blklens, dis, MPI_INT, &type); + MPI_Type_commit(&type); + + position = 0; + MPI_Pack( send_buffer, 1, type, pack_buffer, sizeof(pack_buffer), + &position, MPI_COMM_WORLD ); + pack_size = position; + position = 0; + MPI_Unpack( pack_buffer, pack_size, &position, recv_buffer, 1, type, + MPI_COMM_WORLD ); + + /* Check that the last 40 entries of the recv_buffer have the corresponding + elements from the send buffer */ + for (i=0; i<20; i++) { + if (recv_buffer[i] != -1) { + errs++; + fprintf( stderr, "recv_buffer[%d] = %d, should = -1\n", i, + recv_buffer[i] ); + } + } + for (i=20; i<60; i++) { + if (recv_buffer[i] != i) { + errs++; + fprintf( stderr, "recv_buffer[%d] = %d, should = %d\n", i, + recv_buffer[i], i ); + } + } + MPI_Type_free( &type ); + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; + +} diff --git a/teshsuite/smpi/mpich3-test/datatype/zeroparms.c b/teshsuite/smpi/mpich3-test/datatype/zeroparms.c new file mode 100644 index 0000000000..2ad786f319 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/datatype/zeroparms.c @@ -0,0 +1,38 @@ +/* -*- 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 + +int main( int argc, char *argv[] ) +{ + MPI_Datatype newtype; + int b[1], d[1]; + + MPI_Init( &argc, &argv ); + + /* create a legitimate type to see that we don't + * emit spurious errors. + */ + MPI_Type_hvector( 0, 1, 10, MPI_DOUBLE, &newtype ); + MPI_Type_commit( &newtype ); + MPI_Type_free( &newtype ); + + MPI_Type_indexed( 0, b, d, MPI_DOUBLE, &newtype ); + MPI_Type_commit( &newtype ); + + MPI_Sendrecv( b, 1, newtype, 0, 0, + d, 0, newtype, 0, 0, + MPI_COMM_WORLD, MPI_STATUS_IGNORE ); + + printf( " No Errors\n" ); + + MPI_Type_free( &newtype ); + + MPI_Finalize(); + + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/group/CMakeLists.txt b/teshsuite/smpi/mpich3-test/group/CMakeLists.txt index d46a945e94..f75d72e69b 100644 --- a/teshsuite/smpi/mpich3-test/group/CMakeLists.txt +++ b/teshsuite/smpi/mpich3-test/group/CMakeLists.txt @@ -65,7 +65,6 @@ set(bin_files ) set(txt_files ${txt_files} - ${CMAKE_CURRENT_SOURCE_DIR}/runtests ${CMAKE_CURRENT_SOURCE_DIR}/testlist PARENT_SCOPE ) diff --git a/teshsuite/smpi/mpich3-test/init/CMakeLists.txt b/teshsuite/smpi/mpich3-test/init/CMakeLists.txt index ac51f8a18c..90ceb9d299 100644 --- a/teshsuite/smpi/mpich3-test/init/CMakeLists.txt +++ b/teshsuite/smpi/mpich3-test/init/CMakeLists.txt @@ -77,7 +77,6 @@ set(bin_files ) set(txt_files ${txt_files} - ${CMAKE_CURRENT_SOURCE_DIR}/runtests ${CMAKE_CURRENT_SOURCE_DIR}/testlist PARENT_SCOPE ) diff --git a/teshsuite/smpi/mpich3-test/pt2pt/CMakeLists.txt b/teshsuite/smpi/mpich3-test/pt2pt/CMakeLists.txt index c774661d1b..f934b873be 100644 --- a/teshsuite/smpi/mpich3-test/pt2pt/CMakeLists.txt +++ b/teshsuite/smpi/mpich3-test/pt2pt/CMakeLists.txt @@ -185,7 +185,6 @@ set(bin_files ) set(txt_files ${txt_files} - ${CMAKE_CURRENT_SOURCE_DIR}/runtests ${CMAKE_CURRENT_SOURCE_DIR}/testlist PARENT_SCOPE ) diff --git a/teshsuite/smpi/mpich3-test/util/mtest.c b/teshsuite/smpi/mpich3-test/util/mtest.c new file mode 100644 index 0000000000..6f40201421 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/util/mtest.c @@ -0,0 +1,1712 @@ +/* -*- 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 */ + +static int dbgflag = 0; /* Flag used for debugging */ +static int wrank = -1; /* World rank */ +static int verbose = 0; /* Message level (0 is none) */ +static int returnWithVal = 0; /* Allow programs to return with a non-zero + if there was an error (may cause problems + with some runtime systems) */ +static int usageOutput = 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" )) { + dbgflag = 1; + MPI_Comm_rank( MPI_COMM_WORLD, &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) { + 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) { + returnWithVal = 1; + } + else if (strcmp( envval, "no" ) == 0 || + strcmp( envval, "NO" ) == 0 || + strcmp( envval, "false" ) == 0 || + strcmp( envval, "FALSE" ) == 0) { + 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" )) { + 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 (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 (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 + +/* + * Datatypes + * + * Eventually, this could read a description of a file. For now, we hard + * code the choices. + * + * Each kind of datatype has the following functions: + * MTestTypeXXXInit - Initialize a send buffer for that type + * MTestTypeXXXInitRecv - Initialize a receive buffer for that type + * MTestTypeXXXFree - Free any buffers associate with that type + * MTestTypeXXXCheckbuf - Check that the buffer contains the expected data + * These routines work with (nearly) any datatype that is of type XXX, + * allowing the test codes to create a variety of contiguous, vector, and + * indexed types, then test them by calling these routines. + * + * Available types (for the XXX) are + * Contig - Simple contiguous buffers + * Vector - Simple strided "vector" type + * Indexed - Indexed datatype. Only for a count of 1 instance of the + * datatype + */ +static int datatype_index = 0; + +/* ------------------------------------------------------------------------ */ +/* Datatype routines for contiguous datatypes */ +/* ------------------------------------------------------------------------ */ +/* + * Setup contiguous buffers of n copies of a datatype. + */ +static void *MTestTypeContigInit( MTestDatatype *mtype ) +{ + MPI_Aint size; + int merr; + + if (mtype->count > 0) { + signed char *p; + int i, totsize; + merr = MPI_Type_extent( mtype->datatype, &size ); + if (merr) MTestPrintError( merr ); + totsize = size * mtype->count; + if (!mtype->buf) { + mtype->buf = (void *) malloc( totsize ); + } + p = (signed char *)(mtype->buf); + if (!p) { + /* Error - out of memory */ + MTestError( "Out of memory in type buffer init" ); + } + for (i=0; ibuf) { + free( mtype->buf ); + } + mtype->buf = 0; + } + return mtype->buf; +} + +/* + * Setup contiguous buffers of n copies of a datatype. Initialize for + * reception (e.g., set initial data to detect failure) + */ +static void *MTestTypeContigInitRecv( MTestDatatype *mtype ) +{ + MPI_Aint size; + int merr; + + if (mtype->count > 0) { + signed char *p; + int i, totsize; + merr = MPI_Type_extent( mtype->datatype, &size ); + if (merr) MTestPrintError( merr ); + totsize = size * mtype->count; + if (!mtype->buf) { + mtype->buf = (void *) malloc( totsize ); + } + p = (signed char *)(mtype->buf); + if (!p) { + /* Error - out of memory */ + MTestError( "Out of memory in type buffer init" ); + } + for (i=0; ibuf) { + free( mtype->buf ); + } + mtype->buf = 0; + } + return mtype->buf; +} +static void *MTestTypeContigFree( MTestDatatype *mtype ) +{ + if (mtype->buf) { + free( mtype->buf ); + mtype->buf = 0; + } + return 0; +} +static int MTestTypeContigCheckbuf( MTestDatatype *mtype ) +{ + unsigned char *p; + unsigned char expected; + int i, totsize, err = 0, merr; + MPI_Aint size; + + p = (unsigned char *)mtype->buf; + if (p) { + merr = MPI_Type_extent( mtype->datatype, &size ); + if (merr) MTestPrintError( merr ); + totsize = size * mtype->count; + for (i=0; iprintErrors && err < 10) { + printf( "Data expected = %x but got p[%d] = %x\n", + expected, i, p[i] ); + fflush( stdout ); + } + } + } + } + return err; +} + +/* ------------------------------------------------------------------------ */ +/* Datatype routines for vector datatypes */ +/* ------------------------------------------------------------------------ */ + +static void *MTestTypeVectorInit( MTestDatatype *mtype ) +{ + MPI_Aint size; + int merr; + + if (mtype->count > 0) { + unsigned char *p; + int i, j, k, nc, totsize; + + merr = MPI_Type_extent( mtype->datatype, &size ); + if (merr) MTestPrintError( merr ); + totsize = mtype->count * size; + if (!mtype->buf) { + mtype->buf = (void *) malloc( totsize ); + } + p = (unsigned char *)(mtype->buf); + if (!p) { + /* Error - out of memory */ + MTestError( "Out of memory in type buffer init" ); + } + + /* First, set to -1 */ + for (i=0; icount; k++) { + /* For each element (block) */ + for (i=0; inelm; i++) { + /* For each value */ + for (j=0; jblksize; j++) { + p[j] = (0xff ^ (nc & 0xff)); + nc++; + } + p += mtype->stride; + } + } + } + else { + mtype->buf = 0; + } + return mtype->buf; +} + +static void *MTestTypeVectorFree( MTestDatatype *mtype ) +{ + if (mtype->buf) { + free( mtype->buf ); + mtype->buf = 0; + } + return 0; +} + +/* ------------------------------------------------------------------------ */ +/* Datatype routines for indexed block datatypes */ +/* ------------------------------------------------------------------------ */ + +/* + * Setup a buffer for one copy of an indexed datatype. + */ +static void *MTestTypeIndexedInit( MTestDatatype *mtype ) +{ + MPI_Aint totsize; + int merr; + + if (mtype->count > 1) { + MTestError( "This datatype is supported only for a single count" ); + } + if (mtype->count == 1) { + signed char *p; + int i, k, offset, j; + + /* Allocate the send/recv buffer */ + merr = MPI_Type_extent( mtype->datatype, &totsize ); + if (merr) MTestPrintError( merr ); + if (!mtype->buf) { + mtype->buf = (void *) malloc( totsize ); + } + p = (signed char *)(mtype->buf); + if (!p) { + MTestError( "Out of memory in type buffer init\n" ); + } + /* Initialize the elements */ + /* First, set to -1 */ + for (i=0; inelm; i++) { + int b; + /* Compute the offset: */ + offset = mtype->displs[i] * mtype->basesize; + /* For each element in the block */ + for (b=0; bindex[i]; b++) { + for (j=0; jbasesize; j++) { + p[offset+j] = 0xff ^ (k++ & 0xff); + } + offset += mtype->basesize; + } + } + } + else { + /* count == 0 */ + if (mtype->buf) { + free( mtype->buf ); + } + mtype->buf = 0; + } + return mtype->buf; +} + +/* + * Setup indexed buffers for 1 copy of a datatype. Initialize for + * reception (e.g., set initial data to detect failure) + */ +static void *MTestTypeIndexedInitRecv( MTestDatatype *mtype ) +{ + MPI_Aint totsize; + int merr; + + if (mtype->count > 1) { + MTestError( "This datatype is supported only for a single count" ); + } + if (mtype->count == 1) { + signed char *p; + int i; + merr = MPI_Type_extent( mtype->datatype, &totsize ); + if (merr) MTestPrintError( merr ); + if (!mtype->buf) { + mtype->buf = (void *) malloc( totsize ); + } + p = (signed char *)(mtype->buf); + if (!p) { + /* Error - out of memory */ + MTestError( "Out of memory in type buffer init\n" ); + } + for (i=0; ibuf) { + free( mtype->buf ); + } + mtype->buf = 0; + } + return mtype->buf; +} + +static void *MTestTypeIndexedFree( MTestDatatype *mtype ) +{ + if (mtype->buf) { + free( mtype->buf ); + free( mtype->displs ); + free( mtype->index ); + mtype->buf = 0; + mtype->displs = 0; + mtype->index = 0; + } + return 0; +} + +static int MTestTypeIndexedCheckbuf( MTestDatatype *mtype ) +{ + unsigned char *p; + unsigned char expected; + int i, err = 0, merr; + MPI_Aint totsize; + + p = (unsigned char *)mtype->buf; + if (p) { + int j, k, offset; + merr = MPI_Type_extent( mtype->datatype, &totsize ); + if (merr) MTestPrintError( merr ); + + k = 0; + for (i=0; inelm; i++) { + int b; + /* Compute the offset: */ + offset = mtype->displs[i] * mtype->basesize; + for (b=0; bindex[i]; b++) { + for (j=0; jbasesize; j++) { + expected = (0xff ^ (k & 0xff)); + if (p[offset+j] != expected) { + err++; + if (mtype->printErrors && err < 10) { + printf( "Data expected = %x but got p[%d,%d] = %x\n", + expected, i,j, p[offset+j] ); + fflush( stdout ); + } + } + k++; + } + offset += mtype->basesize; + } + } + } + return err; +} + + +/* ------------------------------------------------------------------------ */ +/* Routines to select a datatype and associated buffer create/fill/check */ +/* routines */ +/* ------------------------------------------------------------------------ */ + +/* + Create a range of datatypes with a given count elements. + This uses a selection of types, rather than an exhaustive collection. + It allocates both send and receive types so that they can have the same + type signature (collection of basic types) but different type maps (layouts + in memory) + */ +int MTestGetDatatypes( MTestDatatype *sendtype, MTestDatatype *recvtype, + int count ) +{ + int merr; + int i; + + sendtype->InitBuf = 0; + sendtype->FreeBuf = 0; + sendtype->CheckBuf = 0; + sendtype->datatype = 0; + sendtype->isBasic = 0; + sendtype->printErrors = 0; + recvtype->InitBuf = 0; + recvtype->FreeBuf = 0; + + recvtype->CheckBuf = 0; + recvtype->datatype = 0; + recvtype->isBasic = 0; + recvtype->printErrors = 0; + + sendtype->buf = 0; + recvtype->buf = 0; + + /* Set the defaults for the message lengths */ + sendtype->count = count; + recvtype->count = count; + /* Use datatype_index to choose a datatype to use. If at the end of the + list, return 0 */ + switch (datatype_index) { + case 0: + sendtype->datatype = MPI_INT; + sendtype->isBasic = 1; + recvtype->datatype = MPI_INT; + recvtype->isBasic = 1; + break; + case 1: + sendtype->datatype = MPI_DOUBLE; + sendtype->isBasic = 1; + recvtype->datatype = MPI_DOUBLE; + recvtype->isBasic = 1; + break; + case 2: + sendtype->datatype = MPI_FLOAT_INT; + sendtype->isBasic = 1; + recvtype->datatype = MPI_FLOAT_INT; + recvtype->isBasic = 1; + break; + case 3: + merr = MPI_Type_dup( MPI_INT, &sendtype->datatype ); + if (merr) MTestPrintError( merr ); + merr = MPI_Type_set_name( sendtype->datatype, + (char*)"dup of MPI_INT" ); + if (merr) MTestPrintError( merr ); + merr = MPI_Type_dup( MPI_INT, &recvtype->datatype ); + if (merr) MTestPrintError( merr ); + merr = MPI_Type_set_name( recvtype->datatype, + (char*)"dup of MPI_INT" ); + if (merr) MTestPrintError( merr ); + /* dup'ed types are already committed if the original type + was committed (MPI-2, section 8.8) */ + break; + case 4: + /* vector send type and contiguous receive type */ + /* These sizes are in bytes (see the VectorInit code) */ + sendtype->stride = 3 * sizeof(int); + sendtype->blksize = sizeof(int); + sendtype->nelm = recvtype->count; + + merr = MPI_Type_vector( recvtype->count, 1, 3, MPI_INT, + &sendtype->datatype ); + if (merr) MTestPrintError( merr ); + merr = MPI_Type_commit( &sendtype->datatype ); + if (merr) MTestPrintError( merr ); + merr = MPI_Type_set_name( sendtype->datatype, + (char*)"int-vector" ); + if (merr) MTestPrintError( merr ); + sendtype->count = 1; + recvtype->datatype = MPI_INT; + recvtype->isBasic = 1; + sendtype->InitBuf = MTestTypeVectorInit; + recvtype->InitBuf = MTestTypeContigInitRecv; + sendtype->FreeBuf = MTestTypeVectorFree; + recvtype->FreeBuf = MTestTypeContigFree; + sendtype->CheckBuf = 0; + recvtype->CheckBuf = MTestTypeContigCheckbuf; + break; + + case 5: + /* Indexed send using many small blocks and contig receive */ + sendtype->blksize = sizeof(int); + sendtype->nelm = recvtype->count; + sendtype->basesize = sizeof(int); + sendtype->displs = (int *)malloc( sendtype->nelm * sizeof(int) ); + sendtype->index = (int *)malloc( sendtype->nelm * sizeof(int) ); + if (!sendtype->displs || !sendtype->index) { + MTestError( "Out of memory in type init\n" ); + } + /* Make the sizes larger (4 ints) to help push the total + size to over 256k in some cases, as the MPICH code as of + 10/1/06 used large internal buffers for packing non-contiguous + messages */ + for (i=0; inelm; i++) { + sendtype->index[i] = 4; + sendtype->displs[i] = 5*i; + } + merr = MPI_Type_indexed( sendtype->nelm, + sendtype->index, sendtype->displs, + MPI_INT, &sendtype->datatype ); + if (merr) MTestPrintError( merr ); + merr = MPI_Type_commit( &sendtype->datatype ); + if (merr) MTestPrintError( merr ); + merr = MPI_Type_set_name( sendtype->datatype, + (char*)"int-indexed(4-int)" ); + if (merr) MTestPrintError( merr ); + sendtype->count = 1; + sendtype->InitBuf = MTestTypeIndexedInit; + sendtype->FreeBuf = MTestTypeIndexedFree; + sendtype->CheckBuf = 0; + + recvtype->datatype = MPI_INT; + recvtype->isBasic = 1; + recvtype->count = count * 4; + recvtype->InitBuf = MTestTypeContigInitRecv; + recvtype->FreeBuf = MTestTypeContigFree; + recvtype->CheckBuf = MTestTypeContigCheckbuf; + break; + + case 6: + /* Indexed send using 2 large blocks and contig receive */ + sendtype->blksize = sizeof(int); + sendtype->nelm = 2; + sendtype->basesize = sizeof(int); + sendtype->displs = (int *)malloc( sendtype->nelm * sizeof(int) ); + sendtype->index = (int *)malloc( sendtype->nelm * sizeof(int) ); + if (!sendtype->displs || !sendtype->index) { + MTestError( "Out of memory in type init\n" ); + } + /* index -> block size */ + sendtype->index[0] = (recvtype->count + 1) / 2; + sendtype->displs[0] = 0; + sendtype->index[1] = recvtype->count - sendtype->index[0]; + sendtype->displs[1] = sendtype->index[0] + 1; + /* There is a deliberate gap here */ + + merr = MPI_Type_indexed( sendtype->nelm, + sendtype->index, sendtype->displs, + MPI_INT, &sendtype->datatype ); + if (merr) MTestPrintError( merr ); + merr = MPI_Type_commit( &sendtype->datatype ); + if (merr) MTestPrintError( merr ); + merr = MPI_Type_set_name( sendtype->datatype, + (char*)"int-indexed(2 blocks)" ); + if (merr) MTestPrintError( merr ); + sendtype->count = 1; + sendtype->InitBuf = MTestTypeIndexedInit; + sendtype->FreeBuf = MTestTypeIndexedFree; + sendtype->CheckBuf = 0; + + recvtype->datatype = MPI_INT; + recvtype->isBasic = 1; + recvtype->count = sendtype->index[0] + sendtype->index[1]; + recvtype->InitBuf = MTestTypeContigInitRecv; + recvtype->FreeBuf = MTestTypeContigFree; + recvtype->CheckBuf = MTestTypeContigCheckbuf; + break; + + case 7: + /* Indexed receive using many small blocks and contig send */ + recvtype->blksize = sizeof(int); + recvtype->nelm = recvtype->count; + recvtype->basesize = sizeof(int); + recvtype->displs = (int *)malloc( recvtype->nelm * sizeof(int) ); + recvtype->index = (int *)malloc( recvtype->nelm * sizeof(int) ); + if (!recvtype->displs || !recvtype->index) { + MTestError( "Out of memory in type recv init\n" ); + } + /* Make the sizes larger (4 ints) to help push the total + size to over 256k in some cases, as the MPICH code as of + 10/1/06 used large internal buffers for packing non-contiguous + messages */ + /* Note that there are gaps in the indexed type */ + for (i=0; inelm; i++) { + recvtype->index[i] = 4; + recvtype->displs[i] = 5*i; + } + merr = MPI_Type_indexed( recvtype->nelm, + recvtype->index, recvtype->displs, + MPI_INT, &recvtype->datatype ); + if (merr) MTestPrintError( merr ); + merr = MPI_Type_commit( &recvtype->datatype ); + if (merr) MTestPrintError( merr ); + merr = MPI_Type_set_name( recvtype->datatype, + (char*)"recv-int-indexed(4-int)" ); + if (merr) MTestPrintError( merr ); + recvtype->count = 1; + recvtype->InitBuf = MTestTypeIndexedInitRecv; + recvtype->FreeBuf = MTestTypeIndexedFree; + recvtype->CheckBuf = MTestTypeIndexedCheckbuf; + + sendtype->datatype = MPI_INT; + sendtype->isBasic = 1; + sendtype->count = count * 4; + sendtype->InitBuf = MTestTypeContigInit; + sendtype->FreeBuf = MTestTypeContigFree; + sendtype->CheckBuf = 0; + break; + + /* Less commonly used but still simple types */ + case 8: + sendtype->datatype = MPI_SHORT; + sendtype->isBasic = 1; + recvtype->datatype = MPI_SHORT; + recvtype->isBasic = 1; + break; + case 9: + sendtype->datatype = MPI_LONG; + sendtype->isBasic = 1; + recvtype->datatype = MPI_LONG; + recvtype->isBasic = 1; + break; + case 10: + sendtype->datatype = MPI_CHAR; + sendtype->isBasic = 1; + recvtype->datatype = MPI_CHAR; + recvtype->isBasic = 1; + break; + case 11: + sendtype->datatype = MPI_UINT64_T; + sendtype->isBasic = 1; + recvtype->datatype = MPI_UINT64_T; + recvtype->isBasic = 1; + break; + case 12: + sendtype->datatype = MPI_FLOAT; + sendtype->isBasic = 1; + recvtype->datatype = MPI_FLOAT; + recvtype->isBasic = 1; + break; + +#ifndef USE_STRICT_MPI + /* MPI_BYTE may only be used with MPI_BYTE in strict MPI */ + case 13: + sendtype->datatype = MPI_INT; + sendtype->isBasic = 1; + recvtype->datatype = MPI_BYTE; + recvtype->isBasic = 1; + recvtype->count *= sizeof(int); + break; +#endif + default: + datatype_index = -1; + } + + if (!sendtype->InitBuf) { + sendtype->InitBuf = MTestTypeContigInit; + recvtype->InitBuf = MTestTypeContigInitRecv; + sendtype->FreeBuf = MTestTypeContigFree; + recvtype->FreeBuf = MTestTypeContigFree; + sendtype->CheckBuf = MTestTypeContigCheckbuf; + recvtype->CheckBuf = MTestTypeContigCheckbuf; + } + datatype_index++; + + if (dbgflag && datatype_index > 0) { + int typesize; + fprintf( stderr, "%d: sendtype is %s\n", wrank, MTestGetDatatypeName( sendtype ) ); + merr = MPI_Type_size( sendtype->datatype, &typesize ); + if (merr) MTestPrintError( merr ); + fprintf( stderr, "%d: sendtype size = %d\n", wrank, typesize ); + fprintf( stderr, "%d: recvtype is %s\n", wrank, MTestGetDatatypeName( recvtype ) ); + merr = MPI_Type_size( recvtype->datatype, &typesize ); + if (merr) MTestPrintError( merr ); + fprintf( stderr, "%d: recvtype size = %d\n", wrank, typesize ); + fflush( stderr ); + + } + else if (verbose && datatype_index > 0) { + printf( "Get new datatypes: send = %s, recv = %s\n", + MTestGetDatatypeName( sendtype ), + MTestGetDatatypeName( recvtype ) ); + fflush( stdout ); + } + + return 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 ) +{ + datatype_index = 0; +} +/* 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 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; +} + +/* This next routine uses a circular buffer of static name arrays just to + simplify the use of the routine */ +const char *MTestGetDatatypeName( MTestDatatype *dtype ) +{ + static char name[4][MPI_MAX_OBJECT_NAME]; + static int sp=0; + int rlen, merr; + + if (sp >= 4) sp = 0; + merr = MPI_Type_get_name( dtype->datatype, name[sp], &rlen ); + if (merr) MTestPrintError( merr ); + return (const char *)name[sp++]; +} +/* ----------------------------------------------------------------------- */ + +/* + * 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. + * + */ +static __thread int interCommIdx = 0; +static __thread int intraCommIdx = 0; +static __thread const char *intraCommName = 0; +static __thread const char *interCommName = 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 done2, 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; + intraCommName = ""; + switch (intraCommIdx) { + case 0: + *comm = MPI_COMM_WORLD; + isBasic = 1; + intraCommName = "MPI_COMM_WORLD"; + break; + case 1: + /* dup of world */ + merr = MPI_Comm_dup(MPI_COMM_WORLD, comm ); + if (merr) MTestPrintError( merr ); + 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 ); + 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 ); + intraCommName = "Rank reverse of half of MPI_COMM_WORLD"; + break; + case 4: + *comm = MPI_COMM_SELF; + isBasic = 1; + intraCommName = "MPI_COMM_SELF"; + break; + + /* These next cases are communicators that include some + but not all of the processes */ + case 5: + case 6: + case 7: + case 8: + { + int newsize; + merr = MPI_Comm_size( MPI_COMM_WORLD, &size ); + if (merr) MTestPrintError( merr ); + newsize = size - (intraCommIdx - 4); + + 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 { + intraCommName = "Split of WORLD"; + } + } + else { + /* Act like default */ + *comm = MPI_COMM_NULL; + intraCommIdx = -1; + } + } + break; + + /* Other ideas: dup of self, cart comm, graph comm */ + default: + *comm = MPI_COMM_NULL; + 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 { + intraCommName = "MPI_COMM_NULL"; + isBasic = 1; + done = 1; + } +done2=done; + /* we are only done if all processes are done */ + MPI_Allreduce(&done2, &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. */ + intraCommIdx++; + + if (!done && !isBasic && *comm != MPI_COMM_NULL) { + /* avoid leaking communicators */ + merr = MPI_Comm_free(comm); + if (merr) MTestPrintError(merr); + } + } + + return 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 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; + interCommName = "MPI_COMM_NULL"; + + switch (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 ); + 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 ); + 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 ); + 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 ); + 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; + rank = 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 ); + 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 ); + } + 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 ); + + 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; + 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 { + 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. */ + 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 interCommIdx; +} +/* Return the name of an intercommunicator */ +const char *MTestGetIntercommName( void ) +{ + return 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 __thread 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 (verbose && level >= 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 __thread 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 + */ +static __thread int win_index = 0; +static const char *winName; +/* Use an attribute to remember the type of memory allocation (static, + malloc, or MPI_Alloc_mem) */ +static __thread int mem_keyval = 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 (mem_keyval == MPI_KEYVAL_INVALID) { + /* Create the keyval */ + merr = MPI_Win_create_keyval( MPI_WIN_NULL_COPY_FN, + MPI_WIN_NULL_DELETE_FN, + &mem_keyval, 0 ); + if (merr) MTestPrintError( merr ); + + } + + switch (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 ); + winName = "active-window"; + merr = MPI_Win_set_attr( *win, 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 ); + winName = "passive-window"; + merr = MPI_Win_set_attr( *win, 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 ); + winName = "active-all-different-win"; + merr = MPI_Win_set_attr( *win, 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 ); + winName = "active-nolocks-all-different-win"; + merr = MPI_Win_set_attr( *win, mem_keyval, (void *)1 ); + if (merr) MTestPrintError( merr ); + break; + default: + win_index = -1; + } + win_index++; + return win_index; +} +/* Return a pointer to the name associated with a window object */ +const char *MTestGetWinName( void ) +{ + return 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, 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 (mem_keyval != MPI_KEYVAL_INVALID) { + MPI_Win_free_keyval( &mem_keyval ); + } +} +#else +static void MTestRMACleanup( void ) {} +#endif