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)
)
set(txt_files
${txt_files}
- ${CMAKE_CURRENT_SOURCE_DIR}/runtests
${CMAKE_CURRENT_SOURCE_DIR}/testlist
PARENT_SCOPE
)
)
set(txt_files
${txt_files}
- ${CMAKE_CURRENT_SOURCE_DIR}/runtests
${CMAKE_CURRENT_SOURCE_DIR}/testlist
PARENT_SCOPE
)
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)
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)
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}")
)
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
)
set(txt_files
${txt_files}
- ${CMAKE_CURRENT_SOURCE_DIR}/runtests
${CMAKE_CURRENT_SOURCE_DIR}/testlist
PARENT_SCOPE
)
--- /dev/null
+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
+ )
--- /dev/null
+/* -*- 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 <stdio.h>
+#include <stdlib.h>
+#include "mpitestconf.h"
+#ifdef HAVE_STRING_H
+#include <string.h>
+#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;
+}
+
--- /dev/null
+/* -*- 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 <stdio.h>
+#include <stdlib.h>
+#include "mpitestconf.h"
+#ifdef HAVE_STRING_H
+#include <string.h>
+#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;
+}
+
--- /dev/null
+/* -*- 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 <unistd.h>
+#endif
+#include <stdio.h>
+#include <stdlib.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 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;
+}
+
--- /dev/null
+/* -*- 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 <stdio.h>
+#include <stdlib.h>
+#include "mpitestconf.h"
+#ifdef HAVE_STRING_H
+#include <string.h>
+#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;
+}
+
--- /dev/null
+/* -*- 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 <stdio.h>
+
+/*
+ * 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;
+}
--- /dev/null
+/* -*- 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 <limits.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <mpi.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 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;
+}
--- /dev/null
+/* -*- Mode: C; c-basic-offset:4 ; -*- */
+/*
+ * (C) 2012 by Argonne National Laboratory.
+ * See COPYRIGHT in top-level directory.
+ */
+#include "mpi.h"
+#include <stdio.h>
+#include <stdlib.h>
+#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<by; jj++) {
+ for (i=0; i<6/bx; i++) {
+ for (ii=0; ii<bx; ii++) {
+ int expected = rx * bx + ry * by * nx + i * bx * px + ii +
+ (j * by * py + jj) * nx;
+ if (destArray[loc] != expected) {
+ errs++;
+ fprintf( stderr, "2D(c(2)c(3)): [%d,%d] = %d, expected %d\n",
+ i*bx+ii, j*by+jj, destArray[loc], expected );
+ }
+ loc++;
+ }
+ }
+ }
+ }
+
+ free( srcArray );
+ free( destArray );
+ MPI_Type_free( &darraytype );
+
+ MTest_Finalize( errs );
+ MPI_Finalize();
+
+ return 0;
+}
+
+int AllocateGrid( int nx, int ny, int **srcArray, int **destArray )
+{
+ int *src, *dest;
+ int i, j;
+ src = (int *)malloc( nx*ny*sizeof(int) );
+ dest = (int *)malloc( nx*ny*sizeof(int) );
+ if (!src || !dest) {
+ fprintf( stderr, "Unable to allocate test arrays of size (%d x %d)\n",
+ nx, ny );
+ return 1;
+ }
+ for (i=0; i<nx*ny; i++) {
+ src[i] = i;
+ dest[i] = -i-1;
+ }
+ *srcArray = src;
+ *destArray = dest;
+ return 0;
+}
+
+/* Extract the source array into the dest array using the DARRAY datatype.
+ "count" integers are returned in destArray */
+int PackUnpack( MPI_Datatype darraytype, const int srcArray[], int destArray[],
+ int count )
+{
+ int packsize, position;
+ int *packArray;
+
+ MPI_Type_commit( &darraytype );
+ MPI_Pack_size( 1, darraytype, MPI_COMM_SELF, &packsize );
+ packArray = (int *)malloc( packsize );
+ if (!packArray) {
+ fprintf( stderr, "Unable to allocate pack array of size %d\n",
+ packsize );
+ MPI_Abort( MPI_COMM_WORLD, 1 );
+ }
+ position = 0;
+ MPI_Pack( (int*)srcArray, 1, darraytype, packArray, packsize, &position,
+ MPI_COMM_SELF );
+ packsize = position;
+ position = 0;
+ MPI_Unpack( packArray, packsize, &position, destArray, count, MPI_INT,
+ MPI_COMM_SELF );
+ free( packArray );
+ return 0;
+}
--- /dev/null
+/* -*- 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 <stdio.h>
+#include <stdlib.h>
+#include <string.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;
+
+/* 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;
+}
--- /dev/null
+/* -*- 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 <stdio.h>
+#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;
+}
--- /dev/null
+/* -*- 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 <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+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;
+}
--- /dev/null
+/* -*- 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 <stdio.h>
+#include <stddef.h>
+#include <assert.h>
+
+/* 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;
+}
+
--- /dev/null
+/* -*- 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 <stdio.h>
+#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;
+
+}
--- /dev/null
+/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */
+/*
+ * (C) 2001 by Argonne National Laboratory.
+ * See COPYRIGHT in top-level directory.
+ */
+#include <math.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#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;
+}
--- /dev/null
+/* -*- 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 <stdio.h>
+#include <stdlib.h>
+#include "mpitestconf.h"
+#ifdef HAVE_STRING_H
+#include <string.h>
+#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)*/
--- /dev/null
+/* -*- 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 <mpi.h>
+#include <stdlib.h>
+#include <stdio.h>
+/* 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;
+}
--- /dev/null
+/* -*- 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 <stdio.h>
+#include <stdlib.h>
+#include "mpitestconf.h"
+#ifdef HAVE_STRING_H
+#include <string.h>
+#endif
+#include <assert.h>
+#include <limits.h>
+
+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;
+}
+
--- /dev/null
+/* -*- 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 <limits.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <mpi.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 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;
+}
--- /dev/null
+/* -*- 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 <stdio.h>
+#include <stdlib.h>
+#include "mpitest.h"
+#include "mpitestconf.h"
+#ifdef HAVE_STRING_H
+#include <string.h>
+#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;
+}
--- /dev/null
+/* -*- 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 <math.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include "mpitest.h"
+#include "mpitestconf.h"
+#ifdef HAVE_STRING_H
+#include <string.h>
+#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;
+}
--- /dev/null
+/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */
+/*
+ * (C) 2012 by Argonne National Laboratory.
+ * See COPYRIGHT in top-level directory.
+ */
+
+#include <stdlib.h>
+#include <stdio.h>
+#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;
+}
+
--- /dev/null
+/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */
+/*
+ * (C) 2001 by Argonne National Laboratory.
+ * See COPYRIGHT in top-level directory.
+ */
+#include <math.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#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;
+}
--- /dev/null
+/* -*- 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 <stdio.h>
+#include <stdlib.h>
+#include "mpitestconf.h"
+#ifdef HAVE_STRING_H
+#include <string.h>
+#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;
+}
--- /dev/null
+/* -*- 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 <stdio.h>
+#include "mpitestconf.h"
+#ifdef HAVE_STRING_H
+#include <string.h>
+#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;
+}
--- /dev/null
+/* -*- 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 <stdio.h>
+#include "mpitestconf.h"
+#ifdef HAVE_STRING_H
+#include <string.h>
+#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;
+}
--- /dev/null
+/* -*- 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 <unistd.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#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;
+}
+
--- /dev/null
+/* -*- 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 <stdio.h>
+#include <stdlib.h>
+#include "mpitestconf.h"
+#ifdef HAVE_STRING_H
+#include <string.h>
+#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;
+}
+
--- /dev/null
+/* -*- 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 <stdio.h>
+#include <stdlib.h>
+#include "mpitestconf.h"
+#ifdef HAVE_STRING_H
+#include <string.h>
+#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;
+}
+
--- /dev/null
+/* -*- 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 <stdio.h>
+#include "mpitestconf.h"
+#ifdef HAVE_STRING_H
+#include <string.h>
+#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;
+}
--- /dev/null
+/* -*- 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 <stdio.h>
+#include <stdlib.h>
+#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;
+}
--- /dev/null
+/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */
+/*
+ * (C) 2001 by Argonne National Laboratory.
+ * See COPYRIGHT in top-level directory.
+ */
+#include <stdio.h>
+#include <math.h>
+#include <stdlib.h>
+#include <unistd.h>
+#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;
+}
--- /dev/null
+/* -*- 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 <stdio.h>
+#include <math.h>
+#include <stdlib.h>
+#include "mpitest.h"
+#include "mpitestconf.h"
+#ifdef HAVE_STRING_H
+#include <string.h>
+#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;
+}
--- /dev/null
+/* -*- 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 <stdio.h>
+
+#include <mpi.h>
+#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;
+}
--- /dev/null
+/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */
+/*
+ * (C) 2001 by Argonne National Laboratory.
+ * See COPYRIGHT in top-level directory.
+ */
+#include <math.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#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;
+}
--- /dev/null
+/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */
+/*
+ * (C) 2008 by Argonne National Laboratory.
+ * See COPYRIGHT in top-level directory.
+ */
+#include <stdio.h>
+#include <stdlib.h>
+#include "mpi.h"
+#include <string.h>
+
+#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;
+}
--- /dev/null
+/* -*- 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 <stdio.h>
+#include <stdlib.h>
+#include "mpitest.h"
+#include "mpitestconf.h"
+#ifdef HAVE_STRING_H
+#include <string.h>
+#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;
+}
+
--- /dev/null
+/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */
+/*
+ * (C) 2001 by Argonne National Laboratory.
+ * See COPYRIGHT in top-level directory.
+ */
+#include <math.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#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;
+}
--- /dev/null
+/* -*- 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 <robl@mcs.anl.gov> as a simplification of a type
+ * encountered by the HDF5 library.
+ *
+ * Should be run with 1 process. */
+
+#include <stdio.h>
+#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<NTYPES; i++) {
+ MPI_Type_free(&(types[i]));
+ }
+ return 0;
+}
+
+int main(int argc, char **argv)
+{
+ MPI_Datatype hdf5type;
+
+ MPI_Init(&argc, &argv);
+ makeHDF5type(&hdf5type);
+
+ /*MPIDU_Datatype_debug(hdf5type, 32);*/
+
+ MPI_Type_free(&hdf5type);
+ MPI_Finalize();
+
+ printf(" No Errors\n");
+
+ return 0;
+}
+
--- /dev/null
+/* -*- 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 <stdio.h>
+#include <stdlib.h>
+#include "mpitestconf.h"
+#ifdef HAVE_STRING_H
+#include <string.h>
+#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;
+}
+
--- /dev/null
+/* -*- 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 <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+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;
+}
+
--- /dev/null
+/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */
+/*
+ * (C) 2001 by Argonne National Laboratory.
+ * See COPYRIGHT in top-level directory.
+ */
+
+#include <stdio.h>
+#include <string.h>
+#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;
+}
--- /dev/null
+#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
--- /dev/null
+/* -*- 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 <stdio.h>
+#include <stdlib.h>
+#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<VEC_NELM*VEC_STRIDE; i++) buf[i] = -i;
+ MPI_Irecv( buf, 1, strideType, source, 0, comm, &req );
+ MPI_Type_free( &strideType );
+
+ for (i=0; i<1024; i++) {
+ MPI_Type_vector( VEC_NELM, 1, 1, MPI_INT, &tmpType[i] );
+ MPI_Type_commit( &tmpType[i] );
+ }
+
+ MPI_Sendrecv( 0, 0, MPI_INT, source, 1,
+ 0, 0, MPI_INT, source, 1, comm, &status );
+
+ MPI_Wait( &req, &status );
+ for (i=0; i<VEC_NELM; i++) {
+ if (buf[VEC_STRIDE*i] != i) {
+ errs++;
+ if (errs < 10) {
+ printf( "buf[%d] = %d, expected %d\n", VEC_STRIDE*i,
+ buf[VEC_STRIDE*i], i );
+ }
+ }
+ }
+ for (i=0; i<1024; i++) {
+ MPI_Type_free( &tmpType[i] );
+ }
+ free( buf );
+ }
+ else if (rank == source) {
+ buf = (int *)malloc( VEC_NELM * sizeof(int) );
+ for (i=0; i<VEC_NELM; i++) buf[i] = i;
+ /* Synchronize with the receiver */
+ MPI_Sendrecv( 0, 0, MPI_INT, dest, 1,
+ 0, 0, MPI_INT, dest, 1, comm, &status );
+ MPI_Send( buf, VEC_NELM, MPI_INT, dest, 0, comm );
+ free( buf );
+ }
+
+ /* Clean up the strideType */
+ if (rank != dest) {
+ MPI_Type_free( &strideType );
+ }
+
+
+ MTest_Finalize( errs );
+ MPI_Finalize();
+ return 0;
+}
--- /dev/null
+/* -*- 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 <stdio.h>
+#include <stdlib.h>
+#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;
+}
--- /dev/null
+/* -*- 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 <math.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include "mpitest.h"
+#include "mpitestconf.h"
+#ifdef HAVE_STRING_H
+#include <string.h>
+#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;
+}
--- /dev/null
+/* -*- 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 <stdio.h>
+#include <stdlib.h>
+#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<count; i++) buf[3*i] = i;
+ MPI_Send( buf, count, newtype, dest, 0, comm );
+ MPI_Send( buf, count, newtype, dest, 1, comm );
+ }
+ else if (rank == dest) {
+ MPI_Recv( buf, count, MPI_INT, source, 0, comm, &status );
+ for (i=0; i<count; i++) {
+ if (buf[i] != i) {
+ errs++;
+ if (errs < 10) {
+ printf( "buf[%d] = %d\n", i, buf[i] );
+ }
+ }
+ }
+ for (i=0; i<count*3; i++) buf[i] = -1;
+ MPI_Recv( buf, count, newtype, source, 1, comm, &status );
+ for (i=0; i<count; i++) {
+ if (buf[3*i] != i) {
+ errs++;
+ if (errs < 10) {
+ printf( "buf[3*%d] = %d\n", i, buf[i] );
+ }
+ }
+ }
+ }
+ }
+
+ MPI_Type_free( &newtype );
+
+ MTest_Finalize( errs );
+ MPI_Finalize();
+ return 0;
+}
--- /dev/null
+/* -*- 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 <stdio.h>
+#include <stdlib.h>
+#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<count; i++) buf[3*i] = i;
+ MPI_Send( buf, count, newtype, dest, 0, comm );
+ MPI_Send( buf, count, newtype, dest, 1, comm );
+ }
+ else if (rank == dest) {
+ MPI_Recv( buf, count, MPI_INT, source, 0, comm, &status );
+ for (i=0; i<count; i++) {
+ if (buf[i] != i) {
+ errs++;
+ if (errs < 10) {
+ printf( "buf[%d] = %d\n", i, buf[i] );
+ }
+ }
+ }
+ for (i=0; i<count*3; i++) buf[i] = -1;
+ MPI_Recv( buf, count, newtype, source, 1, comm, &status );
+ for (i=0; i<count; i++) {
+ if (buf[3*i] != i) {
+ errs++;
+ if (errs < 10) {
+ printf( "buf[3*%d] = %d\n", i, buf[i] );
+ }
+ }
+ }
+ }
+ }
+ MPI_Type_free( &newtype );
+
+ MTest_Finalize( errs );
+ MPI_Finalize();
+ return 0;
+}
--- /dev/null
+/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */
+/*
+ * (C) 2001 by Argonne National Laboratory.
+ * See COPYRIGHT in top-level directory.
+ */
+#include <math.h>
+#include <unistd.h>
+#include <stdlib.h>
+#include <stdio.h>
+#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;
+}
--- /dev/null
+/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */
+/*
+ * (C) 2006 by Argonne National Laboratory.
+ * See COPYRIGHT in top-level directory.
+ */
+#include <stdio.h>
+#include <mpi.h>
+#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;
+}
--- /dev/null
+/* -*- 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 <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+/*
+ * 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;
+}
--- /dev/null
+/* -*- 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 <stdio.h>
+
+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;
+}
--- /dev/null
+/* -*- 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 <stdio.h>
+#include <string.h>
+
+/* 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;
+}
--- /dev/null
+/* -*- 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 <stdio.h>
+#include "mpitest.h"
+#include <stdlib.h>
+#include <string.h>
+
+/* 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;
+}
--- /dev/null
+/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */
+/*
+ * (C) 2001 by Argonne National Laboratory.
+ * See COPYRIGHT in top-level directory.
+ */
+#include <math.h>
+#include <assert.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#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;
+}
--- /dev/null
+/* -*- 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 <stdio.h>
+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);
+}
--- /dev/null
+/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */
+/*
+ * (C) 2001 by Argonne National Laboratory.
+ * See COPYRIGHT in top-level directory.
+ */
+#include <stdio.h>
+#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;
+
+}
--- /dev/null
+/* -*- 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 <stdio.h>
+
+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;
+}
)
set(txt_files
${txt_files}
- ${CMAKE_CURRENT_SOURCE_DIR}/runtests
${CMAKE_CURRENT_SOURCE_DIR}/testlist
PARENT_SCOPE
)
)
set(txt_files
${txt_files}
- ${CMAKE_CURRENT_SOURCE_DIR}/runtests
${CMAKE_CURRENT_SOURCE_DIR}/testlist
PARENT_SCOPE
)
)
set(txt_files
${txt_files}
- ${CMAKE_CURRENT_SOURCE_DIR}/runtests
${CMAKE_CURRENT_SOURCE_DIR}/testlist
PARENT_SCOPE
)
--- /dev/null
+/* -*- 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 <stdio.h>
+#endif
+#if defined(HAVE_STDLIB_H) || defined(STDC_HEADERS)
+#include <stdlib.h>
+#endif
+#if defined(HAVE_STRING_H) || defined(STDC_HEADERS)
+#include <string.h>
+#endif
+#ifdef HAVE_STDARG_H
+#include <stdarg.h>
+#endif
+/* The following two includes permit the collection of resource usage
+ data in the tests
+ */
+#ifdef HAVE_SYS_TIME_H
+#include <sys/time.h>
+#endif
+#ifdef HAVE_SYS_RESOURCE_H
+#include <sys/resource.h>
+#endif
+#include <errno.h>
+
+
+/*
+ * 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 <windows.h>
+void MTestSleep( int sec )
+{
+ Sleep( 1000 * sec );
+}
+#else
+#include <unistd.h>
+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; i<totsize; i++) {
+ p[i] = 0xff ^ (i & 0xff);
+ }
+ }
+ else {
+ if (mtype->buf) {
+ 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; i<totsize; i++) {
+ p[i] = 0xff;
+ }
+ }
+ else {
+ if (mtype->buf) {
+ 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; i<totsize; i++) {
+ expected = (0xff ^ (i & 0xff));
+ if (p[i] != expected) {
+ err++;
+ if (mtype->printErrors && 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; i<totsize; i++) p[i] = 0xff;
+
+ /* Now, set the actual elements to the successive values.
+ To do this, we need to run 3 loops */
+ nc = 0;
+ /* count is usually one for a vector type */
+ for (k=0; k<mtype->count; k++) {
+ /* For each element (block) */
+ for (i=0; i<mtype->nelm; i++) {
+ /* For each value */
+ for (j=0; j<mtype->blksize; 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; i<totsize; i++) p[i] = 0xff;
+
+ /* Now, set the actual elements to the successive values.
+ We require that the base type is a contiguous type */
+ k = 0;
+ for (i=0; i<mtype->nelm; i++) {
+ int b;
+ /* Compute the offset: */
+ offset = mtype->displs[i] * mtype->basesize;
+ /* For each element in the block */
+ for (b=0; b<mtype->index[i]; b++) {
+ for (j=0; j<mtype->basesize; 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; i<totsize; i++) {
+ p[i] = 0xff;
+ }
+ }
+ else {
+ /* count == 0 */
+ if (mtype->buf) {
+ 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; i<mtype->nelm; i++) {
+ int b;
+ /* Compute the offset: */
+ offset = mtype->displs[i] * mtype->basesize;
+ for (b=0; b<mtype->index[i]; b++) {
+ for (j=0; j<mtype->basesize; 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; i<sendtype->nelm; 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; i<recvtype->nelm; 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
