From: Augustin Degomme Date: Fri, 12 Jul 2013 16:43:38 +0000 (+0200) Subject: Add mpich3 test suite, to replace older one. X-Git-Tag: v3_9_90~142 X-Git-Url: http://info.iut-bm.univ-fcomte.fr/pub/gitweb/simgrid.git/commitdiff_plain/c81c99a491282f76757c2673961e3cdee6853539 Add mpich3 test suite, to replace older one. This one is more complete, but a lot of tests are for MPI functions not supported in SMPI Lots of tests are disabled, and some folders not (yet) included. --- diff --git a/buildtools/Cmake/AddTests.cmake b/buildtools/Cmake/AddTests.cmake index 67b21e5b7a..556a8aeb56 100644 --- a/buildtools/Cmake/AddTests.cmake +++ b/buildtools/Cmake/AddTests.cmake @@ -455,14 +455,16 @@ if(NOT enable_memcheck) if(enable_smpi) if(HAVE_RAWCTX) - ADD_TEST(smpi-mpich-env-raw ${CMAKE_COMMAND} -E chdir ${CMAKE_BINARY_DIR}/teshsuite/smpi/mpich-test/env ${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich-test/env/runtests -srcdir=${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich-test/env -basedir=${CMAKE_BINARY_DIR}/smpi_script/ -fort=${SMPI_F2C}) - ADD_TEST(smpi-mpich-pt2pt-raw ${CMAKE_COMMAND} -E chdir ${CMAKE_BINARY_DIR}/teshsuite/smpi/mpich-test/pt2pt ${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich-test/pt2pt/runtests -srcdir=${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich-test/pt2pt -basedir=${CMAKE_BINARY_DIR}/smpi_script/ -fort=${SMPI_F2C}) - ADD_TEST(smpi-mpich-context-raw ${CMAKE_COMMAND} -E chdir ${CMAKE_BINARY_DIR}/teshsuite/smpi/mpich-test/context ${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich-test/context/runtests -srcdir=${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich-test/context -basedir=${CMAKE_BINARY_DIR}/smpi_script/ -fort=${SMPI_F2C}) - ADD_TEST(smpi-mpich-profile-raw ${CMAKE_COMMAND} -E chdir ${CMAKE_BINARY_DIR}/teshsuite/smpi/mpich-test/profile ${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich-test/profile/runtests -srcdir=${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich-test/profile -basedir=${CMAKE_BINARY_DIR}/smpi_script/ -fort=${SMPI_F2C}) - ADD_TEST(smpi-mpich-coll-raw ${CMAKE_COMMAND} -E chdir ${CMAKE_BINARY_DIR}/teshsuite/smpi/mpich-test/coll ${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich-test/coll/runtests -srcdir=${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich-test/coll -basedir=${CMAKE_BINARY_DIR}/smpi_script/ -fort=${SMPI_F2C}) - ADD_TEST(smpi-mpich-coll-selector-mpich-raw ${CMAKE_COMMAND} -E chdir ${CMAKE_BINARY_DIR}/teshsuite/smpi/mpich-test/coll ${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich-test/coll/runtests -srcdir=${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich-test/coll -basedir=${CMAKE_BINARY_DIR}/smpi_script/ -fort=${SMPI_F2C} -selector=mpich) - ADD_TEST(smpi-mpich-coll-selector-ompi-raw ${CMAKE_COMMAND} -E chdir ${CMAKE_BINARY_DIR}/teshsuite/smpi/mpich-test/coll ${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich-test/coll/runtests -srcdir=${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich-test/coll -basedir=${CMAKE_BINARY_DIR}/smpi_script/ -fort=${SMPI_F2C} -selector=ompi) - set_tests_properties(smpi-mpich-env-raw smpi-mpich-context-raw smpi-mpich-pt2pt-raw smpi-mpich-coll-raw smpi-mpich-coll-selector-ompi-raw smpi-mpich-coll-selector-mpich-raw smpi-mpich-profile-raw PROPERTIES PASS_REGULAR_EXPRESSION "-- No differences found; test successful") + ADD_TEST(smpi-mpich3-attr-raw ${CMAKE_COMMAND} -E chdir ${CMAKE_BINARY_DIR}/teshsuite/smpi/mpich3-test/attr ${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich3-test/runtests -srcdir=${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich3-test/attr -tests=testlist -execarg=--cfg=contexts/factory:raw) + ADD_TEST(smpi-mpich3-coll-thread ${CMAKE_COMMAND} -E chdir ${CMAKE_BINARY_DIR}/teshsuite/smpi/mpich3-test/coll ${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich3-test/runtests -srcdir=${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich3-test/coll -tests=testlist -execarg=--cfg=contexts/factory:thread) + ADD_TEST(smpi-mpich3-coll-ompi-thread ${CMAKE_COMMAND} -E chdir ${CMAKE_BINARY_DIR}/teshsuite/smpi/mpich3-test/coll ${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich3-test/runtests -srcdir=${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich3-test/coll -tests=testlist -execarg=--cfg=contexts/factory:thread -execarg=--cfg=smpi/coll_selector:ompi -execarg=--cfg=smpi/send_is_detached_thres:0) + ADD_TEST(smpi-mpich3-coll-mpich-thread ${CMAKE_COMMAND} -E chdir ${CMAKE_BINARY_DIR}/teshsuite/smpi/mpich3-test/coll ${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich3-test/runtests -srcdir=${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich3-test/coll -tests=testlist -execarg=--cfg=contexts/factory:thread -execarg=--cfg=smpi/coll_selector:mpich) + ADD_TEST(smpi-mpich3-comm-raw ${CMAKE_COMMAND} -E chdir ${CMAKE_BINARY_DIR}/teshsuite/smpi/mpich3-test/comm ${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich3-test/runtests -srcdir=${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich3-test/comm -tests=testlist -execarg=--cfg=contexts/factory:raw) + ADD_TEST(smpi-mpich3-init-raw ${CMAKE_COMMAND} -E chdir ${CMAKE_BINARY_DIR}/teshsuite/smpi/mpich3-test/init ${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich3-test/runtests -srcdir=${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich3-test/init -tests=testlist -execarg=--cfg=contexts/factory:raw) + ADD_TEST(smpi-mpich3-datatype-raw ${CMAKE_COMMAND} -E chdir ${CMAKE_BINARY_DIR}/teshsuite/smpi/mpich3-test/datatype ${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich3-test/runtests -srcdir=${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich3-test/datatype -tests=testlist -execarg=--cfg=contexts/factory:raw) + ADD_TEST(smpi-mpich3-group-raw ${CMAKE_COMMAND} -E chdir ${CMAKE_BINARY_DIR}/teshsuite/smpi/mpich3-test/group ${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich3-test/runtests -srcdir=${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich3-test/group -tests=testlist -execarg=--cfg=contexts/factory:raw) + ADD_TEST(smpi-mpich3-pt2pt-raw ${CMAKE_COMMAND} -E chdir ${CMAKE_BINARY_DIR}/teshsuite/smpi/mpich3-test/pt2pt ${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich3-test/runtests -srcdir=${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich3-test/pt2pt -tests=testlist -execarg=--cfg=contexts/factory:raw) + set_tests_properties(smpi-mpich3-attr-raw smpi-mpich3-coll-thread smpi-mpich3-coll-ompi-thread smpi-mpich3-coll-mpich-thread smpi-mpich3-comm-raw smpi-mpich3-init-raw smpi-mpich3-datatype-raw smpi-mpich3-pt2pt-raw smpi-mpich3-group-raw PROPERTIES PASS_REGULAR_EXPRESSION "tests passed!") endif() endif() diff --git a/buildtools/Cmake/DefinePackages.cmake b/buildtools/Cmake/DefinePackages.cmake index af33f03937..f53e862090 100644 --- a/buildtools/Cmake/DefinePackages.cmake +++ b/buildtools/Cmake/DefinePackages.cmake @@ -914,12 +914,20 @@ set(TESHSUITE_CMAKEFILES_TXT teshsuite/simdag/partask/CMakeLists.txt teshsuite/simdag/platforms/CMakeLists.txt teshsuite/smpi/CMakeLists.txt - teshsuite/smpi/mpich-test/CMakeLists.txt - teshsuite/smpi/mpich-test/coll/CMakeLists.txt - teshsuite/smpi/mpich-test/context/CMakeLists.txt - teshsuite/smpi/mpich-test/env/CMakeLists.txt - teshsuite/smpi/mpich-test/profile/CMakeLists.txt - teshsuite/smpi/mpich-test/pt2pt/CMakeLists.txt + # teshsuite/smpi/mpich-test/CMakeLists.txt + # teshsuite/smpi/mpich-test/coll/CMakeLists.txt + # teshsuite/smpi/mpich-test/context/CMakeLists.txt + # teshsuite/smpi/mpich-test/env/CMakeLists.txt + # teshsuite/smpi/mpich-test/profile/CMakeLists.txt + # teshsuite/smpi/mpich-test/pt2pt/CMakeLists.txt + teshsuite/smpi/mpich3-test/CMakeLists.txt + teshsuite/smpi/mpich3-test/attr/CMakeLists.txt + teshsuite/smpi/mpich3-test/comm/CMakeLists.txt + teshsuite/smpi/mpich3-test/coll/CMakeLists.txt + teshsuite/smpi/mpich3-test/datatype/CMakeLists.txt + teshsuite/smpi/mpich3-test/group/CMakeLists.txt + teshsuite/smpi/mpich3-test/init/CMakeLists.txt + teshsuite/smpi/mpich3-test/pt2pt/CMakeLists.txt teshsuite/xbt/CMakeLists.txt ) diff --git a/buildtools/Cmake/MakeExe.cmake b/buildtools/Cmake/MakeExe.cmake index c572a08aca..f56dc002ed 100644 --- a/buildtools/Cmake/MakeExe.cmake +++ b/buildtools/Cmake/MakeExe.cmake @@ -85,12 +85,20 @@ add_subdirectory(${CMAKE_HOME_DIRECTORY}/teshsuite/simdag/network/p2p) add_subdirectory(${CMAKE_HOME_DIRECTORY}/teshsuite/simdag/partask) add_subdirectory(${CMAKE_HOME_DIRECTORY}/teshsuite/simdag/platforms) add_subdirectory(${CMAKE_HOME_DIRECTORY}/teshsuite/smpi) -add_subdirectory(${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich-test) -add_subdirectory(${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich-test/coll) -add_subdirectory(${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich-test/context) -add_subdirectory(${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich-test/env) -add_subdirectory(${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich-test/profile) -add_subdirectory(${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich-test/pt2pt) +#add_subdirectory(${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich-test) +#add_subdirectory(${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich-test/coll) +#add_subdirectory(${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich-test/context) +#add_subdirectory(${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich-test/env) +#add_subdirectory(${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich-test/profile) +#add_subdirectory(${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich-test/pt2pt) +add_subdirectory(${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich3-test) +add_subdirectory(${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich3-test/attr) +add_subdirectory(${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich3-test/comm) +add_subdirectory(${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich3-test/coll) +add_subdirectory(${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich3-test/datatype) +add_subdirectory(${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich3-test/group) +add_subdirectory(${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich3-test/init) +add_subdirectory(${CMAKE_HOME_DIRECTORY}/teshsuite/smpi/mpich3-test/pt2pt) add_subdirectory(${CMAKE_HOME_DIRECTORY}/teshsuite/xbt) add_subdirectory(${CMAKE_HOME_DIRECTORY}/testsuite/surf) diff --git a/teshsuite/smpi/mpich3-test/CMakeLists.txt b/teshsuite/smpi/mpich3-test/CMakeLists.txt new file mode 100644 index 0000000000..97f032f167 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/CMakeLists.txt @@ -0,0 +1,41 @@ +set(tesh_files + ${tesh_files} + + PARENT_SCOPE + ) +set(xml_files + ${xml_files} + PARENT_SCOPE + ) +set(examples_src + ${examples_src} + PARENT_SCOPE + ) +set(bin_files + ${bin_files} + PARENT_SCOPE + ) + +#set(stdo_std_smpi +# ${CMAKE_CURRENT_SOURCE_DIR}/topol/cartmap.std +# ${CMAKE_CURRENT_SOURCE_DIR}/topol/graphtest.std +# ${CMAKE_CURRENT_SOURCE_DIR}/topol/cartf.std +#) + +if("${CMAKE_BINARY_DIR}" STREQUAL "${CMAKE_HOME_DIRECTORY}") +else() + foreach(srcfile ${stdo_std_smpi}) + set(dstfile ${srcfile}) + string(REPLACE "${CMAKE_HOME_DIRECTORY}" "${CMAKE_BINARY_DIR}" dstfile "${dstfile}") + #message("copy ${srcfile} to ${dstfile}") + configure_file("${srcfile}" "${dstfile}" COPYONLY) + endforeach() +endif() + +set(txt_files + ${txt_files} + ${CMAKE_CURRENT_SOURCE_DIR}/README + ${CMAKE_CURRENT_SOURCE_DIR}/runtest + ${CMAKE_CURRENT_SOURCE_DIR}/testlist + ${CMAKE_CURRENT_SOURCE_DIR}/checktest + PARENT_SCOPE) diff --git a/teshsuite/smpi/mpich3-test/README b/teshsuite/smpi/mpich3-test/README new file mode 100644 index 0000000000..7b81d594f3 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/README @@ -0,0 +1,155 @@ +MPICH Test Suite + +This test suite is a *supplement* to other test suites, including the +original MPICH testsuite, the Intel testsuite, and the IBM MPI test suite +(or test suites derived from that test, including the MPI C++ tests). + +Building the Test Suite +======================= +In many cases, configure will find the MPI implementation +automatically. In some cases, it will need some help. For example: + +For IBM MPI, where the compilation commands are not mpicc and mpif77 etc.: + +./configure CC=xlc MPICC=mpcc F77=xlf MPIF77=mpxlf CXX=xlC \ + MPICXX="mpCC -cpp" F90=xlf90 MPIF90=mpxlf90 \ + --disable-spawn \ + --enable-strictmpi + +(or the _r versions of the compilers) + +If mpicc and friends are not in your default path (and you do not want to +add them), you can specify the path with --with-mpi=. For example, +if they are in /usr/local/mympi/bin, use + +./configure --with-mpi=/usr/local/mympi + +(configure will append the bin to the path that you give). + +You may need to add MPI_SIZEOF_OFFSET=8 . + +The option "-cpp" is needed for at least some versions of mpCC to define the +C++ bindings of the MPI routines. + +For implementations that do not implement all of MPI-2, there are --disable +options, including --disable-spawn and --disable-cxx. To restrict tests to +just what is defined in the MPI specification, use --enable-strictmpi . + +The script that runs the tests assumes that the MPI implementation +supports mpiexec; you should consider this the first test of the implementation. + +Setting Options +=============== +The following environment variables will modify the behavior of the tests + +MPITEST_DEBUG - if set, output information for debugging the test suite +MPITEST_VERBOSE - if set to an integer value, output messages whose + level is at least that value (0 is a good choice here) +MPITEST_RETURN_WITH_CODE - Set the return code from the test programs based on + success or failure, with a zero for success and one + for failure (value must be yes, YES, true, or TRUE to + turn this on) +MPITEST_THREADLEVEL_DEFAULT - Set the default thread level. Values are + multiple, serialized, funneled, and single. + +Batch Systems +============= +For systems that run applications through a batch system, the option "-batch" +to the runtests script will create a script file that can be edited and +submitted to the batch system. The script checktests can be run to +summarize the results. + +Specifically, (assuming the bash shell, and that the directory "btest", a +subdirectory of the test suite directory, is used for running the tests): + +export MPITEST_BATCHDIR=`pwd`/btest +runtests -batch -tests=testlist +... edit btest/runtests.batch to make it a value batch submissions script +... run that script and wait for the batch job to complete +cd btest && ../checktests + +If a program other than mpiexec is used in the batch form to run programs, then +specify that to runtests: + + runtests -batch -mpiexec=aprun -tests=testlist + +(Here, aprun is the command used on Cray XE6 systems.) + +Note that some programs that are used to run MPI programs add extra output, +which can confuse any tool that depends on clean output in STDOUT. Since +such unfortunate behavior is common, the option -ignorebogus can be given +to checktests: + +cd btest && ../checktests --ignorebogus + +Controlling the Tests that are Run +================================== +The tests are actually built and run by the script "runtests". This script +can be given a file that contains a list of the tests to run. This file has +two primary types of entries: + + directories: Enter directory and look for the file "testlist". + Recursively run the contents of that file + program names: Build and run that program + +Lines may also be commented out with "#". + +The simplest program line contains the name of the program and the number of +MPI processes to use. For example, the following will build the +program sendrecv1 and run it with 4 processes: + +sendrecv1 4 + +In addition, the program line can contain key=value pairs that provide +special information about running the test. For example, + +sendflood 8 timeLimit=600 + +says to build and run the program sendflood with 8 MPI processes and +permit the test to run for 600 seconds (by default, at least for +MPICH, the default timelimit is 180 seconds). Other key=value pairs +can be used to select whether a program should be run at all, +depending on the abilities of the MPI implementation (this is +particularly important for Fortran programs, since preprocessor +support for Fortran is a non-standard extension to the Fortran +language, and there are some compilers that would not accept Fortran +programs that used the preprocessor). + +The most important key=value pairs are: + + +timeLimit=n : Use a timelimit of n seconds + +arg=string : Run the program with string as an argument to the program + +mpiexecarg=string : Run the program with string as an argument to mpiexec + +env=name=value : Run the program with environment variable "name" given the + value "value" + +mpiversion=x.y : Build and run the program only if the MPI version is at + least x.y. For example, + + distgraph1 4 mpiversion=2.2 + + will build and run distgraph1 with 4 MPI processes only + if the MPI version is at least 2.2. + +strict=bool : If bool is false, only build and run the program if + --enable-strictmpi was not used in configuring the test suite. + That is, a line such as + + neighb_coll 4 strict=false + + Says that this test is not valid for a strict MPI implementation; + it contains extensions to the standard, or in the case of some + MPICH development, MPIX routines + +resultTest=proc : This is used to change the way in which the success or + failure of a test is evaluated. proc is one of several + Perl subroutines defined within the runtest program. These + are primarily used within the testsuite for tests programs + exit with expected status values or that timeouts are + in fact handled. + + diff --git a/teshsuite/smpi/mpich3-test/attr/CMakeLists.txt b/teshsuite/smpi/mpich3-test/attr/CMakeLists.txt new file mode 100644 index 0000000000..3a17813a3f --- /dev/null +++ b/teshsuite/smpi/mpich3-test/attr/CMakeLists.txt @@ -0,0 +1,113 @@ +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") + + include_directories("${CMAKE_HOME_DIRECTORY}/include/smpi") + include_directories("${CMAKE_CURRENT_BINARY_DIR}/../include/") + + add_executable(attr2type attr2type.c ../util/mtest.c) + add_executable(attrend2 attrend2.c ../util/mtest.c) + add_executable(attrend attrend.c ../util/mtest.c) + add_executable(attrerr attrerr.c ../util/mtest.c) + add_executable(attrerrcomm attrerrcomm.c ../util/mtest.c) + add_executable(attrerrtype attrerrtype.c ../util/mtest.c) + add_executable(attric attric.c ../util/mtest.c) + add_executable(attrorder attrorder.c ../util/mtest.c) + add_executable(attrordercomm attrordercomm.c ../util/mtest.c) + add_executable(attrordertype attrordertype.c ../util/mtest.c) + add_executable(attrt attrt.c ../util/mtest.c) + add_executable(baseattr2 baseattr2.c ../util/mtest.c) + add_executable(baseattrcomm baseattrcomm.c ../util/mtest.c) + add_executable(fkeyval fkeyval.c ../util/mtest.c) + add_executable(fkeyvalcomm fkeyvalcomm.c ../util/mtest.c) + add_executable(fkeyvaltype fkeyvaltype.c ../util/mtest.c) + add_executable(keyval_double_free keyval_double_free.c ../util/mtest.c) + + + target_link_libraries(attr2type simgrid) + target_link_libraries(attrend2 simgrid) + target_link_libraries(attrend simgrid) + target_link_libraries(attrerr simgrid) + target_link_libraries(attrerrcomm simgrid) + target_link_libraries(attrerrtype simgrid) + target_link_libraries(attric simgrid) + target_link_libraries(attrorder simgrid) + target_link_libraries(attrordercomm simgrid) + target_link_libraries(attrordertype simgrid) + target_link_libraries(attrt simgrid) + target_link_libraries(baseattr2 simgrid) + target_link_libraries(baseattrcomm simgrid) + target_link_libraries(fkeyval simgrid) + target_link_libraries(fkeyvalcomm simgrid) + target_link_libraries(fkeyvaltype simgrid) + target_link_libraries(keyval_double_free simgrid) + + + set_target_properties(attr2type PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(attrend2 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(attrend PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(attrerr PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(attrerrcomm PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(attrerrtype PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(attric PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(attrorder PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(attrordercomm PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(attrordertype PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(attrt PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(baseattr2 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(baseattrcomm PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(fkeyval PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(fkeyvalcomm PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(fkeyvaltype PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(keyval_double_free 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}/attr2type.c + ${CMAKE_CURRENT_SOURCE_DIR}/attrend2.c + ${CMAKE_CURRENT_SOURCE_DIR}/attrend.c + ${CMAKE_CURRENT_SOURCE_DIR}/attrerr.c + ${CMAKE_CURRENT_SOURCE_DIR}/attrerrcomm.c + ${CMAKE_CURRENT_SOURCE_DIR}/attrerrtype.c + ${CMAKE_CURRENT_SOURCE_DIR}/attric.c + ${CMAKE_CURRENT_SOURCE_DIR}/attrorder.c + ${CMAKE_CURRENT_SOURCE_DIR}/attrordercomm.c + ${CMAKE_CURRENT_SOURCE_DIR}/attrordertype.c + ${CMAKE_CURRENT_SOURCE_DIR}/attrt.c + ${CMAKE_CURRENT_SOURCE_DIR}/baseattr2.c + ${CMAKE_CURRENT_SOURCE_DIR}/baseattrcomm.c + ${CMAKE_CURRENT_SOURCE_DIR}/fkeyval.c + ${CMAKE_CURRENT_SOURCE_DIR}/fkeyvalcomm.c + ${CMAKE_CURRENT_SOURCE_DIR}/fkeyvaltype.c + ${CMAKE_CURRENT_SOURCE_DIR}/keyval_double_free.c + PARENT_SCOPE + ) +set(bin_files + ${bin_files} + PARENT_SCOPE + ) +set(txt_files + ${txt_files} + ${CMAKE_CURRENT_SOURCE_DIR}/runtests + ${CMAKE_CURRENT_SOURCE_DIR}/testlist + PARENT_SCOPE + ) diff --git a/teshsuite/smpi/mpich3-test/attr/attr2type.c b/teshsuite/smpi/mpich3-test/attr/attr2type.c new file mode 100644 index 0000000000..69706cf596 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/attr/attr2type.c @@ -0,0 +1,126 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2007 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include +#include +#include + +static int foo_keyval = MPI_KEYVAL_INVALID; + +int foo_initialize(void); +void foo_finalize(void); + +int foo_copy_attr_function(MPI_Datatype type, int type_keyval, + void *extra_state, void *attribute_val_in, + void *attribute_val_out, int *flag); +int foo_delete_attr_function(MPI_Datatype type, int type_keyval, + void *attribute_val, void *extra_state); +static const char *my_func = 0; +static int verbose = 0; +static int delete_called = 0; +static int copy_called = 0; + +int main(int argc, char *argv[]) +{ + int mpi_errno; + MPI_Datatype type, duptype; + int rank; + + MPI_Init(&argc, &argv); + + MPI_Comm_rank( MPI_COMM_WORLD, &rank ); + + foo_initialize(); + + mpi_errno = MPI_Type_contiguous(2, MPI_INT, &type); + + mpi_errno = MPI_Type_set_attr(type, foo_keyval, NULL); + + mpi_errno = MPI_Type_dup(type, &duptype); + + my_func = "Free of type"; + mpi_errno = MPI_Type_free(&type); + + my_func = "free of duptype"; + mpi_errno = MPI_Type_free(&duptype); + + foo_finalize(); + + if (rank == 0) { + int errs = 0; + if (copy_called != 1) { + printf( "Copy called %d times; expected once\n", copy_called ); + errs++; + } + if (delete_called != 2) { + printf( "Delete called %d times; expected twice\n", delete_called ); + errs++; + } + if (errs == 0) { + printf( " No Errors\n" ); + }else if(mpi_errno!=MPI_SUCCESS){ + printf( " Output fail - Found %d errors\n", errs ); + }else { + printf( " Found %d errors\n", errs ); + } + fflush(stdout); + } + + MPI_Finalize(); + return 0; +} + +int foo_copy_attr_function(MPI_Datatype type, + int type_keyval, + void *extra_state, + void *attribute_val_in, + void *attribute_val_out, + int *flag) +{ + if (verbose) printf("copy fn. called\n"); + copy_called ++; + * (char **) attribute_val_out = NULL; + *flag = 1; + + return MPI_SUCCESS; +} + +int foo_delete_attr_function(MPI_Datatype type, + int type_keyval, + void *attribute_val, + void *extra_state) +{ + if (verbose) printf("delete fn. called in %s\n", my_func ); + delete_called ++; + + return MPI_SUCCESS; +} + +int foo_initialize(void) +{ + int mpi_errno; + + /* create keyval for use later */ + mpi_errno = MPI_Type_create_keyval(foo_copy_attr_function, + foo_delete_attr_function, + &foo_keyval, + NULL); + if (mpi_errno==MPI_SUCCESS && verbose) printf("created keyval\n"); + + return 0; +} + +void foo_finalize(void) +{ + int mpi_errno; + + /* remove keyval */ + mpi_errno = MPI_Type_free_keyval(&foo_keyval); + + if (mpi_errno==MPI_SUCCESS && verbose) printf("freed keyval\n"); + + return; +} diff --git a/teshsuite/smpi/mpich3-test/attr/attrend.c b/teshsuite/smpi/mpich3-test/attr/attrend.c new file mode 100644 index 0000000000..37c4a1b76b --- /dev/null +++ b/teshsuite/smpi/mpich3-test/attr/attrend.c @@ -0,0 +1,82 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2008 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +/* + The MPI-2 specification makes it clear that delect attributes are + called on MPI_COMM_WORLD and MPI_COMM_SELF at the very beginning of + MPI_Finalize. This is useful for tools that want to perform the MPI + equivalent of an "at_exit" action. + */ +#include +#include "mpi.h" +#include "mpitest.h" + +int exit_key = MPI_KEYVAL_INVALID; +int wasCalled = 0; +int foundError = 0; +/* #define DEBUG */ +int delete_fn ( MPI_Comm, int, void *, void * ); +#ifdef DEBUG +#define FFLUSH fflush(stdout); +#else +#define FFLUSH +#endif + +int main( int argc, char **argv ) +{ + int errs = 0, wrank; + + MTest_Init( &argc, &argv ); + + MPI_Comm_rank( MPI_COMM_WORLD, &wrank ); + + /* create the keyval for the exit handler */ + MPI_Keyval_create( MPI_NULL_COPY_FN, delete_fn, &exit_key, (void *)0 ); + + /* Attach to comm_self */ + MPI_Attr_put( MPI_COMM_SELF, exit_key, (void*)0 ); + /* We can free the key now */ + MPI_Keyval_free( &exit_key ); + + /* Now, exit MPI */ + /* MTest_Finalize( errs ); */ + MPI_Finalize(); + + /* Check that the exit handler was called, and without error */ + if (wrank == 0) { + /* In case more than one process exits MPI_Finalize */ + if (wasCalled != 1) { + errs++; + printf( "Attribute delete function on MPI_COMM_SELF was not called\n" ); + } + if (foundError != 0) { + errs++; + printf( "Found %d errors while executing delete function in MPI_COMM_SELF\n", foundError ); + } + if (errs == 0) { + printf( " No Errors\n" ); + } + else { + printf( " Found %d errors\n", errs ); + } + fflush(stdout ); + } + + return 0; +} + +int delete_fn( MPI_Comm comm, int keyval, void *attribute_val, + void *extra_state) +{ + int flag; + wasCalled++; + MPI_Finalized( &flag ); + if (flag) { + foundError++; + } + return MPI_SUCCESS; +} + diff --git a/teshsuite/smpi/mpich3-test/attr/attrend2.c b/teshsuite/smpi/mpich3-test/attr/attrend2.c new file mode 100644 index 0000000000..cf6d39f604 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/attr/attrend2.c @@ -0,0 +1,129 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2008 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +/* + The MPI-2.2 specification makes it clear that attributes are called on + MPI_COMM_WORLD and MPI_COMM_SELF at the very beginning of MPI_Finalize in + LIFO order with respect to the order in which they are set. This is + useful for tools that want to perform the MPI equivalent of an "at_exit" + action. + */ +#include +#include "mpi.h" +#include "mpitest.h" + +/* 20 ought to be enough attributes to ensure that hash-table based MPI + * implementations do not accidentally pass the test except by being extremely + * "lucky". There are (20!) possible permutations which means that there is + * about a 1 in 2.43e18 chance of getting LIFO ordering out of a hash table, + * assuming a decent hash function is used. */ +#define NUM_TEST_ATTRS (20) + +static __attribute__((unused)) int exit_keys[NUM_TEST_ATTRS]; /* init to MPI_KEYVAL_INVALID */ +static __attribute__((unused)) int was_called[NUM_TEST_ATTRS]; +int foundError = 0; +int delete_fn (MPI_Comm, int, void *, void *); + +int main(int argc, char **argv) +{ + int wrank; + + MTest_Init(&argc, &argv); + + MPI_Comm_rank(MPI_COMM_WORLD, &wrank); + +#if MTEST_HAVE_MIN_MPI_VERSION(2,2) + int errs = 0, wrank; + int i; + for (i = 0; i < NUM_TEST_ATTRS; ++i) { + exit_keys[i] = MPI_KEYVAL_INVALID; + was_called[i] = 0; + + /* create the keyval for the exit handler */ + MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN, delete_fn, &exit_keys[i], NULL); + /* attach to comm_self */ + MPI_Comm_set_attr(MPI_COMM_SELF, exit_keys[i], (void*)(long)i); + } + + /* we can free the keys now */ + for (i = 0; i < NUM_TEST_ATTRS; ++i) { + MPI_Comm_free_keyval(&exit_keys[i]); + } + + /* now, exit MPI */ + MPI_Finalize(); + + /* check that the exit handlers were called in LIFO order, and without error */ + if (wrank == 0) { + /* In case more than one process exits MPI_Finalize */ + for (i = 0; i < NUM_TEST_ATTRS; ++i) { + if (was_called[i] < 1) { + errs++; + printf("Attribute delete function on MPI_COMM_SELF was not called for idx=%d\n", i); + } + else if (was_called[i] > 1) { + errs++; + printf("Attribute delete function on MPI_COMM_SELF was called multiple times for idx=%d\n", i); + } + } + if (foundError != 0) { + errs++; + printf("Found %d errors while executing delete function in MPI_COMM_SELF\n", foundError); + } + if (errs == 0) { + printf(" No Errors\n"); + } + else { + printf(" Found %d errors\n", errs); + } + fflush(stdout); + } +#else /* this is a pre-MPI-2.2 implementation, ordering is not defined */ + MPI_Finalize(); + if (wrank == 0) + printf(" No Errors\n"); +#endif + + return 0; +} + +int delete_fn(MPI_Comm comm, int keyval, void *attribute_val, void *extra_state) +{ + int flag; + int i; + int my_idx = (int)(long)attribute_val; + + if (my_idx < 0 || my_idx > NUM_TEST_ATTRS) { + printf("internal error, my_idx=%d is invalid!\n", my_idx); + fflush(stdout); + } + + was_called[my_idx]++; + + MPI_Finalized(&flag); + if (flag) { + printf("my_idx=%d, MPI_Finalized returned %d, should have been 0", my_idx, flag); + foundError++; + } + + /* since attributes were added in 0..(NUM_TEST_ATTRS-1) order, they will be + * called in (NUM_TEST_ATTRS-1)..0 order */ + for (i = 0; i < my_idx; ++i) { + if (was_called[i] != 0) { + printf("my_idx=%d, was_called[%d]=%d but should be 0\n", my_idx, i, was_called[i]); + foundError++; + } + } + for (i = my_idx; i < NUM_TEST_ATTRS; ++i) { + if (was_called[i] != 1) { + printf("my_idx=%d, was_called[%d]=%d but should be 1\n", my_idx, i, was_called[i]); + foundError++; + } + } + + return MPI_SUCCESS; +} + diff --git a/teshsuite/smpi/mpich3-test/attr/attrerr.c b/teshsuite/smpi/mpich3-test/attr/attrerr.c new file mode 100644 index 0000000000..39e361173f --- /dev/null +++ b/teshsuite/smpi/mpich3-test/attr/attrerr.c @@ -0,0 +1,132 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2003 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +/* + + Exercise attribute routines. + This version checks for correct behavior of the copy and delete functions + on an attribute, particularly the correct behavior when the routine returns + failure. + + */ +#include +#include "mpi.h" +#include "mpitest.h" + +int test_communicators ( void ); +void abort_msg ( const char *, int ); +int copybomb_fn ( MPI_Comm, int, void *, void *, void *, int * ); +int deletebomb_fn ( MPI_Comm, int, void *, void * ); + +int main( int argc, char **argv ) +{ + int errs; + MTest_Init( &argc, &argv ); + errs = test_communicators(); + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} + +/* + * MPI 1.2 Clarification: Clarification of Error Behavior of + * Attribute Callback Functions + * Any return value other than MPI_SUCCESS is erroneous. The specific value + * returned to the user is undefined (other than it can't be MPI_SUCCESS). + * Proposals to specify particular values (e.g., user's value) failed. + */ +/* Return an error as the value */ +int copybomb_fn( MPI_Comm oldcomm, int keyval, void *extra_state, + void *attribute_val_in, void *attribute_val_out, int *flag) +{ + /* Note that if (sizeof(int) < sizeof(void *), just setting the int + part of attribute_val_out may leave some dirty bits + */ + *flag = 1; + return MPI_ERR_OTHER; +} + +/* Set delete flag to 1 to allow the attribute to be deleted */ +static int delete_flag = 0; + +int deletebomb_fn( MPI_Comm comm, int keyval, void *attribute_val, + void *extra_state) +{ + if (delete_flag) return MPI_SUCCESS; + return MPI_ERR_OTHER; +} + +void abort_msg( const char *str, int code ) +{ + fprintf( stderr, "%s, err = %d\n", str, code ); + MPI_Abort( MPI_COMM_WORLD, code ); +} + +int test_communicators( void ) +{ + MPI_Comm dup_comm_world, d2; + int world_rank, world_size, key_1; + int err, errs = 0; + MPI_Aint value; + + MPI_Comm_rank( MPI_COMM_WORLD, &world_rank ); + MPI_Comm_size( MPI_COMM_WORLD, &world_size ); +#ifdef DEBUG + if (world_rank == 0) { + printf( "*** Attribute copy/delete return codes ***\n" ); + } +#endif + + MPI_Comm_dup( MPI_COMM_WORLD, &dup_comm_world ); + MPI_Barrier( dup_comm_world ); + + MPI_Errhandler_set( dup_comm_world, MPI_ERRORS_RETURN ); + + value = - 11; + if ((err=MPI_Keyval_create( copybomb_fn, deletebomb_fn, &key_1, &value ))) + abort_msg( "Keyval_create", err ); + + err = MPI_Attr_put( dup_comm_world, key_1, (void *) (MPI_Aint) world_rank ); + if (err) { + errs++; + printf( "Error with first put\n" ); + } + + err = MPI_Attr_put( dup_comm_world, key_1, + (void *) (MPI_Aint) (2*world_rank) ); + if (err == MPI_SUCCESS) { + errs++; + printf( "delete function return code was MPI_SUCCESS in put\n" ); + } + + /* Because the attribute delete function should fail, the attribute + should *not be removed* */ + err = MPI_Attr_delete( dup_comm_world, key_1 ); + if (err == MPI_SUCCESS) { + errs++; + printf( "delete function return code was MPI_SUCCESS in delete\n" ); + } + + err = MPI_Comm_dup( dup_comm_world, &d2 ); + if (err == MPI_SUCCESS) { + errs++; + printf( "copy function return code was MPI_SUCCESS in dup\n" ); + } +#ifndef USE_STRICT_MPI + /* Another interpretation is to leave d2 unchanged on error */ + if (err && d2 != MPI_COMM_NULL) { + errs++; + printf( "dup did not return MPI_COMM_NULL on error\n" ); + } +#endif + + delete_flag = 1; + MPI_Comm_free( &dup_comm_world ); + MPI_Keyval_free( &key_1 ); + + return errs; +} + diff --git a/teshsuite/smpi/mpich3-test/attr/attrerrcomm.c b/teshsuite/smpi/mpich3-test/attr/attrerrcomm.c new file mode 100644 index 0000000000..df42e48c65 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/attr/attrerrcomm.c @@ -0,0 +1,141 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2003 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +/* + + Exercise attribute routines. + This version checks for correct behavior of the copy and delete functions + on an attribute, particularly the correct behavior when the routine returns + failure. + + */ +#include +#include "mpi.h" +#include "mpitest.h" + +int test_communicators ( void ); +void abort_msg ( const char *, int ); +int copybomb_fn ( MPI_Comm, int, void *, void *, void *, int * ); +int deletebomb_fn ( MPI_Comm, int, void *, void * ); + +int main( int argc, char **argv ) +{ + int errs; + MTest_Init( &argc, &argv ); + errs = test_communicators(); + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} + +/* + * MPI 1.2 Clarification: Clarification of Error Behavior of + * Attribute Callback Functions + * Any return value other than MPI_SUCCESS is erroneous. The specific value + * returned to the user is undefined (other than it can't be MPI_SUCCESS). + * Proposals to specify particular values (e.g., user's value) failed. + */ +/* Return an error as the value */ +int copybomb_fn( MPI_Comm oldcomm, int keyval, void *extra_state, + void *attribute_val_in, void *attribute_val_out, int *flag) +{ + /* Note that if (sizeof(int) < sizeof(void *), just setting the int + part of attribute_val_out may leave some dirty bits + */ + *flag = 1; + return MPI_ERR_OTHER; +} + +/* Set delete flag to 1 to allow the attribute to be deleted */ +static int delete_flag = 0; + +int deletebomb_fn( MPI_Comm comm, int keyval, void *attribute_val, + void *extra_state) +{ + if (delete_flag) return MPI_SUCCESS; + return MPI_ERR_OTHER; +} + +void abort_msg( const char *str, int code ) +{ + fprintf( stderr, "%s, err = %d\n", str, code ); + MPI_Abort( MPI_COMM_WORLD, code ); +} + +int test_communicators( void ) +{ + MPI_Comm dup_comm_world, d2; + int world_rank, world_size, key_1; + int err, errs = 0; + MPI_Aint value; + + MPI_Comm_rank( MPI_COMM_WORLD, &world_rank ); + MPI_Comm_size( MPI_COMM_WORLD, &world_size ); +#ifdef DEBUG + if (world_rank == 0) { + printf( "*** Attribute copy/delete return codes ***\n" ); + } +#endif + + MPI_Comm_dup( MPI_COMM_WORLD, &dup_comm_world ); + MPI_Barrier( dup_comm_world ); + + MPI_Errhandler_set( dup_comm_world, MPI_ERRORS_RETURN ); + + value = - 11; + if ((err=MPI_Comm_create_keyval( copybomb_fn, deletebomb_fn, &key_1, &value ))) + abort_msg( "Keyval_create", err ); + + err = MPI_Comm_set_attr( dup_comm_world, key_1, (void *) (MPI_Aint) world_rank ); + if (err) { + errs++; + printf( "Error with first put\n" ); + } + + err = MPI_Comm_set_attr( dup_comm_world, key_1, (void *) (MPI_Aint) (2*world_rank) ); + if (err == MPI_SUCCESS) { + errs++; + printf( "delete function return code was MPI_SUCCESS in put\n" ); + } + + /* Because the attribute delete function should fail, the attribute + should *not be removed* */ + err = MPI_Comm_delete_attr( dup_comm_world, key_1 ); + if (err == MPI_SUCCESS) { + errs++; + printf( "delete function return code was MPI_SUCCESS in delete\n" ); + } + + err = MPI_Comm_dup( dup_comm_world, &d2 ); + if (err == MPI_SUCCESS) { + errs++; + printf( "copy function return code was MPI_SUCCESS in dup\n" ); + } + if (err != MPI_ERR_OTHER) { + int lerrclass; + MPI_Error_class( err, &lerrclass ); + if (lerrclass != MPI_ERR_OTHER) { + errs++; + printf( "dup did not return an error code of class ERR_OTHER; " ); + printf( "err = %d, class = %d\n", err, lerrclass ); + } + } +#ifndef USE_STRICT_MPI + /* Another interpretation is to leave d2 unchanged on error */ + if (err && d2 != MPI_COMM_NULL) { + errs++; + printf( "dup did not return MPI_COMM_NULL on error\n" ); + } +#endif + + delete_flag = 1; + MPI_Comm_free( &dup_comm_world ); + + MPI_Comm_free_keyval( &key_1 ); + + return errs; +} + diff --git a/teshsuite/smpi/mpich3-test/attr/attrerrtype.c b/teshsuite/smpi/mpich3-test/attr/attrerrtype.c new file mode 100644 index 0000000000..d3d9a39de6 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/attr/attrerrtype.c @@ -0,0 +1,139 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2003 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +/* + + Exercise attribute routines. + This version checks for correct behavior of the copy and delete functions + on an attribute, particularly the correct behavior when the routine returns + failure. + + */ +#include +#include "mpi.h" +#include "mpitest.h" + +int test_attrs ( void ); +void abort_msg ( const char *, int ); +int copybomb_fn ( MPI_Datatype, int, void *, void *, void *, int * ); +int deletebomb_fn ( MPI_Datatype, int, void *, void * ); + +int main( int argc, char **argv ) +{ + int errs; + MTest_Init( &argc, &argv ); + errs = test_attrs(); + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} + +/* + * MPI 1.2 Clarification: Clarification of Error Behavior of + * Attribute Callback Functions + * Any return value other than MPI_SUCCESS is erroneous. The specific value + * returned to the user is undefined (other than it can't be MPI_SUCCESS). + * Proposals to specify particular values (e.g., user's value) failed. + */ +/* Return an error as the value */ +int copybomb_fn( MPI_Datatype oldtype, int keyval, void *extra_state, + void *attribute_val_in, void *attribute_val_out, int *flag) +{ + /* Note that if (sizeof(int) < sizeof(void *), just setting the int + part of attribute_val_out may leave some dirty bits + */ + *flag = 1; + return MPI_ERR_OTHER; +} + +/* Set delete flag to 1 to allow the attribute to be deleted */ +static int delete_flag = 0; +static int deleteCalled = 0; + +int deletebomb_fn( MPI_Datatype type, int keyval, void *attribute_val, + void *extra_state) +{ + deleteCalled ++; + if (delete_flag) return MPI_SUCCESS; + return MPI_ERR_OTHER; +} + +void abort_msg( const char *str, int code ) +{ + fprintf( stderr, "%s, err = %d\n", str, code ); + MPI_Abort( MPI_COMM_WORLD, code ); +} + +int test_attrs( void ) +{ + MPI_Datatype dup_type, d2; + int world_rank, world_size, key_1; + int err, errs = 0; + MPI_Aint value; + + MPI_Comm_rank( MPI_COMM_WORLD, &world_rank ); + MPI_Comm_size( MPI_COMM_WORLD, &world_size ); +#ifdef DEBUG + if (world_rank == 0) { + printf( "*** Attribute copy/delete return codes ***\n" ); + } +#endif + + + MPI_Type_dup( MPI_DOUBLE, &dup_type ); + + MPI_Errhandler_set( MPI_COMM_WORLD, MPI_ERRORS_RETURN ); + + value = - 11; + if ((err=MPI_Type_create_keyval( copybomb_fn, deletebomb_fn, &key_1, &value ))) + abort_msg( "Keyval_create", err ); + + err = MPI_Type_set_attr( dup_type, key_1, (void *) (MPI_Aint) world_rank ); + if (err) { + errs++; + printf( "Error with first put\n" ); + } + + err = MPI_Type_set_attr( dup_type, key_1, (void *) (MPI_Aint) (2*world_rank) ); + if (err == MPI_SUCCESS) { + errs++; + printf( "delete function return code was MPI_SUCCESS in put\n" ); + } + + /* Because the attribute delete function should fail, the attribute + should *not be removed* */ + err = MPI_Type_delete_attr( dup_type, key_1 ); + if (err == MPI_SUCCESS) { + errs++; + printf( "delete function return code was MPI_SUCCESS in delete\n" ); + } + + err = MPI_Type_dup( dup_type, &d2 ); + if (err == MPI_SUCCESS) { + errs++; + printf( "copy function return code was MPI_SUCCESS in dup\n" ); + } +#ifndef USE_STRICT_MPI + /* Another interpretation is to leave d2 unchanged on error */ + if (err && d2 != MPI_DATATYPE_NULL) { + errs++; + printf( "dup did not return MPI_DATATYPE_NULL on error\n" ); + } +#endif + + delete_flag = 1; + deleteCalled = 0; + if (d2 != MPI_DATATYPE_NULL) + MPI_Type_free(&d2); + MPI_Type_free( &dup_type ); + if (deleteCalled == 0) { + errs++; + printf( "Free of a datatype did not invoke the attribute delete routine\n" ); + } + MPI_Type_free_keyval( &key_1 ); + + return errs; +} diff --git a/teshsuite/smpi/mpich3-test/attr/attric.c b/teshsuite/smpi/mpich3-test/attr/attric.c new file mode 100644 index 0000000000..c71e96c6c7 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/attr/attric.c @@ -0,0 +1,155 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2001 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +/* + + Exercise communicator routines for intercommunicators + + This C version derived from attrt, which in turn was + derived from a Fortran test program from ... + + */ +#include +#include "mpi.h" +#include "mpitest.h" + +/* #define DEBUG */ +int test_communicators ( void ); +int copy_fn ( MPI_Comm, int, void *, void *, void *, int * ); +int delete_fn ( MPI_Comm, int, void *, void * ); +#ifdef DEBUG +#define FFLUSH fflush(stdout); +#else +#define FFLUSH +#endif + +int main( int argc, char **argv ) +{ + int errs = 0; + MTest_Init( &argc, &argv ); + + errs = test_communicators(); + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} + +int copy_fn( MPI_Comm oldcomm, int keyval, void *extra_state, + void *attribute_val_in, void *attribute_val_out, int *flag) +{ + /* Note that if (sizeof(int) < sizeof(void *), just setting the int + part of attribute_val_out may leave some dirty bits + */ + *(MPI_Aint *)attribute_val_out = (MPI_Aint)attribute_val_in; + *flag = 1; + return MPI_SUCCESS; +} + +int delete_fn( MPI_Comm comm, int keyval, void *attribute_val, + void *extra_state) +{ + int world_rank; + MPI_Comm_rank( MPI_COMM_WORLD, &world_rank ); + if ((MPI_Aint)attribute_val != (MPI_Aint)world_rank) { + printf( "incorrect attribute value %d\n", *(int*)attribute_val ); + MPI_Abort(MPI_COMM_WORLD, 1005 ); + } + return MPI_SUCCESS; +} + +int test_communicators( void ) +{ + MPI_Comm dup_comm, comm; + void *vvalue; + int flag, world_rank, world_size, key_1, key_3; + int errs = 0; + MPI_Aint value; + int isLeft; + + MPI_Comm_rank( MPI_COMM_WORLD, &world_rank ); + MPI_Comm_size( MPI_COMM_WORLD, &world_size ); +#ifdef DEBUG + if (world_rank == 0) { + printf( "*** Communicators ***\n" ); fflush(stdout); + } +#endif + + while (MTestGetIntercomm( &comm, &isLeft, 2 )) { + MTestPrintfMsg(1, "start while loop, isLeft=%s\n", (isLeft ? "TRUE" : "FALSE")); + + if (comm == MPI_COMM_NULL) { + MTestPrintfMsg(1, "got COMM_NULL, skipping\n"); + continue; + } + + /* + Check Comm_dup by adding attributes to comm & duplicating + */ + + value = 9; + MPI_Keyval_create(copy_fn, delete_fn, &key_1, &value ); + MTestPrintfMsg(1, "Keyval_create key=%#x value=%d\n", key_1, value); + value = 7; + MPI_Keyval_create(MPI_NULL_COPY_FN, MPI_NULL_DELETE_FN, + &key_3, &value ); + MTestPrintfMsg(1, "Keyval_create key=%#x value=%d\n", key_3, value); + + /* This may generate a compilation warning; it is, however, an + easy way to cache a value instead of a pointer */ + /* printf( "key1 = %x key3 = %x\n", key_1, key_3 ); */ + MPI_Attr_put(comm, key_1, (void *) (MPI_Aint) world_rank ); + MPI_Attr_put(comm, key_3, (void *)0 ); + + MTestPrintfMsg(1, "Comm_dup\n" ); + MPI_Comm_dup(comm, &dup_comm ); + + /* Note that if sizeof(int) < sizeof(void *), we can't use + (void **)&value to get the value we passed into Attr_put. To avoid + problems (e.g., alignment errors), we recover the value into + a (void *) and cast to int. Note that this may generate warning + messages from the compiler. */ + MPI_Attr_get(dup_comm, key_1, (void **)&vvalue, &flag ); + value = (MPI_Aint)vvalue; + + if (! flag) { + errs++; + printf( "dup_comm key_1 not found on %d\n", world_rank ); + fflush( stdout ); + MPI_Abort(MPI_COMM_WORLD, 3004 ); + } + + if (value != world_rank) { + errs++; + printf( "dup_comm key_1 value incorrect: %ld\n", (long)value ); + fflush( stdout ); + MPI_Abort(MPI_COMM_WORLD, 3005 ); + } + + MPI_Attr_get(dup_comm, key_3, (void **)&vvalue, &flag ); + value = (MPI_Aint)vvalue; + if (flag) { + errs++; + printf( "dup_comm key_3 found!\n" ); + fflush( stdout ); + MPI_Abort(MPI_COMM_WORLD, 3008 ); + } + MTestPrintfMsg(1, "Keyval_free key=%#x\n", key_1); + MPI_Keyval_free(&key_1 ); + MTestPrintfMsg(1, "Keyval_free key=%#x\n", key_3); + MPI_Keyval_free(&key_3 ); + /* + Free all communicators created + */ + MTestPrintfMsg(1, "Comm_free comm\n"); + MPI_Comm_free( &comm ); + MTestPrintfMsg(1, "Comm_free dup_comm\n"); + MPI_Comm_free( &dup_comm ); + } + + return errs; +} + diff --git a/teshsuite/smpi/mpich3-test/attr/attrorder.c b/teshsuite/smpi/mpich3-test/attr/attrorder.c new file mode 100644 index 0000000000..09827feadc --- /dev/null +++ b/teshsuite/smpi/mpich3-test/attr/attrorder.c @@ -0,0 +1,123 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2001 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include "mpi.h" +#include +#include "mpitest.h" + +/* +static char MTestDescrip[] = "Test creating and inserting attributes in \ +different orders to ensure that the list management code handles all cases."; +*/ + +int checkAttrs( MPI_Comm comm, int n, int key[], int attrval[] ); +int checkNoAttrs( MPI_Comm comm, int n, int key[] ); + +int main( int argc, char *argv[] ) +{ + int errs = 0; + int key[3], attrval[3]; + int i; + MPI_Comm comm; + + MTest_Init( &argc, &argv ); + + { + comm = MPI_COMM_WORLD; + /* Create key values */ + for (i=0; i<3; i++) { + MPI_Keyval_create( MPI_NULL_COPY_FN, MPI_NULL_DELETE_FN, + &key[i], (void *)0 ); + attrval[i] = 1024 * i; + } + + /* Insert attribute in several orders. Test after put with get, + then delete, then confirm delete with get. */ + + MPI_Attr_put( comm, key[2], &attrval[2] ); + MPI_Attr_put( comm, key[1], &attrval[1] ); + MPI_Attr_put( comm, key[0], &attrval[0] ); + + errs += checkAttrs( comm, 3, key, attrval ); + + MPI_Attr_delete( comm, key[0] ); + MPI_Attr_delete( comm, key[1] ); + MPI_Attr_delete( comm, key[2] ); + + errs += checkNoAttrs( comm, 3, key ); + + MPI_Attr_put( comm, key[1], &attrval[1] ); + MPI_Attr_put( comm, key[2], &attrval[2] ); + MPI_Attr_put( comm, key[0], &attrval[0] ); + + errs += checkAttrs( comm, 3, key, attrval ); + + MPI_Attr_delete( comm, key[2] ); + MPI_Attr_delete( comm, key[1] ); + MPI_Attr_delete( comm, key[0] ); + + errs += checkNoAttrs( comm, 3, key ); + + MPI_Attr_put( comm, key[0], &attrval[0] ); + MPI_Attr_put( comm, key[1], &attrval[1] ); + MPI_Attr_put( comm, key[2], &attrval[2] ); + + errs += checkAttrs( comm, 3, key, attrval ); + + MPI_Attr_delete( comm, key[1] ); + MPI_Attr_delete( comm, key[2] ); + MPI_Attr_delete( comm, key[0] ); + + errs += checkNoAttrs( comm, 3, key ); + + for (i=0; i<3; i++) { + MPI_Keyval_free( &key[i] ); + } + } + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; + +} + +int checkAttrs( MPI_Comm comm, int n, int key[], int attrval[] ) +{ + int errs = 0; + int i, flag, *val_p; + + for (i=0; i +#include "mpitest.h" + +/* +static char MTestDescrip[] = "Test creating and inserting attributes in \ +different orders to ensure that the list management code handles all cases."; +*/ + +int checkAttrs( MPI_Comm comm, int n, int key[], int attrval[] ); +int checkNoAttrs( MPI_Comm comm, int n, int key[] ); + +int main( int argc, char *argv[] ) +{ + int errs = 0; + int key[3], attrval[3]; + int i; + MPI_Comm comm; + + MTest_Init( &argc, &argv ); + + { + comm = MPI_COMM_WORLD; + /* Create key values */ + for (i=0; i<3; i++) { + MPI_Comm_create_keyval( MPI_NULL_COPY_FN, MPI_NULL_DELETE_FN, + &key[i], (void *)0 ); + attrval[i] = 1024 * i; + } + + /* Insert attribute in several orders. Test after put with get, + then delete, then confirm delete with get. */ + + MPI_Comm_set_attr( comm, key[2], &attrval[2] ); + MPI_Comm_set_attr( comm, key[1], &attrval[1] ); + MPI_Comm_set_attr( comm, key[0], &attrval[0] ); + + errs += checkAttrs( comm, 3, key, attrval ); + + MPI_Comm_delete_attr( comm, key[0] ); + MPI_Comm_delete_attr( comm, key[1] ); + MPI_Comm_delete_attr( comm, key[2] ); + + errs += checkNoAttrs( comm, 3, key ); + + MPI_Comm_set_attr( comm, key[1], &attrval[1] ); + MPI_Comm_set_attr( comm, key[2], &attrval[2] ); + MPI_Comm_set_attr( comm, key[0], &attrval[0] ); + + errs += checkAttrs( comm, 3, key, attrval ); + + MPI_Comm_delete_attr( comm, key[2] ); + MPI_Comm_delete_attr( comm, key[1] ); + MPI_Comm_delete_attr( comm, key[0] ); + + errs += checkNoAttrs( comm, 3, key ); + + MPI_Comm_set_attr( comm, key[0], &attrval[0] ); + MPI_Comm_set_attr( comm, key[1], &attrval[1] ); + MPI_Comm_set_attr( comm, key[2], &attrval[2] ); + + errs += checkAttrs( comm, 3, key, attrval ); + + MPI_Comm_delete_attr( comm, key[1] ); + MPI_Comm_delete_attr( comm, key[2] ); + MPI_Comm_delete_attr( comm, key[0] ); + + errs += checkNoAttrs( comm, 3, key ); + + for (i=0; i<3; i++) { + MPI_Comm_free_keyval( &key[i] ); + } + } + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; + +} + +int checkAttrs( MPI_Comm comm, int n, int key[], int attrval[] ) +{ + int errs = 0; + int i, flag, *val_p; + + for (i=0; i +#include "mpitest.h" + +/* +static char MTestDescrip[] = "Test creating and inserting attributes in \ +different orders to ensure that the list management code handles all cases."; +*/ + +int checkAttrs( MPI_Datatype type, int n, int key[], int attrval[] ); +int checkNoAttrs( MPI_Datatype type, int n, int key[] ); + +int main( int argc, char *argv[] ) +{ + int errs = 0; + int key[3], attrval[3]; + int i; + MPI_Datatype type; + + MTest_Init( &argc, &argv ); + + { + type = MPI_INT; + /* Create key values */ + for (i=0; i<3; i++) { + MPI_Type_create_keyval( MPI_NULL_COPY_FN, MPI_NULL_DELETE_FN, + &key[i], (void *)0 ); + attrval[i] = 1024 * i; + } + + /* Insert attribute in several orders. Test after put with get, + then delete, then confirm delete with get. */ + + MPI_Type_set_attr( type, key[2], &attrval[2] ); + MPI_Type_set_attr( type, key[1], &attrval[1] ); + MPI_Type_set_attr( type, key[0], &attrval[0] ); + + errs += checkAttrs( type, 3, key, attrval ); + + MPI_Type_delete_attr( type, key[0] ); + MPI_Type_delete_attr( type, key[1] ); + MPI_Type_delete_attr( type, key[2] ); + + errs += checkNoAttrs( type, 3, key ); + + MPI_Type_set_attr( type, key[1], &attrval[1] ); + MPI_Type_set_attr( type, key[2], &attrval[2] ); + MPI_Type_set_attr( type, key[0], &attrval[0] ); + + errs += checkAttrs( type, 3, key, attrval ); + + MPI_Type_delete_attr( type, key[2] ); + MPI_Type_delete_attr( type, key[1] ); + MPI_Type_delete_attr( type, key[0] ); + + errs += checkNoAttrs( type, 3, key ); + + MPI_Type_set_attr( type, key[0], &attrval[0] ); + MPI_Type_set_attr( type, key[1], &attrval[1] ); + MPI_Type_set_attr( type, key[2], &attrval[2] ); + + errs += checkAttrs( type, 3, key, attrval ); + + MPI_Type_delete_attr( type, key[1] ); + MPI_Type_delete_attr( type, key[2] ); + MPI_Type_delete_attr( type, key[0] ); + + errs += checkNoAttrs( type, 3, key ); + + for (i=0; i<3; i++) { + MPI_Type_free_keyval( &key[i] ); + } + } + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; + +} + +int checkAttrs( MPI_Datatype type, int n, int key[], int attrval[] ) +{ + int errs = 0; + int i, flag, *val_p; + + for (i=0; i +#include "mpi.h" +#include "mpitest.h" + +//#define DEBUG +int test_communicators ( void ); +int copy_fn ( MPI_Comm, int, void *, void *, void *, int * ); +int delete_fn ( MPI_Comm, int, void *, void * ); +#ifdef DEBUG +#define FFLUSH fflush(stdout); +#else +#define FFLUSH +#endif + +int main( int argc, char **argv ) +{ + int errs = 0; + MTest_Init( &argc, &argv ); + + errs = test_communicators(); + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} + +int copy_fn( MPI_Comm oldcomm, int keyval, void *extra_state, + void *attribute_val_in, void *attribute_val_out, int *flag) +{ + /* Note that if (sizeof(int) < sizeof(void *), just setting the int + part of attribute_val_out may leave some dirty bits + */ + *(MPI_Aint *)attribute_val_out = (MPI_Aint)attribute_val_in; + *flag = 1; + return MPI_SUCCESS; +} + +int delete_fn( MPI_Comm comm, int keyval, void *attribute_val, + void *extra_state) +{ + int world_rank; + MPI_Comm_rank( MPI_COMM_WORLD, &world_rank ); + if ((MPI_Aint)attribute_val != (MPI_Aint)world_rank) { + printf( "incorrect attribute value %d\n", *(int*)attribute_val ); + MPI_Abort(MPI_COMM_WORLD, 1005 ); + } + return MPI_SUCCESS; +} + +int test_communicators( void ) +{ + MPI_Comm dup_comm_world, lo_comm, rev_comm, dup_comm, + split_comm, world_comm; + MPI_Group world_group, lo_group, rev_group; + void *vvalue; + int ranges[1][3]; + int flag, world_rank, world_size, rank, size, n, key_1, key_3; + int color, key, result; + int errs = 0; + MPI_Aint value; + + MPI_Comm_rank( MPI_COMM_WORLD, &world_rank ); + MPI_Comm_size( MPI_COMM_WORLD, &world_size ); +#ifdef DEBUG + if (world_rank == 0) { + printf( "*** Communicators ***\n" ); fflush(stdout); + } +#endif + + MPI_Comm_dup( MPI_COMM_WORLD, &dup_comm_world ); + + /* + Exercise Comm_create by creating an equivalent to dup_comm_world + (sans attributes) and a half-world communicator. + */ + +#ifdef DEBUG + if (world_rank == 0) { + printf( " Comm_create\n" ); fflush(stdout); + } +#endif + + MPI_Comm_group( dup_comm_world, &world_group ); + MPI_Comm_create( dup_comm_world, world_group, &world_comm ); + MPI_Comm_rank( world_comm, &rank ); + if (rank != world_rank) { + errs++; + printf( "incorrect rank in world comm: %d\n", rank ); + MPI_Abort(MPI_COMM_WORLD, 3001 ); + } + + n = world_size / 2; + + ranges[0][0] = 0; + ranges[0][1] = (world_size - n) - 1; + ranges[0][2] = 1; + +#ifdef DEBUG + printf( "world rank = %d before range incl\n", world_rank );FFLUSH; +#endif + MPI_Group_range_incl(world_group, 1, ranges, &lo_group ); +#ifdef DEBUG + printf( "world rank = %d after range incl\n", world_rank );FFLUSH; +#endif + MPI_Comm_create(world_comm, lo_group, &lo_comm ); +#ifdef DEBUG + printf( "world rank = %d before group free\n", world_rank );FFLUSH; +#endif + MPI_Group_free( &lo_group ); + +#ifdef DEBUG + printf( "world rank = %d after group free\n", world_rank );FFLUSH; +#endif + + if (world_rank < (world_size - n)) { + MPI_Comm_rank(lo_comm, &rank ); + if (rank == MPI_UNDEFINED) { + errs++; + printf( "incorrect lo group rank: %d\n", rank ); fflush(stdout); + MPI_Abort(MPI_COMM_WORLD, 3002 ); + } + else { + /* printf( "lo in\n" );FFLUSH; */ + MPI_Barrier(lo_comm ); + /* printf( "lo out\n" );FFLUSH; */ + } + } + else { + if (lo_comm != MPI_COMM_NULL) { + errs++; + printf( "rank : %d incorrect lo comm:\n", rank ); fflush(stdout); + MPI_Abort(MPI_COMM_WORLD, 3003 ); + } + } + +#ifdef DEBUG + printf( "worldrank = %d\n", world_rank );FFLUSH; +#endif + MPI_Barrier(world_comm); + +#ifdef DEBUG + printf( "bar!\n" );FFLUSH; +#endif + /* + Check Comm_dup by adding attributes to lo_comm & duplicating + */ +#ifdef DEBUG + if (world_rank == 0) { + printf( " Comm_dup\n" ); + fflush(stdout); + } +#endif + + if (lo_comm != MPI_COMM_NULL) { + value = 9; + MPI_Keyval_create(copy_fn, delete_fn, &key_1, &value ); + value = 8; + value = 7; + MPI_Keyval_create(MPI_NULL_COPY_FN, MPI_NULL_DELETE_FN, + &key_3, &value ); + + /* This may generate a compilation warning; it is, however, an + easy way to cache a value instead of a pointer */ + /* printf( "key1 = %x key3 = %x\n", key_1, key_3 ); */ + MPI_Attr_put(lo_comm, key_1, (void *) (MPI_Aint) world_rank ); + MPI_Attr_put(lo_comm, key_3, (void *)0 ); + + MPI_Comm_dup(lo_comm, &dup_comm ); + + /* Note that if sizeof(int) < sizeof(void *), we can't use + (void **)&value to get the value we passed into Attr_put. To avoid + problems (e.g., alignment errors), we recover the value into + a (void *) and cast to int. Note that this may generate warning + messages from the compiler. */ + MPI_Attr_get(dup_comm, key_1, (void **)&vvalue, &flag ); + value = (MPI_Aint)vvalue; + + if (! flag) { + errs++; + printf( "dup_comm key_1 not found on %d\n", world_rank ); + fflush( stdout ); + MPI_Abort(MPI_COMM_WORLD, 3004 ); + } + + if (value != world_rank) { + errs++; + printf( "dup_comm key_1 value incorrect: %ld, expected %d\n", + (long)value, world_rank ); + fflush( stdout ); + MPI_Abort(MPI_COMM_WORLD, 3005 ); + } + + MPI_Attr_get(dup_comm, key_3, (void **)&vvalue, &flag ); + value = (MPI_Aint)vvalue; + if (flag) { + errs++; + printf( "dup_comm key_3 found!\n" ); + fflush( stdout ); + MPI_Abort(MPI_COMM_WORLD, 3008 ); + } + MPI_Keyval_free(&key_1 ); + MPI_Keyval_free(&key_3 ); + } + /* + Split the world into even & odd communicators with reversed ranks. + */ +#ifdef DEBUG + if (world_rank == 0) { + printf( " Comm_split\n" ); + fflush(stdout); + } +#endif + + color = world_rank % 2; + key = world_size - world_rank; + + MPI_Comm_split(dup_comm_world, color, key, &split_comm ); + MPI_Comm_size(split_comm, &size ); + MPI_Comm_rank(split_comm, &rank ); + if (rank != ((size - world_rank/2) - 1)) { + errs++; + printf( "incorrect split rank: %d\n", rank ); fflush(stdout); + MPI_Abort(MPI_COMM_WORLD, 3009 ); + } + + MPI_Barrier(split_comm ); + /* + Test each possible Comm_compare result + */ +#ifdef DEBUG + if (world_rank == 0) { + printf( " Comm_compare\n" ); + fflush(stdout); + } +#endif + + MPI_Comm_compare(world_comm, world_comm, &result ); + if (result != MPI_IDENT) { + errs++; + printf( "incorrect ident result: %d\n", result ); + MPI_Abort(MPI_COMM_WORLD, 3010 ); + } + + if (lo_comm != MPI_COMM_NULL) { + MPI_Comm_compare(lo_comm, dup_comm, &result ); + if (result != MPI_CONGRUENT) { + errs++; + printf( "incorrect congruent result: %d\n", result ); + MPI_Abort(MPI_COMM_WORLD, 3011 ); + } + } + + ranges[0][0] = world_size - 1; + ranges[0][1] = 0; + ranges[0][2] = -1; + + MPI_Group_range_incl(world_group, 1, ranges, &rev_group ); + MPI_Comm_create(world_comm, rev_group, &rev_comm ); + + MPI_Comm_compare(world_comm, rev_comm, &result ); + if (result != MPI_SIMILAR && world_size != 1) { + errs++; + printf( "incorrect similar result: %d\n", result ); + MPI_Abort(MPI_COMM_WORLD, 3012 ); + } + + if (lo_comm != MPI_COMM_NULL) { + MPI_Comm_compare(world_comm, lo_comm, &result ); + if (result != MPI_UNEQUAL && world_size != 1) { + errs++; + printf( "incorrect unequal result: %d\n", result ); + MPI_Abort(MPI_COMM_WORLD, 3013 ); + } + } + /* + Free all communicators created + */ +#ifdef DEBUG + if (world_rank == 0) + printf( " Comm_free\n" ); +#endif + + MPI_Comm_free( &world_comm ); + MPI_Comm_free( &dup_comm_world ); + + MPI_Comm_free( &rev_comm ); + MPI_Comm_free( &split_comm ); + + MPI_Group_free( &world_group ); + MPI_Group_free( &rev_group ); + + if (lo_comm != MPI_COMM_NULL) { + MPI_Comm_free( &lo_comm ); + MPI_Comm_free( &dup_comm ); + } + + return errs; +} + diff --git a/teshsuite/smpi/mpich3-test/attr/baseattr2.c b/teshsuite/smpi/mpich3-test/attr/baseattr2.c new file mode 100644 index 0000000000..58190f673d --- /dev/null +++ b/teshsuite/smpi/mpich3-test/attr/baseattr2.c @@ -0,0 +1,174 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2001 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include +#include "mpi.h" +#include "mpitest.h" + +void MissingKeyval( int rc, const char keyname[] ); + +int main( int argc, char **argv) +{ + int errs = 0; + int rc; + void *v; + int flag; + int vval; + int rank, size; + + MTest_Init( &argc, &argv ); + MPI_Comm_size( MPI_COMM_WORLD, &size ); + MPI_Comm_rank( MPI_COMM_WORLD, &rank ); + + /* Set errors return so that we can provide better information + should a routine reject one of the attribute values */ + MPI_Errhandler_set( MPI_COMM_WORLD, MPI_ERRORS_RETURN ); + + rc = MPI_Attr_get( MPI_COMM_WORLD, MPI_TAG_UB, &v, &flag ); + if (rc) { + MissingKeyval( rc, "MPI_TAG_UB" ); + errs++; + } + else { + if (!flag) { + errs++; + fprintf( stderr, "Could not get TAG_UB\n" ); + } + else { + vval = *(int*)v; + if (vval < 32767) { + errs++; + fprintf( stderr, "Got too-small value (%d) for TAG_UB\n", vval ); + } + } + } + + rc = MPI_Attr_get( MPI_COMM_WORLD, MPI_HOST, &v, &flag ); + if (rc) { + MissingKeyval( rc, "MPI_HOST" ); + errs++; + } + else { + if (!flag) { + errs++; + fprintf( stderr, "Could not get HOST\n" ); + } + else { + vval = *(int*)v; + if ((vval < 0 || vval >= size) && vval != MPI_PROC_NULL) { + errs++; + fprintf( stderr, "Got invalid value %d for HOST\n", vval ); + } + } + } + + rc = MPI_Attr_get( MPI_COMM_WORLD, MPI_IO, &v, &flag ); + if (rc) { + MissingKeyval( rc, "MPI_IO" ); + errs++; + } + else { + if (!flag) { + errs++; + fprintf( stderr, "Could not get IO\n" ); + } + else { + vval = *(int*)v; + if ((vval < 0 || vval >= size) && vval != MPI_ANY_SOURCE && + vval != MPI_PROC_NULL) { + errs++; + fprintf( stderr, "Got invalid value %d for IO\n", vval ); + } + } + } + + rc = MPI_Attr_get( MPI_COMM_WORLD, MPI_WTIME_IS_GLOBAL, &v, &flag ); + if (rc) { + MissingKeyval( rc, "MPI_WTIME_IS_GLOBAL" ); + errs++; + } + else { + if (flag) { + /* Wtime need not be set */ + vval = *(int*)v; + if (vval < 0 || vval > 1) { + errs++; + fprintf( stderr, "Invalid value for WTIME_IS_GLOBAL (got %d)\n", + vval ); + } + } + } + + rc = MPI_Attr_get( MPI_COMM_WORLD, MPI_APPNUM, &v, &flag ); + if (rc) { + MissingKeyval( rc, "MPI_APPNUM" ); + errs++; + } + else { + /* appnum need not be set */ + if (flag) { + vval = *(int *)v; + if (vval < 0) { + errs++; + fprintf( stderr, "MPI_APPNUM is defined as %d but must be nonnegative\n", vval ); + } + } + } + + rc = MPI_Attr_get( MPI_COMM_WORLD, MPI_UNIVERSE_SIZE, &v, &flag ); + if (rc) { + MissingKeyval( rc, "MPI_UNIVERSE_SIZE" ); + errs++; + } + else { + /* MPI_UNIVERSE_SIZE need not be set */ + if (flag) { + vval = *(int *)v; + if (vval < size) { + errs++; + fprintf( stderr, "MPI_UNIVERSE_SIZE = %d, less than comm world (%d)\n", vval, size ); + } + } + } + + rc = MPI_Attr_get( MPI_COMM_WORLD, MPI_LASTUSEDCODE, &v, &flag ); + if (rc) { + MissingKeyval( rc, "MPI_LASTUSEDCODE" ); + errs++; + } + else { + /* Last used code must be defined and >= MPI_ERR_LASTCODE */ + if (flag) { + vval = *(int*)v; + if (vval < MPI_ERR_LASTCODE) { + errs++; + fprintf( stderr, "MPI_LASTUSEDCODE points to an integer (%d) smaller than MPI_ERR_LASTCODE (%d)\n", vval, MPI_ERR_LASTCODE ); + } + } + else { + errs++; + fprintf( stderr, "MPI_LASTUSECODE is not defined\n" ); + } + } + + MPI_Errhandler_set( MPI_COMM_WORLD, MPI_ERRORS_ARE_FATAL ); + + MTest_Finalize( errs ); + MPI_Finalize( ); + + return 0; +} + +void MissingKeyval( int errcode, const char keyname[] ) +{ + int errclass, slen; + char string[MPI_MAX_ERROR_STRING]; + + MPI_Error_class( errcode, &errclass ); + MPI_Error_string( errcode, string, &slen ); + printf( "For key %s: Error class %d (%s)\n", keyname, errclass, string ); + fflush( stdout ); +} diff --git a/teshsuite/smpi/mpich3-test/attr/baseattrcomm.c b/teshsuite/smpi/mpich3-test/attr/baseattrcomm.c new file mode 100644 index 0000000000..aaa76223bf --- /dev/null +++ b/teshsuite/smpi/mpich3-test/attr/baseattrcomm.c @@ -0,0 +1,118 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2001 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include +#include "mpi.h" +#include "mpitest.h" + +int main( int argc, char **argv) +{ + int errs = 0; + void *v; + int flag; + int vval; + int rank, size; + + MTest_Init( &argc, &argv ); + MPI_Comm_size( MPI_COMM_WORLD, &size ); + MPI_Comm_rank( MPI_COMM_WORLD, &rank ); + + MPI_Comm_get_attr( MPI_COMM_WORLD, MPI_TAG_UB, &v, &flag ); + if (!flag) { + errs++; + fprintf( stderr, "Could not get TAG_UB\n" ); + } + else { + vval = *(int*)v; + if (vval < 32767) { + errs++; + fprintf( stderr, "Got too-small value (%d) for TAG_UB\n", vval ); + } + } + + MPI_Comm_get_attr( MPI_COMM_WORLD, MPI_HOST, &v, &flag ); + if (!flag) { + errs++; + fprintf( stderr, "Could not get HOST\n" ); + } + else { + vval = *(int*)v; + if ((vval < 0 || vval >= size) && vval != MPI_PROC_NULL) { + errs++; + fprintf( stderr, "Got invalid value %d for HOST\n", vval ); + } + } + MPI_Comm_get_attr( MPI_COMM_WORLD, MPI_IO, &v, &flag ); + if (!flag) { + errs++; + fprintf( stderr, "Could not get IO\n" ); + } + else { + vval = *(int*)v; + if ((vval < 0 || vval >= size) && vval != MPI_ANY_SOURCE && + vval != MPI_PROC_NULL) { + errs++; + fprintf( stderr, "Got invalid value %d for IO\n", vval ); + } + } + + MPI_Comm_get_attr( MPI_COMM_WORLD, MPI_WTIME_IS_GLOBAL, &v, &flag ); + if (flag) { + /* Wtime need not be set */ + vval = *(int*)v; + if (vval < 0 || vval > 1) { + errs++; + fprintf( stderr, "Invalid value for WTIME_IS_GLOBAL (got %d)\n", + vval ); + } + } + + /* MPI 2.0, section 5.5.3 - MPI_APPNUM should be set if the program is + started with more than one executable name (e.g., in MPMD instead + of SPMD mode). This is independent of the dynamic process routines, + and should be supported even if MPI_COMM_SPAWN and friends are not. */ + MPI_Comm_get_attr( MPI_COMM_WORLD, MPI_APPNUM, &v, &flag ); + /* appnum need not be set */ + if (flag) { + vval = *(int *)v; + if (vval < 0) { + errs++; + fprintf( stderr, "MPI_APPNUM is defined as %d but must be nonnegative\n", vval ); + } + } + + /* MPI 2.0 section 5.5.1. MPI_UNIVERSE_SIZE need not be set, but + should be present. */ + MPI_Comm_get_attr( MPI_COMM_WORLD, MPI_UNIVERSE_SIZE, &v, &flag ); + /* MPI_UNIVERSE_SIZE need not be set */ + if (flag) { + /* But if it is set, it must be at least the size of comm_world */ + vval = *(int *)v; + if (vval < size) { + errs++; + fprintf( stderr, "MPI_UNIVERSE_SIZE = %d, less than comm world (%d)\n", vval, size ); + } + } + + MPI_Comm_get_attr( MPI_COMM_WORLD, MPI_LASTUSEDCODE, &v, &flag ); + /* Last used code must be defined and >= MPI_ERR_LASTCODE */ + if (flag) { + vval = *(int*)v; + if (vval < MPI_ERR_LASTCODE) { + errs++; + fprintf( stderr, "MPI_LASTUSEDCODE points to an integer (%d) smaller than MPI_ERR_LASTCODE (%d)\n", vval, MPI_ERR_LASTCODE ); + } + } + else { + errs++; + fprintf( stderr, "MPI_LASTUSECODE is not defined\n" ); + } + + MTest_Finalize( errs ); + MPI_Finalize( ); + + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/attr/fkeyval.c b/teshsuite/smpi/mpich3-test/attr/fkeyval.c new file mode 100644 index 0000000000..48722c1ece --- /dev/null +++ b/teshsuite/smpi/mpich3-test/attr/fkeyval.c @@ -0,0 +1,113 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2001 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include "mpi.h" +#include +#include "mpitest.h" + +/* +static char MTestDescrip[] = "Test freeing keyvals while still attached to \ +a communicator, then make sure that the keyval delete and copy code are still \ +executed"; +*/ + +/* Function prototypes to keep compilers happy */ +int copy_fn( MPI_Comm oldcomm, int keyval, void *extra_state, + void *attribute_val_in, void *attribute_val_out, + int *flag); +int delete_fn( MPI_Comm comm, int keyval, void *attribute_val, + void *extra_state); + +/* Copy increments the attribute value */ +int copy_fn( MPI_Comm oldcomm, int keyval, void *extra_state, + void *attribute_val_in, void *attribute_val_out, + int *flag) +{ + /* Copy the address of the attribute */ + *(void **)attribute_val_out = attribute_val_in; + /* Change the value */ + *(int *)attribute_val_in = *(int *)attribute_val_in + 1; + /* set flag to 1 to tell comm dup to insert this attribute + into the new communicator */ + *flag = 1; + return MPI_SUCCESS; +} + +/* Delete decrements the attribute value */ +int delete_fn( MPI_Comm comm, int keyval, void *attribute_val, + void *extra_state) +{ + *(int *)attribute_val = *(int *)attribute_val - 1; + return MPI_SUCCESS; +} + +int main( int argc, char *argv[] ) +{ + int errs = 0; + int attrval; + int i, key[32], keyval, saveKeyval; + MPI_Comm comm, dupcomm; + MTest_Init( &argc, &argv ); + + while (MTestGetIntracomm( &comm, 1 )) { + if (comm == MPI_COMM_NULL) continue; + + MPI_Keyval_create( copy_fn, delete_fn, &keyval, (void *)0 ); + saveKeyval = keyval; /* in case we need to free explicitly */ + attrval = 1; + MPI_Attr_put( comm, keyval, (void*)&attrval ); + /* See MPI-1, 5.7.1. Freeing the keyval does not remove it if it + is in use in an attribute */ + MPI_Keyval_free( &keyval ); + + /* We create some dummy keyvals here in case the same keyval + is reused */ + for (i=0; i<32; i++) { + MPI_Keyval_create( MPI_NULL_COPY_FN, MPI_NULL_DELETE_FN, + &key[i], (void *)0 ); + } + + MPI_Comm_dup( comm, &dupcomm ); + /* Check that the attribute was copied */ + if (attrval != 2) { + errs++; + printf( "Attribute not incremented when comm dup'ed (%s)\n", + MTestGetIntracommName() ); + } + MPI_Comm_free( &dupcomm ); + if (attrval != 1) { + errs++; + printf( "Attribute not decremented when dupcomm %s freed\n", + MTestGetIntracommName() ); + } + /* Check that the attribute was freed in the dupcomm */ + + if (comm != MPI_COMM_WORLD && comm != MPI_COMM_SELF) { + MPI_Comm_free( &comm ); + /* Check that the original attribute was freed */ + if (attrval != 0) { + errs++; + printf( "Attribute not decremented when comm %s freed\n", + MTestGetIntracommName() ); + } + } + else { + /* Explicitly delete the attributes from world and self */ + MPI_Attr_delete( comm, saveKeyval ); + } + /* Free those other keyvals */ + for (i=0; i<32; i++) { + MPI_Keyval_free( &key[i] ); + } + } + MTest_Finalize( errs ); + MPI_Finalize(); + + /* The attributes on comm self and world were deleted by finalize + (see separate test) */ + + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/attr/fkeyvalcomm.c b/teshsuite/smpi/mpich3-test/attr/fkeyvalcomm.c new file mode 100644 index 0000000000..e2e661449a --- /dev/null +++ b/teshsuite/smpi/mpich3-test/attr/fkeyvalcomm.c @@ -0,0 +1,114 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2001 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include "mpi.h" +#include +#include "mpitest.h" + +/* +static char MTestDescrip[] = "Test freeing keyvals while still attached to \ +a communicator, then make sure that the keyval delete and copy code are still \ +executed"; +*/ + +/* Function prototypes to keep compilers happy */ +int copy_fn( MPI_Comm oldcomm, int keyval, void *extra_state, + void *attribute_val_in, void *attribute_val_out, + int *flag); +int delete_fn( MPI_Comm comm, int keyval, void *attribute_val, + void *extra_state); + +/* Copy increments the attribute value */ +int copy_fn( MPI_Comm oldcomm, int keyval, void *extra_state, + void *attribute_val_in, void *attribute_val_out, + int *flag) +{ + /* Copy the address of the attribute */ + *(void **)attribute_val_out = attribute_val_in; + /* Change the value */ + *(int *)attribute_val_in = *(int *)attribute_val_in + 1; + /* set flag to 1 to tell comm dup to insert this attribute + into the new communicator */ + *flag = 1; + return MPI_SUCCESS; +} + +/* Delete decrements the attribute value */ +int delete_fn( MPI_Comm comm, int keyval, void *attribute_val, + void *extra_state) +{ + *(int *)attribute_val = *(int *)attribute_val - 1; + return MPI_SUCCESS; +} + +int main( int argc, char *argv[] ) +{ + int errs = 0; + int attrval; + int i, key[32], keyval, saveKeyval; + MPI_Comm comm, dupcomm; + MTest_Init( &argc, &argv ); + + while (MTestGetIntracomm( &comm, 1 )) { + if (comm == MPI_COMM_NULL) continue; + + MPI_Comm_create_keyval( copy_fn, delete_fn, &keyval, (void *)0 ); + saveKeyval = keyval; /* in case we need to free explicitly */ + attrval = 1; + MPI_Comm_set_attr( comm, keyval, (void*)&attrval ); + /* See MPI-1, 5.7.1. Freeing the keyval does not remove it if it + is in use in an attribute */ + MPI_Comm_free_keyval( &keyval ); + + /* We create some dummy keyvals here in case the same keyval + is reused */ + for (i=0; i<32; i++) { + MPI_Comm_create_keyval( MPI_NULL_COPY_FN, MPI_NULL_DELETE_FN, + &key[i], (void *)0 ); + } + + MPI_Comm_dup( comm, &dupcomm ); + /* Check that the attribute was copied */ + if (attrval != 2) { + errs++; + printf( "Attribute not incremented when comm dup'ed (%s)\n", + MTestGetIntracommName() ); + } + MPI_Comm_free( &dupcomm ); + if (attrval != 1) { + errs++; + printf( "Attribute not decremented when dupcomm %s freed\n", + MTestGetIntracommName() ); + } + /* Check that the attribute was freed in the dupcomm */ + + if (comm != MPI_COMM_WORLD && comm != MPI_COMM_SELF) { + MPI_Comm_free( &comm ); + /* Check that the original attribute was freed */ + if (attrval != 0) { + errs++; + printf( "Attribute not decremented when comm %s freed\n", + MTestGetIntracommName() ); + } + } + else { + /* Explicitly delete the attributes from world and self */ + MPI_Comm_delete_attr( comm, saveKeyval ); + } + /* Free those other keyvals */ + for (i=0; i<32; i++) { + MPI_Comm_free_keyval( &key[i] ); + } + } + MTest_Finalize( errs ); + MPI_Finalize(); + + /* The attributes on comm self and world were deleted by finalize + (see separate test) */ + + return 0; + +} diff --git a/teshsuite/smpi/mpich3-test/attr/fkeyvaltype.c b/teshsuite/smpi/mpich3-test/attr/fkeyvaltype.c new file mode 100644 index 0000000000..392e51dec3 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/attr/fkeyvaltype.c @@ -0,0 +1,127 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2001 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include "mpi.h" +#include +#include "mpitest.h" +#include "stdlib.h" + +/* +static char MTestDescrip[] = "Test freeing keyvals while still attached to \ +a datatype, then make sure that the keyval delete and copy code are still \ +executed"; +*/ + +/* Copy increments the attribute value */ +int copy_fn( MPI_Datatype oldtype, int keyval, void *extra_state, + void *attribute_val_in, void *attribute_val_out, + int *flag); +int copy_fn( MPI_Datatype oldtype, int keyval, void *extra_state, + void *attribute_val_in, void *attribute_val_out, + int *flag) +{ + /* Copy the address of the attribute */ + *(void **)attribute_val_out = attribute_val_in; + /* Change the value */ + *(int *)attribute_val_in = *(int *)attribute_val_in + 1; + /* set flag to 1 to tell comm dup to insert this attribute + into the new communicator */ + *flag = 1; + return MPI_SUCCESS; +} + +/* Delete decrements the attribute value */ +int delete_fn( MPI_Datatype type, int keyval, void *attribute_val, + void *extra_state); +int delete_fn( MPI_Datatype type, int keyval, void *attribute_val, + void *extra_state) +{ + *(int *)attribute_val = *(int *)attribute_val - 1; + return MPI_SUCCESS; +} + +int main( int argc, char *argv[] ) +{ + int errs = 0; + int attrval; + int i, key[32], keyval, saveKeyval; + MPI_Datatype type, duptype; + MTestDatatype mstype, mrtype; + char typename[MPI_MAX_OBJECT_NAME]; + int tnlen; + + MTest_Init( &argc, &argv ); + + while (MTestGetDatatypes( &mstype, &mrtype, 1 )) { + type = mstype.datatype; + MPI_Type_create_keyval( copy_fn, delete_fn, &keyval, (void *)0 ); + saveKeyval = keyval; /* in case we need to free explicitly */ + attrval = 1; + MPI_Type_set_attr( type, keyval, (void*)&attrval ); + /* See MPI-1, 5.7.1. Freeing the keyval does not remove it if it + is in use in an attribute */ + MPI_Type_free_keyval( &keyval ); + + /* We create some dummy keyvals here in case the same keyval + is reused */ + for (i=0; i<32; i++) { + MPI_Type_create_keyval( MPI_NULL_COPY_FN, MPI_NULL_DELETE_FN, + &key[i], (void *)0 ); + } + + if (attrval != 1) { + errs++; + MPI_Type_get_name( type, typename, &tnlen ); + printf( "attrval is %d, should be 1, before dup in type %s\n", + attrval, typename ); + } + MPI_Type_dup( type, &duptype ); + /* Check that the attribute was copied */ + if (attrval != 2) { + errs++; + MPI_Type_get_name( type, typename, &tnlen ); + printf( "Attribute not incremented when type dup'ed (%s)\n", + typename ); + } + MPI_Type_free( &duptype ); + if (attrval != 1) { + errs++; + MPI_Type_get_name( type, typename, &tnlen ); + printf( "Attribute not decremented when duptype %s freed\n", + typename ); + } + /* Check that the attribute was freed in the duptype */ + + if (!mstype.isBasic) { + MPI_Type_get_name( type, typename, &tnlen ); + MTestFreeDatatype(&mstype); + /* Check that the original attribute was freed */ + if (attrval != 0) { + errs++; + printf( "Attribute not decremented when type %s freed\n", + typename ); + } + } + else { + /* Explicitly delete the attributes from world and self */ + MPI_Type_delete_attr( type, saveKeyval ); + if (mstype.buf) { + free(mstype.buf); + mstype.buf = 0; + } + } + /* Free those other keyvals */ + for (i=0; i<32; i++) { + MPI_Type_free_keyval( &key[i] ); + } + MTestFreeDatatype(&mrtype); + } + MTest_Finalize( errs ); + MPI_Finalize(); + + return 0; + +} diff --git a/teshsuite/smpi/mpich3-test/attr/keyval_double_free.c b/teshsuite/smpi/mpich3-test/attr/keyval_double_free.c new file mode 100644 index 0000000000..9b5eaa60fc --- /dev/null +++ b/teshsuite/smpi/mpich3-test/attr/keyval_double_free.c @@ -0,0 +1,42 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2009 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include +#include +#include +#include "mpitest.h" + +/* tests multiple invocations of Keyval_free on the same keyval */ + +int delete_fn(MPI_Comm comm, int keyval, void *attr, void *extra); +int delete_fn(MPI_Comm comm, int keyval, void *attr, void *extra) { + MPI_Keyval_free(&keyval); + return MPI_SUCCESS; +} + +int main (int argc, char **argv) +{ + MPI_Comm duped; + int keyval = MPI_KEYVAL_INVALID; + int keyval_copy = MPI_KEYVAL_INVALID; + int errs=0; + + MTest_Init( &argc, &argv ); + MPI_Comm_dup(MPI_COMM_SELF, &duped); + + MPI_Keyval_create(MPI_NULL_COPY_FN, delete_fn, &keyval, NULL); + keyval_copy = keyval; + + MPI_Attr_put(MPI_COMM_SELF, keyval, NULL); + MPI_Attr_put(duped, keyval, NULL); + + MPI_Comm_free(&duped); /* first MPI_Keyval_free */ + MPI_Keyval_free(&keyval); /* second MPI_Keyval_free */ + MPI_Keyval_free(&keyval_copy); /* third MPI_Keyval_free */ + MTest_Finalize( errs ); + MPI_Finalize(); /* fourth MPI_Keyval_free */ + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/attr/testlist b/teshsuite/smpi/mpich3-test/attr/testlist new file mode 100644 index 0000000000..368d246098 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/attr/testlist @@ -0,0 +1,32 @@ +#needs MPI_Keyval_create and MPI_Attr_get +#attrt 2 +#needs MPI_Intercomm_create +#attric 4 +#needs MPI_Errhandler_set, MPI_Keyval_create, MPI_Keyval_free, MPI_Attr_put +#attrerr 1 +#needs MPI_Keyval_create, MPI_Keyval_free, MPI_Attr_put +#attrend 1 +#attrend 4 +attrend2 1 +attrend2 5 +#needs MPI_Errhandler_set, MPI_Comm_create_keyval, MPI_Comm_free_keyval, MPI_Comm_set_attr, MPI_Comm_delete_attr +#attrerrcomm 1 +#needs MPI_Errhandler_set, MPI_Type_create_keyval, MPI_Type_dup, MPI_Type_set_attr, MPI_Type_delete_attr +#attrerrtype 1 +#needs MPI_Type_create_keyval, MPI_Type_dup, MPI_Type_set_attr +#attr2type 1 +#needs MPI_Keyval_create, MPI_Keyval_free, MPI_Attr_put, MPI_Attr_get, MPI_Attr_delete +#attrorder 1 +#needs MPI_Comm_create_keyval, MPI_Comm_free_keyval, MPI_Comm_get_attr, MPI_Comm_set_attr, MPI_Comm_delete_attr +#attrordercomm 1 +#needs MPI_Type_create_keyval, MPI_Type_delete_keyval, MPI_Type_set_attr, MPI_Type_delete_attr +#attrordertype 1 +#needs MPI_Errhandler_set, MPI_Attr_get +#baseattr2 1 +#needs MPI_Comm_get_attr +#baseattrcomm 1 +#MPI_Keyval_create, MPI_Keyval_free for type and comm also +#fkeyval 1 +#fkeyvalcomm 1 +#fkeyvaltype 1 +#keyval_double_free 1 diff --git a/teshsuite/smpi/mpich3-test/checktests b/teshsuite/smpi/mpich3-test/checktests new file mode 100755 index 0000000000..ab266925cb --- /dev/null +++ b/teshsuite/smpi/mpich3-test/checktests @@ -0,0 +1,96 @@ +#! /usr/local/bin/perl + +$debug = 1; +$verbose = 1; +$ignoreBogusOutput = 0; +$filePattern = "runtests.*.status"; + +$testsPassed = 0; +$testsFailed = 0; + +foreach $_ (@ARGV) { + if (/^--?ignorebogus/) { + $ignoreBogusOutput = 1; + } + else { + print STDERR "checktests [ -ignorebogus ]\n"; + exit(1); + } +} + +open( RESULTS, "ls -1 $filePattern |" ) || die "Cannot list directory using ls -1 $filePattern\n"; + +while () { + chop; + $statusFile = $_; + $resultsFile = $statusFile; + $resultsFile =~ s/\.status/.out/; + + if ($resultsFile =~ /runtests\.([0-9]+)\.out/) { + $count = $1; + } + else { + $count = -1; + print STDERR "Unable to determine test number from $resultsFile!\n"; + $testsFailed ++; + next; + } + open (SFD, "<$statusFile" ); + while () { + chop; + $testStatus = $_; + } + close (SFD); + + if (-s $resultsFile) { + open (RFD, "<$resultsFile"); + $runLine = ; + $sawNoerrors = 0; + # Successful output should contain ONLY the line No Errors + while () { + chop; + $outLine = $_; + if ($outLine =~ /^\s+No [Ee]rrors\s*$/) { + $sawNoerrors = 1; + } + else { + # To filter out output that may be added to STDOUT + # by a badly behaved runtime system, you can either + # add a specific filter here (preferred) or set the + # -ignorebogus option (considered a workaround) + # The following is an example that accepts certain + # kinds of output once "No Errors" is seen. + if ($sawNoerrors) { + if ( /^Application [0-9]+ resources: utime .*/) { + last; + } + } + if (!$ignoreBogusOutput) { + # Any extraneous output is an error + $sawNoerrors = 0; + } + } + } + close (RFD); + if ($sawNoerrors == 1 && $testStatus == 0) { + $testsPassed ++; + } + else { + # Test wrote No Errors but then exited with a non-zero status + $testsFailed ++; + # Output the errors + if ($verbose) { + print STDOUT "Test $count failed:\n"; + print STDOUT "Test status: $testStatus\n"; + print STDOUT "Test output:\n"; + system ("cat $resultsFile" ); + } + } + } + else { + print STDERR "No $resultsFile\n" if $debug; + $testsFailed ++; + } +} + +print "Tests passed: $testsPassed; test failed: $testsFailed\n"; diff --git a/teshsuite/smpi/mpich3-test/coll/CMakeLists.txt b/teshsuite/smpi/mpich3-test/coll/CMakeLists.txt new file mode 100644 index 0000000000..4eb8ba2232 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/coll/CMakeLists.txt @@ -0,0 +1,403 @@ +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(allgather2 allgather2.c ../util/mtest.c) + add_executable(allgather3 allgather3.c ../util/mtest.c) + add_executable(allgatherv2 allgatherv2.c ../util/mtest.c) + add_executable(allgatherv3 allgatherv3.c ../util/mtest.c) + add_executable(allgatherv4 allgatherv4.c ../util/mtest.c) + add_executable(allred2 allred2.c ../util/mtest.c) + add_executable(allred3 allred3.c ../util/mtest.c) + add_executable(allred4 allred4.c ../util/mtest.c) + add_executable(allred5 allred5.c ../util/mtest.c) + add_executable(allred6 allred6.c ../util/mtest.c) + add_executable(allred allred.c ../util/mtest.c) + add_executable(allredmany allredmany.c ../util/mtest.c) + add_executable(alltoall1 alltoall1.c ../util/mtest.c) + add_executable(alltoallv0 alltoallv0.c ../util/mtest.c) + add_executable(alltoallv alltoallv.c ../util/mtest.c) + add_executable(alltoallw1 alltoallw1.c ../util/mtest.c) + add_executable(alltoallw2 alltoallw2.c ../util/mtest.c) + add_executable(alltoallw_zeros alltoallw_zeros.c ../util/mtest.c) + add_executable(bcast2 bcast2.c ../util/mtest.c) + add_executable(bcast3 bcast3.c ../util/mtest.c) + add_executable(bcasttest bcasttest.c ../util/mtest.c) + add_executable(bcastzerotype bcastzerotype.c ../util/mtest.c) + add_executable(coll10 coll10.c ../util/mtest.c) + add_executable(coll11 coll11.c ../util/mtest.c) + add_executable(coll12 coll12.c ../util/mtest.c) + add_executable(coll13 coll13.c ../util/mtest.c) + add_executable(coll2 coll2.c ../util/mtest.c) + add_executable(coll3 coll3.c ../util/mtest.c) + add_executable(coll4 coll4.c ../util/mtest.c) + add_executable(coll5 coll5.c ../util/mtest.c) + add_executable(coll6 coll6.c ../util/mtest.c) + add_executable(coll7 coll7.c ../util/mtest.c) + add_executable(coll8 coll8.c ../util/mtest.c) + add_executable(coll9 coll9.c ../util/mtest.c) + add_executable(exscan2 exscan2.c ../util/mtest.c) + add_executable(exscan exscan.c ../util/mtest.c) + add_executable(gather2 gather2.c ../util/mtest.c) + add_executable(gather2_save gather2_save.c ../util/mtest.c) + add_executable(gather gather.c ../util/mtest.c) + add_executable(iallred iallred.c ../util/mtest.c) + add_executable(ibarrier ibarrier.c ../util/mtest.c) + add_executable(icallgather icallgather.c ../util/mtest.c) + add_executable(icallgatherv icallgatherv.c ../util/mtest.c) + add_executable(icallreduce icallreduce.c ../util/mtest.c) + add_executable(icalltoall icalltoall.c ../util/mtest.c) + add_executable(icalltoallv icalltoallv.c ../util/mtest.c) + add_executable(icalltoallw icalltoallw.c ../util/mtest.c) + add_executable(icbarrier icbarrier.c ../util/mtest.c) + add_executable(icbcast icbcast.c ../util/mtest.c) + add_executable(icgather icgather.c ../util/mtest.c) + add_executable(icgatherv icgatherv.c ../util/mtest.c) + add_executable(icreduce icreduce.c ../util/mtest.c) + add_executable(icscatter icscatter.c ../util/mtest.c) + add_executable(icscatterv icscatterv.c ../util/mtest.c) + add_executable(longuser longuser.c ../util/mtest.c) + add_executable(nonblocking2 nonblocking2.c ../util/mtest.c) + add_executable(nonblocking3 nonblocking3.c ../util/mtest.c) + add_executable(nonblocking nonblocking.c ../util/mtest.c) + add_executable(opband opband.c ../util/mtest.c) + add_executable(opbor opbor.c ../util/mtest.c) + add_executable(opbxor opbxor.c ../util/mtest.c) + add_executable(op_commutative op_commutative.c ../util/mtest.c) + add_executable(opland opland.c ../util/mtest.c) + add_executable(oplor oplor.c ../util/mtest.c) + add_executable(oplxor oplxor.c ../util/mtest.c) + add_executable(opmax opmax.c ../util/mtest.c) + add_executable(opmaxloc opmaxloc.c ../util/mtest.c) + add_executable(opmin opmin.c ../util/mtest.c) + add_executable(opminloc opminloc.c ../util/mtest.c) + add_executable(opprod opprod.c ../util/mtest.c) + add_executable(opsum opsum.c ../util/mtest.c) + add_executable(red3 red3.c ../util/mtest.c) + add_executable(red4 red4.c ../util/mtest.c) + add_executable(redscat2 redscat2.c ../util/mtest.c) + add_executable(redscat3 redscat3.c ../util/mtest.c) + add_executable(redscatbkinter redscatbkinter.c ../util/mtest.c) + add_executable(redscatblk3 redscatblk3.c ../util/mtest.c) + add_executable(red_scat_block2 red_scat_block2.c ../util/mtest.c) + add_executable(red_scat_block red_scat_block.c ../util/mtest.c) + add_executable(redscat redscat.c ../util/mtest.c) + add_executable(redscatinter redscatinter.c ../util/mtest.c) + add_executable(reduce_mpich reduce.c ../util/mtest.c) + add_executable(reduce_local reduce_local.c ../util/mtest.c) + add_executable(scantst scantst.c ../util/mtest.c) + add_executable(scatter2 scatter2.c ../util/mtest.c) + add_executable(scatter3 scatter3.c ../util/mtest.c) + add_executable(scattern scattern.c ../util/mtest.c) + add_executable(scatterv scatterv.c ../util/mtest.c) + add_executable(uoplong uoplong.c ../util/mtest.c) + + + + target_link_libraries(allgather2 simgrid) + target_link_libraries(allgather3 simgrid) + target_link_libraries(allgatherv2 simgrid) + target_link_libraries(allgatherv3 simgrid) + target_link_libraries(allgatherv4 simgrid) + target_link_libraries(allred2 simgrid) + target_link_libraries(allred3 simgrid) + target_link_libraries(allred4 simgrid) + target_link_libraries(allred5 simgrid) + target_link_libraries(allred6 simgrid) + target_link_libraries(allred simgrid) + target_link_libraries(allredmany simgrid) + target_link_libraries(alltoall1 simgrid) + target_link_libraries(alltoallv0 simgrid) + target_link_libraries(alltoallv simgrid) + target_link_libraries(alltoallw1 simgrid) + target_link_libraries(alltoallw2 simgrid) + target_link_libraries(alltoallw_zeros simgrid) + target_link_libraries(bcast2 simgrid) + target_link_libraries(bcast3 simgrid) + target_link_libraries(bcasttest simgrid) + target_link_libraries(bcastzerotype simgrid) + target_link_libraries(coll10 simgrid) + target_link_libraries(coll11 simgrid) + target_link_libraries(coll12 simgrid) + target_link_libraries(coll13 simgrid) + target_link_libraries(coll2 simgrid) + target_link_libraries(coll3 simgrid) + target_link_libraries(coll4 simgrid) + target_link_libraries(coll5 simgrid) + target_link_libraries(coll6 simgrid) + target_link_libraries(coll7 simgrid) + target_link_libraries(coll8 simgrid) + target_link_libraries(coll9 simgrid) + target_link_libraries(exscan2 simgrid) + target_link_libraries(exscan simgrid) + target_link_libraries(gather2 simgrid) + target_link_libraries(gather2_save simgrid) + target_link_libraries(gather simgrid) + target_link_libraries(iallred simgrid) + target_link_libraries(ibarrier simgrid) + target_link_libraries(icallgather simgrid) + target_link_libraries(icallgatherv simgrid) + target_link_libraries(icallreduce simgrid) + target_link_libraries(icalltoall simgrid) + target_link_libraries(icalltoallv simgrid) + target_link_libraries(icalltoallw simgrid) + target_link_libraries(icbarrier simgrid) + target_link_libraries(icbcast simgrid) + target_link_libraries(icgather simgrid) + target_link_libraries(icgatherv simgrid) + target_link_libraries(icreduce simgrid) + target_link_libraries(icscatter simgrid) + target_link_libraries(icscatterv simgrid) + target_link_libraries(longuser simgrid) + target_link_libraries(nonblocking2 simgrid) + target_link_libraries(nonblocking3 simgrid) + target_link_libraries(nonblocking simgrid) + target_link_libraries(opband simgrid) + target_link_libraries(opbor simgrid) + target_link_libraries(opbxor simgrid) + target_link_libraries(op_commutative simgrid) + target_link_libraries(opland simgrid) + target_link_libraries(oplor simgrid) + target_link_libraries(oplxor simgrid) + target_link_libraries(opmax simgrid) + target_link_libraries(opmaxloc simgrid) + target_link_libraries(opmin simgrid) + target_link_libraries(opminloc simgrid) + target_link_libraries(opprod simgrid) + target_link_libraries(opsum simgrid) + target_link_libraries(red3 simgrid) + target_link_libraries(red4 simgrid) + target_link_libraries(redscat2 simgrid) + target_link_libraries(redscat3 simgrid) + target_link_libraries(redscatbkinter simgrid) + target_link_libraries(redscatblk3 simgrid) + target_link_libraries(red_scat_block2 simgrid) + target_link_libraries(red_scat_block simgrid) + target_link_libraries(redscat simgrid) + target_link_libraries(redscatinter simgrid) + target_link_libraries(reduce_mpich simgrid) + target_link_libraries(reduce_local simgrid) + target_link_libraries(scantst simgrid) + target_link_libraries(scatter2 simgrid) + target_link_libraries(scatter3 simgrid) + target_link_libraries(scattern simgrid) + target_link_libraries(scatterv simgrid) + target_link_libraries(uoplong simgrid) + + + + set_target_properties(allgather2 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(allgather3 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(allgatherv2 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(allgatherv3 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(allgatherv4 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(allred2 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(allred3 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(allred4 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(allred5 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(allred6 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(allred PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(allredmany PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(alltoall1 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(alltoallv0 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(alltoallv PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(alltoallw1 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(alltoallw2 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(alltoallw_zeros PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(bcast2 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(bcast3 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(bcasttest PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(bcastzerotype PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(coll10 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(coll11 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(coll12 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(coll13 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(coll2 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(coll3 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(coll4 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(coll5 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(coll6 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(coll7 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(coll8 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(coll9 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(exscan2 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(exscan PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(gather2 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(gather2_save PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(gather PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(iallred PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(ibarrier PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(icallgather PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(icallgatherv PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(icallreduce PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(icalltoall PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(icalltoallv PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(icalltoallw PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(icbarrier PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(icbcast PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(icgather PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(icgatherv PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(icreduce PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(icscatter PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(icscatterv PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(longuser PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(nonblocking2 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(nonblocking3 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(nonblocking PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(opband PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(opbor PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(opbxor PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(op_commutative PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(opland PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(oplor PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(oplxor PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(opmax PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(opmaxloc PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(opmin PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(opminloc PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(opprod PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(opsum PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(red3 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(red4 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(redscat2 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(redscat3 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(redscatbkinter PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(redscatblk3 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(red_scat_block2 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(red_scat_block PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(redscat PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(redscatinter PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(reduce_mpich PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(reduce_local PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(scantst PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(scatter2 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(scatter3 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(scattern PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(scatterv PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(uoplong 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}/allgather2.c + ${CMAKE_CURRENT_SOURCE_DIR}/allgather3.c + ${CMAKE_CURRENT_SOURCE_DIR}/allgatherv2.c + ${CMAKE_CURRENT_SOURCE_DIR}/allgatherv3.c + ${CMAKE_CURRENT_SOURCE_DIR}/allgatherv4.c + ${CMAKE_CURRENT_SOURCE_DIR}/allred2.c + ${CMAKE_CURRENT_SOURCE_DIR}/allred3.c + ${CMAKE_CURRENT_SOURCE_DIR}/allred4.c + ${CMAKE_CURRENT_SOURCE_DIR}/allred5.c + ${CMAKE_CURRENT_SOURCE_DIR}/allred6.c + ${CMAKE_CURRENT_SOURCE_DIR}/allred.c + ${CMAKE_CURRENT_SOURCE_DIR}/allredmany.c + ${CMAKE_CURRENT_SOURCE_DIR}/alltoall1.c + ${CMAKE_CURRENT_SOURCE_DIR}/alltoallv0.c + ${CMAKE_CURRENT_SOURCE_DIR}/alltoallv.c + ${CMAKE_CURRENT_SOURCE_DIR}/alltoallw1.c + ${CMAKE_CURRENT_SOURCE_DIR}/alltoallw2.c + ${CMAKE_CURRENT_SOURCE_DIR}/alltoallw_zeros.c + ${CMAKE_CURRENT_SOURCE_DIR}/bcast2.c + ${CMAKE_CURRENT_SOURCE_DIR}/bcast3.c + ${CMAKE_CURRENT_SOURCE_DIR}/bcasttest.c + ${CMAKE_CURRENT_SOURCE_DIR}/bcastzerotype.c + ${CMAKE_CURRENT_SOURCE_DIR}/coll10.c + ${CMAKE_CURRENT_SOURCE_DIR}/coll11.c + ${CMAKE_CURRENT_SOURCE_DIR}/coll12.c + ${CMAKE_CURRENT_SOURCE_DIR}/coll13.c + ${CMAKE_CURRENT_SOURCE_DIR}/coll2.c + ${CMAKE_CURRENT_SOURCE_DIR}/coll3.c + ${CMAKE_CURRENT_SOURCE_DIR}/coll4.c + ${CMAKE_CURRENT_SOURCE_DIR}/coll5.c + ${CMAKE_CURRENT_SOURCE_DIR}/coll6.c + ${CMAKE_CURRENT_SOURCE_DIR}/coll7.c + ${CMAKE_CURRENT_SOURCE_DIR}/coll8.c + ${CMAKE_CURRENT_SOURCE_DIR}/coll9.c + ${CMAKE_CURRENT_SOURCE_DIR}/exscan2.c + ${CMAKE_CURRENT_SOURCE_DIR}/exscan.c + ${CMAKE_CURRENT_SOURCE_DIR}/gather2.c + ${CMAKE_CURRENT_SOURCE_DIR}/gather2_save.c + ${CMAKE_CURRENT_SOURCE_DIR}/gather.c + ${CMAKE_CURRENT_SOURCE_DIR}/iallred.c + ${CMAKE_CURRENT_SOURCE_DIR}/ibarrier.c + ${CMAKE_CURRENT_SOURCE_DIR}/icallgather.c + ${CMAKE_CURRENT_SOURCE_DIR}/icallgatherv.c + ${CMAKE_CURRENT_SOURCE_DIR}/icallreduce.c + ${CMAKE_CURRENT_SOURCE_DIR}/icalltoall.c + ${CMAKE_CURRENT_SOURCE_DIR}/icalltoallv.c + ${CMAKE_CURRENT_SOURCE_DIR}/icalltoallw.c + ${CMAKE_CURRENT_SOURCE_DIR}/icbarrier.c + ${CMAKE_CURRENT_SOURCE_DIR}/icbcast.c + ${CMAKE_CURRENT_SOURCE_DIR}/icgather.c + ${CMAKE_CURRENT_SOURCE_DIR}/icgatherv.c + ${CMAKE_CURRENT_SOURCE_DIR}/icreduce.c + ${CMAKE_CURRENT_SOURCE_DIR}/icscatter.c + ${CMAKE_CURRENT_SOURCE_DIR}/icscatterv.c + ${CMAKE_CURRENT_SOURCE_DIR}/longuser.c + ${CMAKE_CURRENT_SOURCE_DIR}/nonblocking2.c + ${CMAKE_CURRENT_SOURCE_DIR}/nonblocking3.c + ${CMAKE_CURRENT_SOURCE_DIR}/nonblocking.c + ${CMAKE_CURRENT_SOURCE_DIR}/opband.c + ${CMAKE_CURRENT_SOURCE_DIR}/opbor.c + ${CMAKE_CURRENT_SOURCE_DIR}/opbxor.c + ${CMAKE_CURRENT_SOURCE_DIR}/op_commutative.c + ${CMAKE_CURRENT_SOURCE_DIR}/opland.c + ${CMAKE_CURRENT_SOURCE_DIR}/oplor.c + ${CMAKE_CURRENT_SOURCE_DIR}/oplxor.c + ${CMAKE_CURRENT_SOURCE_DIR}/opmax.c + ${CMAKE_CURRENT_SOURCE_DIR}/opmaxloc.c + ${CMAKE_CURRENT_SOURCE_DIR}/opmin.c + ${CMAKE_CURRENT_SOURCE_DIR}/opminloc.c + ${CMAKE_CURRENT_SOURCE_DIR}/opprod.c + ${CMAKE_CURRENT_SOURCE_DIR}/opsum.c + ${CMAKE_CURRENT_SOURCE_DIR}/red3.c + ${CMAKE_CURRENT_SOURCE_DIR}/red4.c + ${CMAKE_CURRENT_SOURCE_DIR}/redscat2.c + ${CMAKE_CURRENT_SOURCE_DIR}/redscat3.c + ${CMAKE_CURRENT_SOURCE_DIR}/redscatbkinter.c + ${CMAKE_CURRENT_SOURCE_DIR}/redscatblk3.c + ${CMAKE_CURRENT_SOURCE_DIR}/red_scat_block2.c + ${CMAKE_CURRENT_SOURCE_DIR}/red_scat_block.c + ${CMAKE_CURRENT_SOURCE_DIR}/redscat.c + ${CMAKE_CURRENT_SOURCE_DIR}/redscatinter.c + ${CMAKE_CURRENT_SOURCE_DIR}/reduce.c + ${CMAKE_CURRENT_SOURCE_DIR}/reduce_local.c + ${CMAKE_CURRENT_SOURCE_DIR}/scantst.c + ${CMAKE_CURRENT_SOURCE_DIR}/scatter2.c + ${CMAKE_CURRENT_SOURCE_DIR}/scatter3.c + ${CMAKE_CURRENT_SOURCE_DIR}/scattern.c + ${CMAKE_CURRENT_SOURCE_DIR}/scatterv.c + ${CMAKE_CURRENT_SOURCE_DIR}/uoplong.c + PARENT_SCOPE + ) +set(bin_files + ${bin_files} + PARENT_SCOPE + ) +set(txt_files + ${txt_files} + ${CMAKE_CURRENT_SOURCE_DIR}/runtests + ${CMAKE_CURRENT_SOURCE_DIR}/testlist + PARENT_SCOPE + ) diff --git a/teshsuite/smpi/mpich3-test/coll/allgather2.c b/teshsuite/smpi/mpich3-test/coll/allgather2.c new file mode 100644 index 0000000000..edb907dd16 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/coll/allgather2.c @@ -0,0 +1,59 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2003 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ + +#include "mpi.h" +#include "mpitest.h" +#include +#include + +/* Gather data from a vector to contiguous. Use IN_PLACE */ + +int main( int argc, char **argv ) +{ + double *vecout; + MPI_Comm comm; + int count, minsize = 2; + int i, errs = 0; + int rank, size; + + MTest_Init( &argc, &argv ); + + while (MTestGetIntracommGeneral( &comm, minsize, 1 )) { + if (comm == MPI_COMM_NULL) continue; + /* Determine the sender and receiver */ + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + + for (count = 1; count < 9000; count = count * 2) { + vecout = (double *)malloc( size * count * sizeof(double) ); + + for (i=0; i +#include + +/* Gather data from a vector to contiguous. */ + +int main( int argc, char **argv ) +{ + double *vecout, *invec; + MPI_Comm comm; + int count, minsize = 2; + int i, errs = 0; + int rank, size; + + MTest_Init( &argc, &argv ); + + while (MTestGetIntracommGeneral( &comm, minsize, 1 )) { + if (comm == MPI_COMM_NULL) continue; + /* Determine the sender and receiver */ + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + + for (count = 1; count < 9000; count = count * 2) { + invec = (double *)malloc( count * sizeof(double) ); + vecout = (double *)malloc( size * count * sizeof(double) ); + + for (i=0; i +#include + +/* Gather data from a vector to contiguous. Use IN_PLACE. This is + the trivial version based on the allgather test (allgatherv but with + constant data sizes) */ + +int main( int argc, char **argv ) +{ + double *vecout; + MPI_Comm comm; + int count, minsize = 2; + int i, errs = 0; + int rank, size; + int *displs, *recvcounts; + + MTest_Init( &argc, &argv ); + + while (MTestGetIntracommGeneral( &comm, minsize, 1 )) { + if (comm == MPI_COMM_NULL) continue; + /* Determine the sender and receiver */ + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + + displs = (int *)malloc( size * sizeof(int) ); + recvcounts = (int *)malloc( size * sizeof(int) ); + + for (count = 1; count < 9000; count = count * 2) { + vecout = (double *)malloc( size * count * sizeof(double) ); + + for (i=0; i +#include + +/* Gather data from a vector to contiguous. This is + the trivial version based on the allgather test (allgatherv but with + constant data sizes) */ + +int main( int argc, char **argv ) +{ + double *vecout, *invec; + MPI_Comm comm; + int count, minsize = 2; + int i, errs = 0; + int rank, size; + int *displs, *recvcounts; + + MTest_Init( &argc, &argv ); + + while (MTestGetIntracommGeneral( &comm, minsize, 1 )) { + if (comm == MPI_COMM_NULL) continue; + /* Determine the sender and receiver */ + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + + displs = (int *)malloc( size * sizeof(int) ); + recvcounts = (int *)malloc( size * sizeof(int) ); + + for (count = 1; count < 9000; count = count * 2) { + invec = (double *)malloc( count * sizeof(double) ); + vecout = (double *)malloc( size * count * sizeof(double) ); + + for (i=0; i +#include +#ifdef HAVE_SYS_TIME_H +#include +#endif +#include +#include +#include + +/* FIXME: What is this test supposed to accomplish? */ + +#define START_BUF (1) +#define LARGE_BUF (256 * 1024) + +/* FIXME: MAX_BUF is too large */ +#define MAX_BUF (128 * 1024 * 1024) +#define LOOPS 10 + +__thread char * sbuf, * rbuf; +__thread int * recvcounts, * displs; +int errs = 0; + +/* #define dprintf printf */ +#define dprintf(...) + +typedef enum { + REGULAR, + BCAST, + SPIKE, + HALF_FULL, + LINEAR_DECREASE, + BELL_CURVE +} test_t; + +void comm_tests(MPI_Comm comm); +double run_test(long long msg_size, MPI_Comm comm, test_t test_type, double * max_time); + +int main(int argc, char ** argv) +{ + int comm_size, comm_rank; + MPI_Comm comm; + + MTest_Init(&argc, &argv); + MPI_Comm_size(MPI_COMM_WORLD, &comm_size); + MPI_Comm_rank(MPI_COMM_WORLD, &comm_rank); + + if (LARGE_BUF * comm_size > MAX_BUF) + goto fn_exit; + + sbuf = (void *) calloc(MAX_BUF, 1); + rbuf = (void *) calloc(MAX_BUF, 1); + + srand(time(NULL)); + + recvcounts = (void *) malloc(comm_size * sizeof(int)); + displs = (void *) malloc(comm_size * sizeof(int)); + if (!recvcounts || !displs || !sbuf || !rbuf) { + fprintf(stderr, "Unable to allocate memory:\n"); + if (!sbuf) fprintf(stderr,"\tsbuf of %d bytes\n", MAX_BUF ); + if (!rbuf) fprintf(stderr,"\trbuf of %d bytes\n", MAX_BUF ); + if (!recvcounts) fprintf(stderr,"\trecvcounts of %zd bytes\n", comm_size * sizeof(int) ); + if (!displs) fprintf(stderr,"\tdispls of %zd bytes\n", comm_size * sizeof(int) ); + fflush(stderr); + MPI_Abort(MPI_COMM_WORLD, -1); + } + + if (!comm_rank) { + dprintf("Message Range: (%d, %d); System size: %d\n", START_BUF, LARGE_BUF, comm_size); + fflush(stdout); + } + + + /* COMM_WORLD tests */ + if (!comm_rank) { + dprintf("\n\n==========================================================\n"); + dprintf(" MPI_COMM_WORLD\n"); + dprintf("==========================================================\n"); + } + comm_tests(MPI_COMM_WORLD); + + /* non-COMM_WORLD tests */ + if (!comm_rank) { + dprintf("\n\n==========================================================\n"); + dprintf(" non-COMM_WORLD\n"); + dprintf("==========================================================\n"); + } + MPI_Comm_split(MPI_COMM_WORLD, (comm_rank == comm_size - 1) ? 0 : 1, 0, &comm); + if (comm_rank < comm_size - 1) + comm_tests(comm); + MPI_Comm_free(&comm); + + /* Randomized communicator tests */ + if (!comm_rank) { + dprintf("\n\n==========================================================\n"); + dprintf(" Randomized Communicator\n"); + dprintf("==========================================================\n"); + } + MPI_Comm_split(MPI_COMM_WORLD, 0, rand(), &comm); + comm_tests(comm); + MPI_Comm_free(&comm); + + //free(sbuf); + //free(rbuf); + free(recvcounts); + free(displs); + +fn_exit: + MTest_Finalize(errs); + MPI_Finalize(); + + return 0; +} + +void comm_tests(MPI_Comm comm) +{ + int comm_size, comm_rank; + double rtime, max_time; + long long msg_size; + + MPI_Comm_size(comm, &comm_size); + MPI_Comm_rank(comm, &comm_rank); + + for (msg_size = START_BUF; msg_size <= LARGE_BUF; msg_size *= 2) { + if (!comm_rank) { + dprintf("\n====> MSG_SIZE: %d\n", (int) msg_size); + fflush(stdout); + } + + rtime = run_test(msg_size, comm, REGULAR, &max_time); + if (!comm_rank) { + dprintf("REGULAR:\tAVG: %.3f\tMAX: %.3f\n", rtime, max_time); + fflush(stdout); + } + + rtime = run_test(msg_size, comm, BCAST, &max_time); + if (!comm_rank) { + dprintf("BCAST:\tAVG: %.3f\tMAX: %.3f\n", rtime, max_time); + fflush(stdout); + } + + rtime = run_test(msg_size, comm, SPIKE, &max_time); + if (!comm_rank) { + dprintf("SPIKE:\tAVG: %.3f\tMAX: %.3f\n", rtime, max_time); + fflush(stdout); + } + + rtime = run_test(msg_size, comm, HALF_FULL, &max_time); + if (!comm_rank) { + dprintf("HALF_FULL:\tAVG: %.3f\tMAX: %.3f\n", rtime, max_time); + fflush(stdout); + } + + rtime = run_test(msg_size, comm, LINEAR_DECREASE, &max_time); + if (!comm_rank) { + dprintf("LINEAR_DECREASE:\tAVG: %.3f\tMAX: %.3f\n", rtime, max_time); + fflush(stdout); + } + + rtime = run_test(msg_size, comm, BELL_CURVE, &max_time); + if (!comm_rank) { + dprintf("BELL_CURVE:\tAVG: %.3f\tMAX: %.3f\n", rtime, max_time); + fflush(stdout); + } + } +} + +double run_test(long long msg_size, MPI_Comm comm, test_t test_type, + double * max_time) +{ + int i, j; + int comm_size, comm_rank; + double start, end; + double total_time, avg_time; + MPI_Aint tmp; + + MPI_Comm_size(comm, &comm_size); + MPI_Comm_rank(comm, &comm_rank); + + displs[0] = 0; + for (i = 0; i < comm_size; i++) { + if (test_type == REGULAR) + recvcounts[i] = msg_size; + else if (test_type == BCAST) + recvcounts[i] = (!i) ? msg_size : 0; + else if (test_type == SPIKE) + recvcounts[i] = (!i) ? (msg_size / 2) : (msg_size / (2 * (comm_size - 1))); + else if (test_type == HALF_FULL) + recvcounts[i] = (i < (comm_size / 2)) ? (2 * msg_size) : 0; + else if (test_type == LINEAR_DECREASE) { + tmp = 2 * msg_size * (comm_size - 1 - i) / (comm_size - 1); + if (tmp != (int)tmp) { + fprintf( stderr, "Integer overflow in variable tmp\n" ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + recvcounts[i] = (int) tmp; + + /* If the maximum message size is too large, don't run */ + if (tmp > MAX_BUF) return 0; + } + else if (test_type == BELL_CURVE) { + for (j = 0; j < i; j++) { + if (i - 1 + j >= comm_size) continue; + tmp = msg_size * comm_size / (log(comm_size) * i); + recvcounts[i - 1 + j] = (int) tmp; + displs[i - 1 + j] = 0; + + /* If the maximum message size is too large, don't run */ + if (tmp > MAX_BUF) return 0; + } + } + + if (i < comm_size - 1) + displs[i+1] = displs[i] + recvcounts[i]; + } + + /* Test that: + 1: sbuf is large enough + 2: rbuf is large enough + 3: There were no failures (e.g., tmp nowhere > rbuf size + */ + MPI_Barrier(comm); + start = MPI_Wtime(); + for (i = 0; i < LOOPS; i++) { + MPI_Allgatherv(sbuf, recvcounts[comm_rank], MPI_CHAR, + rbuf, recvcounts, displs, MPI_CHAR, comm); + } + end = MPI_Wtime(); + MPI_Barrier(comm); + + /* Convert to microseconds (why?) */ + total_time = 1.0e6 * (end - start); + MPI_Reduce(&total_time, &avg_time, 1, MPI_DOUBLE, MPI_SUM, 0, comm); + MPI_Reduce(&total_time, max_time, 1, MPI_DOUBLE, MPI_MAX, 0, comm); + + return (avg_time / (LOOPS * comm_size)); +} diff --git a/teshsuite/smpi/mpich3-test/coll/allred.c b/teshsuite/smpi/mpich3-test/coll/allred.c new file mode 100644 index 0000000000..d33f876849 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/coll/allred.c @@ -0,0 +1,447 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2001 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +/* Warning - this test will fail for MPI_PROD & maybe MPI_SUM + * if more than 10 MPI processes are used. Loss of precision + * will occur as the number of processors is increased. + */ + +#include "mpi.h" +#include "mpitest.h" +#include +#include +#include +#ifdef HAVE_STDINT_H +#include +#endif + +int count, size, rank; +int cerrcnt; + +struct int_test { int a; int b; }; +struct long_test { long a; int b; }; +struct short_test { short a; int b; }; +struct float_test { float a; int b; }; +struct double_test { double a; int b; }; + +#define mpi_op2str(op) \ + ((op == MPI_SUM) ? "MPI_SUM" : \ + (op == MPI_PROD) ? "MPI_PROD" : \ + (op == MPI_MAX) ? "MPI_MAX" : \ + (op == MPI_MIN) ? "MPI_MIN" : \ + (op == MPI_LOR) ? "MPI_LOR" : \ + (op == MPI_LXOR) ? "MPI_LXOR" : \ + (op == MPI_LAND) ? "MPI_LAND" : \ + (op == MPI_BOR) ? "MPI_BOR" : \ + (op == MPI_BAND) ? "MPI_BAND" : \ + (op == MPI_BXOR) ? "MPI_BXOR" : \ + (op == MPI_MAXLOC) ? "MPI_MAXLOC" : \ + (op == MPI_MINLOC) ? "MPI_MINLOC" : \ + "MPI_NO_OP") + +/* calloc to avoid spurious valgrind warnings when "type" has padding bytes */ +#define DECL_MALLOC_IN_OUT_SOL(type) \ + type *in, *out, *sol; \ + in = (type *) calloc(count, sizeof(type)); \ + out = (type *) calloc(count, sizeof(type)); \ + sol = (type *) calloc(count, sizeof(type)); + +#define SET_INDEX_CONST(arr, val) \ + { \ + int i; \ + for (i = 0; i < count; i++) \ + arr[i] = val; \ + } + +#define SET_INDEX_SUM(arr, val) \ + { \ + int i; \ + for (i = 0; i < count; i++) \ + arr[i] = i + val; \ + } + +#define SET_INDEX_FACTOR(arr, val) \ + { \ + int i; \ + for (i = 0; i < count; i++) \ + arr[i] = i * (val); \ + } + +#define SET_INDEX_POWER(arr, val) \ + { \ + int i, j; \ + for (i = 0; i < count; i++) { \ + (arr)[i] = 1; \ + for (j = 0; j < (val); j++) \ + arr[i] *= i; \ + } \ + } + +#define ERROR_CHECK_AND_FREE(lerrcnt, mpi_type, mpi_op) \ + do { \ + char name[MPI_MAX_OBJECT_NAME] = {0}; \ + int len = 0; \ + if (lerrcnt) { \ + MPI_Type_get_name(mpi_type, name, &len); \ + fprintf(stderr, "(%d) Error for type %s and op %s\n", \ + rank, name, mpi_op2str(mpi_op)); \ + } \ + free(in); free(out); free(sol); \ + } while(0) + +/* The logic on the error check on MPI_Allreduce assumes that all + MPI_Allreduce routines return a failure if any do - this is sufficient + for MPI implementations that reject some of the valid op/datatype pairs + (and motivated this addition, as some versions of the IBM MPI + failed in just this way). +*/ +#define ALLREDUCE_AND_FREE(mpi_type, mpi_op, in, out, sol) \ + { \ + int i, rc, lerrcnt = 0; \ + rc = MPI_Allreduce(in, out, count, mpi_type, mpi_op, MPI_COMM_WORLD); \ + if (rc) { lerrcnt++; cerrcnt++; MTestPrintError( rc ); } \ + else { \ + for (i = 0; i < count; i++) { \ + if (out[i] != sol[i]) { \ + cerrcnt++; \ + lerrcnt++; \ + } \ + } \ + } \ + ERROR_CHECK_AND_FREE(lerrcnt, mpi_type, mpi_op); \ + } + +#define STRUCT_ALLREDUCE_AND_FREE(mpi_type, mpi_op, in, out, sol) \ + { \ + int i, rc, lerrcnt = 0; \ + rc = MPI_Allreduce(in, out, count, mpi_type, mpi_op, MPI_COMM_WORLD); \ + if (rc) { lerrcnt++; cerrcnt++; MTestPrintError( rc ); } \ + else { \ + for (i = 0; i < count; i++) { \ + if ((out[i].a != sol[i].a) || (out[i].b != sol[i].b)) { \ + cerrcnt++; \ + lerrcnt++; \ + } \ + } \ + } \ + ERROR_CHECK_AND_FREE(lerrcnt, mpi_type, mpi_op); \ + } + +#define SET_INDEX_STRUCT_CONST(arr, val, el) \ + { \ + int i; \ + for (i = 0; i < count; i++) \ + arr[i].el = val; \ + } + +#define SET_INDEX_STRUCT_SUM(arr, val, el) \ + { \ + int i; \ + for (i = 0; i < count; i++) \ + arr[i].el = i + (val); \ + } + +#define sum_test1(type, mpi_type) \ + { \ + DECL_MALLOC_IN_OUT_SOL(type); \ + SET_INDEX_SUM(in, 0); \ + SET_INDEX_FACTOR(sol, size); \ + SET_INDEX_CONST(out, 0); \ + ALLREDUCE_AND_FREE(mpi_type, MPI_SUM, in, out, sol); \ + } + +#define prod_test1(type, mpi_type) \ + { \ + DECL_MALLOC_IN_OUT_SOL(type); \ + SET_INDEX_SUM(in, 0); \ + SET_INDEX_POWER(sol, size); \ + SET_INDEX_CONST(out, 0); \ + ALLREDUCE_AND_FREE(mpi_type, MPI_PROD, in, out, sol); \ + } + +#define max_test1(type, mpi_type) \ + { \ + DECL_MALLOC_IN_OUT_SOL(type); \ + SET_INDEX_SUM(in, rank); \ + SET_INDEX_SUM(sol, size - 1); \ + SET_INDEX_CONST(out, 0); \ + ALLREDUCE_AND_FREE(mpi_type, MPI_MAX, in, out, sol); \ + } + +#define min_test1(type, mpi_type) \ + { \ + DECL_MALLOC_IN_OUT_SOL(type); \ + SET_INDEX_SUM(in, rank); \ + SET_INDEX_SUM(sol, 0); \ + SET_INDEX_CONST(out, 0); \ + ALLREDUCE_AND_FREE(mpi_type, MPI_MIN, in, out, sol); \ + } + +#define const_test(type, mpi_type, mpi_op, val1, val2, val3) \ + { \ + DECL_MALLOC_IN_OUT_SOL(type); \ + SET_INDEX_CONST(in, (val1)); \ + SET_INDEX_CONST(sol, (val2)); \ + SET_INDEX_CONST(out, (val3)); \ + ALLREDUCE_AND_FREE(mpi_type, mpi_op, in, out, sol); \ + } + +#define lor_test1(type, mpi_type) \ + const_test(type, mpi_type, MPI_LOR, (rank & 0x1), (size > 1), 0) +#define lor_test2(type, mpi_type) \ + const_test(type, mpi_type, MPI_LOR, 0, 0, 0) +#define lxor_test1(type, mpi_type) \ + const_test(type, mpi_type, MPI_LXOR, (rank == 1), (size > 1), 0) +#define lxor_test2(type, mpi_type) \ + const_test(type, mpi_type, MPI_LXOR, 0, 0, 0) +#define lxor_test3(type, mpi_type) \ + const_test(type, mpi_type, MPI_LXOR, 1, (size & 0x1), 0) +#define land_test1(type, mpi_type) \ + const_test(type, mpi_type, MPI_LAND, (rank & 0x1), 0, 0) +#define land_test2(type, mpi_type) \ + const_test(type, mpi_type, MPI_LAND, 1, 1, 0) +#define bor_test1(type, mpi_type) \ + const_test(type, mpi_type, MPI_BOR, (rank & 0x3), ((size < 3) ? size - 1 : 0x3), 0) +#define bxor_test1(type, mpi_type) \ + const_test(type, mpi_type, MPI_BXOR, (rank == 1) * 0xf0, (size > 1) * 0xf0, 0) +#define bxor_test2(type, mpi_type) \ + const_test(type, mpi_type, MPI_BXOR, 0, 0, 0) +#define bxor_test3(type, mpi_type) \ + const_test(type, mpi_type, MPI_BXOR, ~0, (size &0x1) ? ~0 : 0, 0) + +#define band_test1(type, mpi_type) \ + { \ + DECL_MALLOC_IN_OUT_SOL(type); \ + if (rank == size-1) { \ + SET_INDEX_SUM(in, 0); \ + } \ + else { \ + SET_INDEX_CONST(in, ~0); \ + } \ + SET_INDEX_SUM(sol, 0); \ + SET_INDEX_CONST(out, 0); \ + ALLREDUCE_AND_FREE(mpi_type, MPI_BAND, in, out, sol); \ + } + +#define band_test2(type, mpi_type) \ + { \ + DECL_MALLOC_IN_OUT_SOL(type); \ + if (rank == size-1) { \ + SET_INDEX_SUM(in, 0); \ + } \ + else { \ + SET_INDEX_CONST(in, 0); \ + } \ + SET_INDEX_CONST(sol, 0); \ + SET_INDEX_CONST(out, 0); \ + ALLREDUCE_AND_FREE(mpi_type, MPI_BAND, in, out, sol); \ + } + +#define maxloc_test(type, mpi_type) \ + { \ + DECL_MALLOC_IN_OUT_SOL(type); \ + SET_INDEX_STRUCT_SUM(in, rank, a); \ + SET_INDEX_STRUCT_CONST(in, rank, b); \ + SET_INDEX_STRUCT_SUM(sol, size - 1, a); \ + SET_INDEX_STRUCT_CONST(sol, size - 1, b); \ + SET_INDEX_STRUCT_CONST(out, 0, a); \ + SET_INDEX_STRUCT_CONST(out, -1, b); \ + STRUCT_ALLREDUCE_AND_FREE(mpi_type, MPI_MAXLOC, in, out, sol); \ + } + +#define minloc_test(type, mpi_type) \ + { \ + DECL_MALLOC_IN_OUT_SOL(type); \ + SET_INDEX_STRUCT_SUM(in, rank, a); \ + SET_INDEX_STRUCT_CONST(in, rank, b); \ + SET_INDEX_STRUCT_SUM(sol, 0, a); \ + SET_INDEX_STRUCT_CONST(sol, 0, b); \ + SET_INDEX_STRUCT_CONST(out, 0, a); \ + SET_INDEX_STRUCT_CONST(out, -1, b); \ + STRUCT_ALLREDUCE_AND_FREE(mpi_type, MPI_MINLOC, in, out, sol); \ + } + +#if MTEST_HAVE_MIN_MPI_VERSION(2,2) +#define test_types_set_mpi_2_2_integer(op,post) do { \ + op##_test##post(int8_t, MPI_INT8_T); \ + op##_test##post(int16_t, MPI_INT16_T); \ + op##_test##post(int32_t, MPI_INT32_T); \ + op##_test##post(int64_t, MPI_INT64_T); \ + op##_test##post(uint8_t, MPI_UINT8_T); \ + op##_test##post(uint16_t, MPI_UINT16_T); \ + op##_test##post(uint32_t, MPI_UINT32_T); \ + op##_test##post(uint64_t, MPI_UINT64_T); \ + op##_test##post(MPI_Aint, MPI_AINT); \ + op##_test##post(MPI_Offset, MPI_OFFSET); \ + } while (0) +#else +#define test_types_set_mpi_2_2_integer(op,post) do { } while (0) +#endif + +#if MTEST_HAVE_MIN_MPI_VERSION(3,0) +#define test_types_set_mpi_3_0_integer(op,post) do { \ + op##_test##post(MPI_Count, MPI_COUNT); \ + } while (0) +#else +#define test_types_set_mpi_3_0_integer(op,post) do { } while (0) +#endif + +#define test_types_set1(op, post) \ + { \ + op##_test##post(int, MPI_INT); \ + op##_test##post(long, MPI_LONG); \ + op##_test##post(short, MPI_SHORT); \ + op##_test##post(unsigned short, MPI_UNSIGNED_SHORT); \ + op##_test##post(unsigned, MPI_UNSIGNED); \ + op##_test##post(unsigned long, MPI_UNSIGNED_LONG); \ + op##_test##post(unsigned char, MPI_UNSIGNED_CHAR); \ + test_types_set_mpi_2_2_integer(op,post); \ + test_types_set_mpi_3_0_integer(op,post); \ + } + +#define test_types_set2(op, post) \ + { \ + test_types_set1(op, post); \ + op##_test##post(float, MPI_FLOAT); \ + op##_test##post(double, MPI_DOUBLE); \ + } + +#define test_types_set3(op, post) \ + { \ + op##_test##post(unsigned char, MPI_BYTE); \ + } + +/* Make sure that we test complex and double complex, even if long + double complex is not available */ +#if defined(USE_LONG_DOUBLE_COMPLEX) + +#if MTEST_HAVE_MIN_MPI_VERSION(2,2) && defined(HAVE_FLOAT__COMPLEX) \ + && defined(HAVE_DOUBLE__COMPLEX) \ + && defined(HAVE_LONG_DOUBLE__COMPLEX) +#define test_types_set4(op, post) \ + do { \ + op##_test##post(float _Complex, MPI_C_FLOAT_COMPLEX); \ + op##_test##post(double _Complex, MPI_C_DOUBLE_COMPLEX); \ + if (MPI_C_LONG_DOUBLE_COMPLEX != MPI_DATATYPE_NULL) { \ + op##_test##post(long double _Complex, MPI_C_LONG_DOUBLE_COMPLEX); \ + } \ + } while (0) + +#else +#define test_types_set4(op, post) do { } while (0) +#endif +#else + +#if MTEST_HAVE_MIN_MPI_VERSION(2,2) && defined(HAVE_FLOAT__COMPLEX) \ + && defined(HAVE_DOUBLE__COMPLEX) +#define test_types_set4(op, post) \ + do { \ + op##_test##post(float _Complex, MPI_C_FLOAT_COMPLEX); \ + op##_test##post(double _Complex, MPI_C_DOUBLE_COMPLEX); \ + } while (0) + +#else +#define test_types_set4(op, post) do { } while (0) +#endif + +#endif /* defined(USE_LONG_DOUBLE_COMPLEX) */ + +#if MTEST_HAVE_MIN_MPI_VERSION(2,2) && defined(HAVE__BOOL) +#define test_types_set5(op, post) \ + do { \ + op##_test##post(_Bool, MPI_C_BOOL); \ + } while (0) + +#else +#define test_types_set5(op, post) do { } while (0) +#endif + +int main( int argc, char **argv ) +{ + MTest_Init( &argc, &argv ); + + MPI_Comm_size(MPI_COMM_WORLD, &size); + MPI_Comm_rank(MPI_COMM_WORLD, &rank); + + if (size < 2) { + fprintf( stderr, "At least 2 processes required\n" ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + + /* Set errors return so that we can provide better information + should a routine reject one of the operand/datatype pairs */ + MPI_Errhandler_set( MPI_COMM_WORLD, MPI_ERRORS_RETURN ); + + count = 10; + /* Allow an argument to override the count. + Note that the product tests may fail if the count is very large. + */ + if (argc >= 2) { + count = atoi( argv[1] ); + if (count <= 0) { + fprintf( stderr, "Invalid count argument %s\n", argv[1] ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + } + + test_types_set2(sum, 1); + test_types_set2(prod, 1); + test_types_set2(max, 1); + test_types_set2(min, 1); + + test_types_set1(lor, 1); + test_types_set1(lor, 2); + + test_types_set1(lxor, 1); + test_types_set1(lxor, 2); + test_types_set1(lxor, 3); + + test_types_set1(land, 1); + test_types_set1(land, 2); + + test_types_set1(bor, 1); + test_types_set1(band, 1); + test_types_set1(band, 2); + + test_types_set1(bxor, 1); + test_types_set1(bxor, 2); + test_types_set1(bxor, 3); + + test_types_set3(bor, 1); + test_types_set3(band, 1); + test_types_set3(band, 2); + + test_types_set3(bxor, 1); + test_types_set3(bxor, 2); + test_types_set3(bxor, 3); + + test_types_set4(sum, 1); + test_types_set4(prod, 1); + + test_types_set5(lor, 1); + test_types_set5(lor, 2); + test_types_set5(lxor, 1); + test_types_set5(lxor, 2); + test_types_set5(lxor, 3); + test_types_set5(land, 1); + test_types_set5(land, 2); + + maxloc_test(struct int_test, MPI_2INT); + maxloc_test(struct long_test, MPI_LONG_INT); + maxloc_test(struct short_test, MPI_SHORT_INT); + maxloc_test(struct float_test, MPI_FLOAT_INT); + maxloc_test(struct double_test, MPI_DOUBLE_INT); + + minloc_test(struct int_test, MPI_2INT); + minloc_test(struct long_test, MPI_LONG_INT); + minloc_test(struct short_test, MPI_SHORT_INT); + minloc_test(struct float_test, MPI_FLOAT_INT); + minloc_test(struct double_test, MPI_DOUBLE_INT); + + MPI_Errhandler_set( MPI_COMM_WORLD, MPI_ERRORS_ARE_FATAL ); + MTest_Finalize( cerrcnt ); + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/coll/allred2.c b/teshsuite/smpi/mpich3-test/coll/allred2.c new file mode 100644 index 0000000000..f33b245a09 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/coll/allred2.c @@ -0,0 +1,55 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2003 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include "mpi.h" +#include +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Test MPI_Allreduce with MPI_IN_PLACE"; +*/ + +int main( int argc, char *argv[] ) +{ + int errs = 0; + int rank, size; + int minsize = 2, count; + MPI_Comm comm; + int *buf, i; + + MTest_Init( &argc, &argv ); + + while (MTestGetIntracommGeneral( &comm, minsize, 1 )) { + if (comm == MPI_COMM_NULL) continue; + MPI_Comm_size( comm, &size ); + MPI_Comm_rank( comm, &rank ); + + for (count = 1; count < 65000; count = count * 2) { + /* Contiguous data */ + buf = (int *)malloc( count * sizeof(int) ); + for (i=0; i +#include +#include "mpitest.h" +#include + +/* +static char MTEST_Descrip[] = "Test MPI_Allreduce with non-commutative user-defined operations"; +*/ + +/* We make the error count global so that we can easily control the output + of error information (in particular, limiting it after the first 10 + errors */ +int errs = 0; + +/* This implements a simple matrix-matrix multiply. This is an associative + but not commutative operation. The matrix size is set in matSize; + the number of matrices is the count argument. The matrix is stored + in C order, so that + c(i,j) is cin[j+i*matSize] + */ +#define MAXCOL 256 +static int matSize = 0; /* Must be < MAXCOL */ +static int max_offset = 0; +void uop( void *, void *, int *, MPI_Datatype * ); +void uop( void *cinPtr, void *coutPtr, int *count, MPI_Datatype *dtype ) +{ + const int *cin = (const int *)cinPtr; + int *cout = (int *)coutPtr; + int i, j, k, nmat; + int tempcol[MAXCOL]; + int offset1, offset2; + int matsize2 = matSize*matSize; + + for (nmat = 0; nmat < *count; nmat++) { + for (j=0; j +#include +#include "mpitest.h" +#include + +/* +static char MTEST_Descrip[] = "Test MPI_Allreduce with non-commutative user-defined operations using matrix rotations"; +*/ + +/* This example is similar to allred3.c, but uses only 3x3 matrics with + integer-valued entries. This is an associative but not commutative + operation. + The number of matrices is the count argument. The matrix is stored + in C order, so that + c(i,j) is cin[j+i*3] + + Three different matrices are used: + I = identity matrix + A = (1 0 0 B = (0 1 0 + 0 0 1 1 0 0 + 0 1 0) 0 0 1) + + The product + + I^k A I^(p-2-k-j) B I^j + + is + + ( 0 1 0 + 0 0 1 + 1 0 0 ) + + for all values of k, p, and j. + */ + +void matmult( void *cinPtr, void *coutPtr, int *count, MPI_Datatype *dtype ); + +void matmult( void *cinPtr, void *coutPtr, int *count, MPI_Datatype *dtype ) +{ + const int *cin = (const int *)cinPtr; + int *cout = (int *)coutPtr; + int i, j, k, nmat; + int tempcol[3]; + int offset1, offset2; + + for (nmat = 0; nmat < *count; nmat++) { + for (j=0; j<3; j++) { + for (i=0; i<3; i++) { + tempcol[i] = 0; + for (k=0; k<3; k++) { + /* col[i] += cin(i,k) * cout(k,j) */ + offset1 = k+i*3; + offset2 = j+k*3; + tempcol[i] += cin[offset1] * cout[offset2]; + } + } + for (i=0; i<3; i++) { + offset1 = j+i*3; + cout[offset1] = tempcol[i]; + } + } + /* Advance to the next matrix */ + cin += 9; + cout += 9; + } +} + +/* Initialize the integer matrix as one of the + above matrix entries, as a function of count. + We guarantee that both the A and B matrices are included. +*/ +static void initMat( int rank, int size, int nmat, int mat[] ) +{ + int i, kind; + + /* Zero the matrix */ + for (i=0; i<9; i++) { + mat[i] = 0; + } + + /* Decide which matrix to create (I, A, or B) */ + if ( size == 2) { + /* rank 0 is A, 1 is B */ + kind = 1 + rank; + } + else { + int tmpA, tmpB; + /* Most ranks are identity matrices */ + kind = 0; + /* Make sure exactly one rank gets the A matrix + and one the B matrix */ + tmpA = size / 4; + tmpB = (3 * size) / 4; + + if (rank == tmpA) kind = 1; + if (rank == tmpB) kind = 2; + } + + switch (kind) { + case 0: /* Identity */ + mat[0] = 1; + mat[4] = 1; + mat[8] = 1; + break; + case 1: /* A */ + mat[0] = 1; + mat[5] = 1; + mat[7] = 1; + break; + case 2: /* B */ + mat[1] = 1; + mat[3] = 1; + mat[8] = 1; + break; + } +} + +/* Compare a matrix with the known result */ +static int checkResult( int nmat, int mat[], const char *msg ) +{ + int n, k, errs = 0, wrank; + static int solution[9] = { 0, 1, 0, + 0, 0, 1, + 1, 0, 0 }; + + MPI_Comm_rank( MPI_COMM_WORLD, &wrank ); + + for (n=0; n +#include +#include "mpitest.h" +#include + +/* +static char MTEST_Descrip[] = "Test MPI_Allreduce with count greater than the number of processes"; +*/ + +/* We make the error count global so that we can easily control the output + of error information (in particular, limiting it after the first 10 + errors */ +int errs = 0; + +int main( int argc, char *argv[] ) +{ + MPI_Comm comm; + MPI_Datatype dtype; + int count, *bufin, *bufout, size, i, minsize=1; + + MTest_Init( &argc, &argv ); + + while (MTestGetIntracommGeneral( &comm, minsize, 1 )) { + if (comm == MPI_COMM_NULL) { + continue; + } + MPI_Comm_size( comm, &size ); + count = size * 2; + bufin = (int *)malloc( count * sizeof(int) ); + bufout = (int *)malloc( count * sizeof(int) ); + if (!bufin || !bufout) { + fprintf( stderr, "Unable to allocated space for buffers (%d)\n", + count ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + for (i=0; i +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Test MPI_Allreduce with apparent non-commutative operators"; +*/ +/* While the operator is in fact commutative, this forces the MPI code to + run the code that is used for non-commutative operators, and for + various message lengths. Other tests check truly non-commutative + operators */ + +void mysum( void *cinPtr, void *coutPtr, int *count, MPI_Datatype *dtype ); + +void mysum( void *cinPtr, void *coutPtr, int *count, MPI_Datatype *dtype ) +{ + const int *cin = (const int *)cinPtr; + int *cout = (int *)coutPtr; + int i, n = *count; + for (i=0; i +#include "mpi.h" + +/* + * This example should be run with 2 processes and tests the ability of the + * implementation to handle a flood of one-way messages. + */ + +int main( int argc, char **argv ) +{ + double wscale = 10.0, scale; + int numprocs, myid,i; + + MPI_Init(&argc,&argv); + MPI_Comm_size(MPI_COMM_WORLD,&numprocs); + MPI_Comm_rank(MPI_COMM_WORLD,&myid); + + for ( i=0; i<10000; i++) { + MPI_Allreduce(&wscale,&scale,1,MPI_DOUBLE,MPI_SUM,MPI_COMM_WORLD); + } + + if (myid == 0) { + /* If we get here at all, we're ok */ + printf( " No Errors\n" ); + } + MPI_Finalize(); + + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/coll/alltoall1.c b/teshsuite/smpi/mpich3-test/coll/alltoall1.c new file mode 100644 index 0000000000..cd6d3d8681 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/coll/alltoall1.c @@ -0,0 +1,121 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2003 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include "mpi.h" +#include +#include "mpitest.h" +#include + +/* +static char MTEST_Descrip[] = ""; +*/ + +int main( int argc, char *argv[] ) +{ + int errs = 0; + int rank, size; + int minsize = 2, count; + MPI_Comm comm; + int *sendbuf, *recvbuf, *p; + int sendcount, recvcount; + int i, j; + MPI_Datatype sendtype, recvtype; + + MTest_Init( &argc, &argv ); + + /* The following illustrates the use of the routines to + run through a selection of communicators and datatypes. + Use subsets of these for tests that do not involve combinations + of communicators, datatypes, and counts of datatypes */ + while (MTestGetIntracommGeneral( &comm, minsize, 1 )) { + if (comm == MPI_COMM_NULL) continue; + + /* Determine the sender and receiver */ + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + + /* printf( "Size of comm = %d\n", size ); */ + for (count = 1; count < 65000; count = count * 2) { + + /* Create a send buf and a receive buf suitable for testing + all to all. */ + sendcount = count; + recvcount = count; + sendbuf = (int *)malloc( count * size * sizeof(int) ); + recvbuf = (int *)malloc( count * size * sizeof(int) ); + sendtype = MPI_INT; + recvtype = MPI_INT; + + if (!sendbuf || !recvbuf) { + errs++; + fprintf( stderr, "Failed to allocate sendbuf and/or recvbuf\n" ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + for (i=0; i +#include +#include + +/* + This program tests MPI_Alltoallv by having processor i send different + amounts of data to each processor. + + Because there are separate send and receive types to alltoallv, + there need to be tests to rearrange data on the fly. Not done yet. + + The first test sends i items to processor i from all processors. + + Currently, the test uses only MPI_INT; this is adequate for testing systems + that use point-to-point operations + */ + +int main( int argc, char **argv ) +{ + + MPI_Comm comm; + int *sbuf, *rbuf; + int rank, size; + int *sendcounts, *recvcounts, *rdispls, *sdispls; + int i, j, *p, err; + + MTest_Init( &argc, &argv ); + err = 0; + + while (MTestGetIntracommGeneral( &comm, 2, 1 )) { + if (comm == MPI_COMM_NULL) continue; + + /* Create the buffer */ + MPI_Comm_size( comm, &size ); + MPI_Comm_rank( comm, &rank ); + sbuf = (int *)malloc( size * size * sizeof(int) ); + rbuf = (int *)malloc( size * size * sizeof(int) ); + if (!sbuf || !rbuf) { + fprintf( stderr, "Could not allocated buffers!\n" ); + MPI_Abort( comm, 1 ); + } + + /* Load up the buffers */ + for (i=0; i +#include + +/* + This program tests MPI_Alltoallv by having processor each process + send data to two neighbors only, using counts of 0 for the other processes. + This idiom is sometimes used for halo exchange operations. + + Because there are separate send and receive types to alltoallv, + there need to be tests to rearrange data on the fly. Not done yet. + + Currently, the test uses only MPI_INT; this is adequate for testing systems + that use point-to-point operations + */ + +int main( int argc, char **argv ) +{ + + MPI_Comm comm; + int *sbuf, *rbuf; + int rank, size; + int *sendcounts, *recvcounts, *rdispls, *sdispls; + int i, *p, err; + int left, right, length; + + MTest_Init( &argc, &argv ); + err = 0; + + while (MTestGetIntracommGeneral( &comm, 2, 1 )) { + if (comm == MPI_COMM_NULL) continue; + + MPI_Comm_size( comm, &size ); + MPI_Comm_rank( comm, &rank ); + + if (size < 3) continue; + + /* Create and load the arguments to alltoallv */ + sendcounts = (int *)malloc( size * sizeof(int) ); + recvcounts = (int *)malloc( size * sizeof(int) ); + rdispls = (int *)malloc( size * sizeof(int) ); + sdispls = (int *)malloc( size * sizeof(int) ); + if (!sendcounts || !recvcounts || !rdispls || !sdispls) { + fprintf( stderr, "Could not allocate arg items!\n" ); + MPI_Abort( comm, 1 ); + } + + /* Get the neighbors */ + left = (rank - 1 + size) % size; + right = (rank + 1) % size; + + /* Set the defaults */ + for (i=0; i +#include + +#define MAX_SIZE 64 + +MPI_Datatype transpose_type(int M, int m, int n, MPI_Datatype type); +MPI_Datatype submatrix_type(int N, int m, int n, MPI_Datatype type); +void Transpose(float *localA, float *localB, int M, int N, MPI_Comm comm); +void Transpose(float *localA, float *localB, int M, int N, MPI_Comm comm) +/* transpose MxN matrix A that is block distributed (1-D) on + processes of comm onto block distributed matrix B */ +{ + int i, j, extent, myrank, p, n[2], m[2]; + int lasti, lastj; + int *sendcounts, *recvcounts; + int *sdispls, *rdispls; + MPI_Datatype xtype[2][2], stype[2][2], *sendtypes, *recvtypes; + + MTestPrintfMsg( 2, "M = %d, N = %d\n", M, N ); + + /* compute parameters */ + MPI_Comm_size(comm, &p); + MPI_Comm_rank(comm, &myrank); + extent = sizeof(float); + + /* allocate arrays */ + sendcounts = (int *)malloc(p*sizeof(int)); + recvcounts = (int *)malloc(p*sizeof(int)); + sdispls = (int *)malloc(p*sizeof(int)); + rdispls = (int *)malloc(p*sizeof(int)); + sendtypes = (MPI_Datatype *)malloc(p*sizeof(MPI_Datatype)); + recvtypes = (MPI_Datatype *)malloc(p*sizeof(MPI_Datatype)); + + /* compute block sizes */ + m[0] = M/p; + m[1] = M - (p-1)*(M/p); + n[0] = N/p; + n[1] = N - (p-1)*(N/p); + + /* compute types */ + for (i=0; i <= 1; i++) + for (j=0; j <= 1; j++) { + xtype[i][j] = transpose_type(N, m[i], n[j], MPI_FLOAT); + stype[i][j] = submatrix_type(M, m[i], n[j], MPI_FLOAT); + } + + /* prepare collective operation arguments */ + lasti = myrank == p-1; + for (j=0; j < p; j++) { + lastj = j == p-1; + sendcounts[j] = 1; + sdispls[j] = j*n[0]*extent; + sendtypes[j] = xtype[lasti][lastj]; + recvcounts[j] = 1; + rdispls[j] = j*m[0]*extent; + recvtypes[j] = stype[lastj][lasti]; + } + + /* communicate */ + MTestPrintfMsg( 2, "Begin Alltoallw...\n" ); + /* -- Note that the book incorrectly uses &localA and &localB + as arguments to MPI_Alltoallw */ + MPI_Alltoallw(localA, sendcounts, sdispls, sendtypes, + localB, recvcounts, rdispls, recvtypes, comm); + MTestPrintfMsg( 2, "Done with Alltoallw\n" ); + + /* Free buffers */ + free( sendcounts ); + free( recvcounts ); + free( sdispls ); + free( rdispls ); + free( sendtypes ); + free( recvtypes ); + + /* Free datatypes */ + for (i=0; i <= 1; i++) + for (j=0; j <= 1; j++) { + MPI_Type_free( &xtype[i][j] ); + MPI_Type_free( &stype[i][j] ); + } +} + + +/* Define an n x m submatrix in a n x M local matrix (this is the + destination in the transpose matrix */ +MPI_Datatype submatrix_type(int M, int m, int n, MPI_Datatype type) +/* computes a datatype for an mxn submatrix within an MxN matrix + with entries of type type */ +{ + /* MPI_Datatype subrow; */ + MPI_Datatype submatrix; + + /* The book, MPI: The Complete Reference, has the wrong type constructor + here. Since the stride in the vector type is relative to the input + type, the stride in the book's code is n times as long as is intended. + Since n may not exactly divide N, it is better to simply use the + blocklength argument in Type_vector */ + /* + MPI_Type_contiguous(n, type, &subrow); + MPI_Type_vector(m, 1, N, subrow, &submatrix); + */ + MPI_Type_vector(n, m, M, type, &submatrix ); + MPI_Type_commit(&submatrix); + + /* Add a consistency test: the size of submatrix should be + n * m * sizeof(type) and the extent should be ((n-1)*M+m) * sizeof(type) */ + { + int tsize; + MPI_Aint textent, lb; + MPI_Type_size( type, &tsize ); + MPI_Type_get_extent( submatrix, &lb, &textent ); + + if (textent != tsize * (M * (n-1)+m)) { + fprintf( stderr, "Submatrix extent is %ld, expected %ld (%d,%d,%d)\n", + (long)textent, (long)(tsize * (M * (n-1)+m)), M, n, m ); + } + } + return(submatrix); +} + +/* Extract an m x n submatrix within an m x N matrix and transpose it. + Assume storage by rows; the defined datatype accesses by columns */ +MPI_Datatype transpose_type(int N, int m, int n, MPI_Datatype type) +/* computes a datatype for the transpose of an mxn matrix + with entries of type type */ +{ + MPI_Datatype subrow, subrow1, submatrix; + MPI_Aint lb, extent; + + MPI_Type_vector(m, 1, N, type, &subrow); + MPI_Type_get_extent(type, &lb, &extent); + MPI_Type_create_resized(subrow, 0, extent, &subrow1); + MPI_Type_contiguous(n, subrow1, &submatrix); + MPI_Type_commit(&submatrix); + MPI_Type_free( &subrow ); + MPI_Type_free( &subrow1 ); + + /* Add a consistency test: the size of submatrix should be + n * m * sizeof(type) and the extent should be ((m-1)*N+n) * sizeof(type) */ + { + int tsize; + MPI_Aint textent, llb; + MPI_Type_size( type, &tsize ); + MPI_Type_get_true_extent( submatrix, &llb, &textent ); + + if (textent != tsize * (N * (m-1)+n)) { + fprintf( stderr, "Transpose Submatrix extent is %ld, expected %ld (%d,%d,%d)\n", + (long)textent, (long)(tsize * (N * (m-1)+n)), N, n, m ); + } + } + + return(submatrix); +} + +/* -- CUT HERE -- */ + +int main( int argc, char *argv[] ) +{ + int gM, gN, lm, lmlast, ln, lnlast, i, j, errs = 0; + int size, rank; + float *localA, *localB; + MPI_Comm comm; + + MTest_Init( &argc, &argv ); + comm = MPI_COMM_WORLD; + + MPI_Comm_size( comm, &size ); + MPI_Comm_rank( comm, &rank ); + + gM = 20; + gN = 30; + + /* Each block is lm x ln in size, except for the last process, + which has lmlast x lnlast */ + lm = gM/size; + lmlast = gM - (size - 1)*lm; + ln = gN/size; + lnlast = gN - (size - 1)*ln; + + /* Create the local matrices. + Initialize the input matrix so that the entries are + consequtive integers, by row, starting at 0. + */ + if (rank == size - 1) { + localA = (float *)malloc( gN * lmlast * sizeof(float) ); + localB = (float *)malloc( gM * lnlast * sizeof(float) ); + for (i=0; i +#include +#include + +/* + This program tests MPI_Alltoallw by having processor i send different + amounts of data to each processor. This is just the MPI_Alltoallv test, + but with displacements in bytes rather than units of the datatype. + + Because there are separate send and receive types to alltoallw, + there need to be tests to rearrange data on the fly. Not done yet. + + The first test sends i items to processor i from all processors. + + Currently, the test uses only MPI_INT; this is adequate for testing systems + that use point-to-point operations + */ + +int main( int argc, char **argv ) +{ + + MPI_Comm comm; + int *sbuf, *rbuf; + int rank, size; + int *sendcounts, *recvcounts, *rdispls, *sdispls; + int i, j, *p, err; + MPI_Datatype *sendtypes, *recvtypes; + + MTest_Init( &argc, &argv ); + err = 0; + + while (MTestGetIntracommGeneral( &comm, 2, 1 )) { + if (comm == MPI_COMM_NULL) continue; + + /* Create the buffer */ + MPI_Comm_size( comm, &size ); + MPI_Comm_rank( comm, &rank ); + sbuf = (int *)malloc( size * size * sizeof(int) ); + rbuf = (int *)malloc( size * size * sizeof(int) ); + if (!sbuf || !rbuf) { + fprintf( stderr, "Could not allocated buffers!\n" ); + MPI_Abort( comm, 1 ); + } + + /* Load up the buffers */ + for (i=0; i +#include + +#include + +#include "mpitest.h" + +int main(int argc, char *argv[]) +{ + int sendbuf, recvbuf; + int *sendcounts; + int *recvcounts; + int *sdispls; + int *rdispls; + MPI_Datatype sendtype; + MPI_Datatype *sendtypes; + MPI_Datatype *recvtypes; + int rank = -1; + int size = -1; + int i; + + + MPI_Init(&argc, &argv); + + MPI_Comm_size(MPI_COMM_WORLD, &size); + MPI_Comm_rank(MPI_COMM_WORLD, &rank); + + sendtypes = malloc(size * sizeof(MPI_Datatype)); + recvtypes = malloc(size * sizeof(MPI_Datatype)); + sendcounts = malloc(size * sizeof(int)); + recvcounts = malloc(size * sizeof(int)); + sdispls = malloc(size * sizeof(int)); + rdispls = malloc(size * sizeof(int)); + if (!sendtypes || !recvtypes || + !sendcounts || !recvcounts || + !sdispls || !rdispls) + { + printf("error, unable to allocate memory\n"); + goto fn_exit; + } + + MPI_Type_contiguous(0, MPI_INT, &sendtype); + MPI_Type_commit(&sendtype); + + for (i = 0; i < size; ++i) { + sendtypes[i] = sendtype; + sendcounts[i] = 1; + sdispls[i] = 0; + + recvtypes[i] = MPI_INT; + recvcounts[i] = 0; + rdispls[i] = 0; + } + + + /* try zero-counts on both the send and recv side in case only one direction is broken for some reason */ + MPI_Alltoallw(&sendbuf, sendcounts, sdispls, sendtypes, &recvbuf, recvcounts, rdispls, recvtypes, MPI_COMM_WORLD); + MPI_Alltoallw(&sendbuf, recvcounts, rdispls, recvtypes, &recvbuf, sendcounts, sdispls, sendtypes, MPI_COMM_WORLD); + +#if MTEST_HAVE_MIN_MPI_VERSION(2,2) + /* pass MPI_IN_PLACE and different but compatible types rank is even/odd */ + if (rank % 2) + MPI_Alltoallw(MPI_IN_PLACE, NULL, NULL, NULL, &recvbuf, recvcounts, rdispls, recvtypes, MPI_COMM_WORLD); + else + MPI_Alltoallw(MPI_IN_PLACE, NULL, NULL, NULL, &recvbuf, sendcounts, sdispls, sendtypes, MPI_COMM_WORLD); +#endif + + /* now the same for Alltoallv instead of Alltoallw */ + MPI_Alltoallv(&sendbuf, sendcounts, sdispls, sendtypes[0], &recvbuf, recvcounts, rdispls, recvtypes[0], MPI_COMM_WORLD); + MPI_Alltoallv(&sendbuf, recvcounts, rdispls, recvtypes[0], &recvbuf, sendcounts, sdispls, sendtypes[0], MPI_COMM_WORLD); + +#if MTEST_HAVE_MIN_MPI_VERSION(2,2) + if (rank % 2) + MPI_Alltoallv(MPI_IN_PLACE, NULL, NULL, MPI_DATATYPE_NULL, &recvbuf, recvcounts, rdispls, recvtypes[0], MPI_COMM_WORLD); + else + MPI_Alltoallv(MPI_IN_PLACE, NULL, NULL, MPI_DATATYPE_NULL, &recvbuf, sendcounts, sdispls, sendtypes[0], MPI_COMM_WORLD); +#endif + + MPI_Type_free(&sendtype); + + if (rank == 0) + printf(" No Errors\n"); + +fn_exit: + if (rdispls) free(rdispls); + if (sdispls) free(sdispls); + if (recvcounts) free(recvcounts); + if (sendcounts) free(sendcounts); + if (recvtypes) free(recvtypes); + if (sendtypes) free(sendtypes); + + MPI_Finalize(); + + return 0; +} + diff --git a/teshsuite/smpi/mpich3-test/coll/bcast2.c b/teshsuite/smpi/mpich3-test/coll/bcast2.c new file mode 100644 index 0000000000..b2c2f79f74 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/coll/bcast2.c @@ -0,0 +1,81 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2003 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include "mpi.h" +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Test of broadcast with various roots and datatypes"; +*/ + +int main( int argc, char *argv[] ) +{ + int errs = 0, err; + int rank, size, root; + int minsize = 2, count; + MPI_Comm comm; + MTestDatatype sendtype, recvtype; + + MTest_Init( &argc, &argv ); + + /* The following illustrates the use of the routines to + run through a selection of communicators and datatypes. + Use subsets of these for tests that do not involve combinations + of communicators, datatypes, and counts of datatypes */ + while (MTestGetIntracommGeneral( &comm, minsize, 1 )) { + if (comm == MPI_COMM_NULL) continue; + + /* Determine the sender and receiver */ + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + + /* To improve reporting of problems about operations, we + change the error handler to errors return */ + MPI_Errhandler_set( comm, MPI_ERRORS_RETURN ); + + /* The max value of count must be very large to ensure that we + reach the long message algorithms */ + for (count = 1; count < 280000; count = count * 4) { + while (MTestGetDatatypes( &sendtype, &recvtype, count )) { + for (root=0; root +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Test of broadcast with various roots and datatypes and sizes that are not powers of two"; +*/ + +int main( int argc, char *argv[] ) +{ + int errs = 0, err; + int rank, size, root; + int minsize = 2, count; + MPI_Comm comm; + MTestDatatype sendtype, recvtype; + + MTest_Init( &argc, &argv ); + + /* The following illustrates the use of the routines to + run through a selection of communicators and datatypes. + Use subsets of these for tests that do not involve combinations + of communicators, datatypes, and counts of datatypes */ + while (MTestGetIntracommGeneral( &comm, minsize, 1 )) { + if (comm == MPI_COMM_NULL) continue; + /* Determine the sender and receiver */ + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + + count = 1; + /* This must be very large to ensure that we reach the long message + algorithms */ + for (count = 4; count < 66000; count = count * 4) { + while (MTestGetDatatypes( &sendtype, &recvtype, count-1 )) { + for (root=0; root +#include +#include +#include "mpitest.h" + +#define ROOT 0 +#define NUM_REPS 5 +#define NUM_SIZES 4 + +int main( int argc, char **argv) +{ + int *buf; + int i, rank, reps, n; + int bVerify = 1; + int sizes[NUM_SIZES] = { 100, 64*1024, 128*1024, 1024*1024 }; + int num_errors=0; + + MTest_Init( &argc, &argv ); + MPI_Comm_rank(MPI_COMM_WORLD, &rank); + + if (argc > 1) + { + if (strcmp(argv[1], "-novalidate") == 0 || strcmp(argv[1], "-noverify") == 0) + bVerify = 0; + } + + buf = (int *) malloc(sizes[NUM_SIZES-1]*sizeof(int)); + memset(buf, 0, sizes[NUM_SIZES-1]*sizeof(int)); + + for (n=0; n= 10) + { + printf("Error: Rank=%d, num_errors = %d\n", rank, num_errors); + fflush(stdout); + } + } + } + } + + free(buf); + + MTest_Finalize( num_errors ); + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/coll/bcastzerotype.c b/teshsuite/smpi/mpich3-test/coll/bcastzerotype.c new file mode 100644 index 0000000000..65a6055273 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/coll/bcastzerotype.c @@ -0,0 +1,51 @@ +#include +#include +#include + +#include + +/* test broadcast behavior with non-zero counts but zero-sized types */ + +int main(int argc, char *argv[]) +{ + int i, type_size; + MPI_Datatype type = MPI_DATATYPE_NULL; + char *buf = NULL; + int wrank, wsize; + + MPI_Init(&argc, &argv); + MPI_Comm_rank(MPI_COMM_WORLD, &wrank); + MPI_Comm_size(MPI_COMM_WORLD, &wsize); + + /* a random non-zero sized buffer */ +#define NELEM (10) + buf = malloc(NELEM*sizeof(int)); + assert(buf); + + for (i = 0; i < NELEM; i++) { + buf[i] = wrank * NELEM + i; + } + + /* create a zero-size type */ + MPI_Type_contiguous(0, MPI_INT, &type); + MPI_Type_commit(&type); + MPI_Type_size(type, &type_size); + assert(type_size == 0); + + /* do the broadcast, which will break on some MPI implementations */ + MPI_Bcast(buf, NELEM, type, 0, MPI_COMM_WORLD); + + /* check that the buffer remains unmolested */ + for (i = 0; i < NELEM; i++) { + assert(buf[i] == wrank * NELEM + i); + } + + MPI_Type_free(&type); + MPI_Finalize(); + + if (wrank == 0) { + printf(" No errors\n"); + } + + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/coll/coll10.c b/teshsuite/smpi/mpich3-test/coll/coll10.c new file mode 100644 index 0000000000..e93abedc59 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/coll/coll10.c @@ -0,0 +1,61 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2001 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include "mpi.h" +#include +#include "mpitest.h" + +#define BAD_ANSWER 100000 + +int assoc ( int *, int *, int *, MPI_Datatype * ); + +/* + The operation is inoutvec[i] = invec[i] op inoutvec[i] + (see 4.9.4). The order is important. + + Note that the computation is in process rank (in the communicator) + order, independant of the root. + */ +int assoc(int *invec, int *inoutvec, int *len, MPI_Datatype *dtype) +{ + int i; + for ( i=0; i<*len; i++ ) { + if (inoutvec[i] <= invec[i] ) { + int rank; + MPI_Comm_rank( MPI_COMM_WORLD, &rank ); + fprintf( stderr, "[%d] inout[0] = %d, in[0] = %d\n", + rank, inoutvec[0], invec[0] ); + inoutvec[i] = BAD_ANSWER; + } + else + inoutvec[i] = invec[i]; + } + return (1); +} + +int main( int argc, char **argv ) +{ + int rank, size; + int data; + int errors=0; + int result = -100; + MPI_Op op; + + MTest_Init( &argc, &argv ); + MPI_Comm_rank( MPI_COMM_WORLD, &rank ); + MPI_Comm_size( MPI_COMM_WORLD, &size ); + + data = rank; + + MPI_Op_create( (MPI_User_function*)assoc, 0, &op ); + MPI_Reduce ( &data, &result, 1, MPI_INT, op, size-1, MPI_COMM_WORLD ); + MPI_Bcast ( &result, 1, MPI_INT, size-1, MPI_COMM_WORLD ); + MPI_Op_free( &op ); + if (result == BAD_ANSWER) errors++; + + MTest_Finalize( errors ); + MPI_Finalize(); + return MTestReturnValue( errors ); +} diff --git a/teshsuite/smpi/mpich3-test/coll/coll11.c b/teshsuite/smpi/mpich3-test/coll/coll11.c new file mode 100644 index 0000000000..9b5ddda888 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/coll/coll11.c @@ -0,0 +1,108 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2001 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include "mpi.h" +#include +#include "mpitest.h" + +void addem ( int *, int *, int *, MPI_Datatype * ); +void assoc ( int *, int *, int *, MPI_Datatype * ); + +void addem(int *invec, int *inoutvec, int *len, MPI_Datatype *dtype) +{ + int i; + for ( i=0; i<*len; i++ ) + inoutvec[i] += invec[i]; +} + +#define BAD_ANSWER 100000 + +/* + The operation is inoutvec[i] = invec[i] op inoutvec[i] + (see 4.9.4). The order is important. + + Note that the computation is in process rank (in the communicator) + order, independant of the root. + */ +void assoc(int *invec, int *inoutvec, int *len, MPI_Datatype *dtype) +{ + int i; + for ( i=0; i<*len; i++ ) { + if (inoutvec[i] <= invec[i] ) { + int rank; + MPI_Comm_rank( MPI_COMM_WORLD, &rank ); + fprintf( stderr, "[%d] inout[0] = %d, in[0] = %d\n", + rank, inoutvec[0], invec[0] ); + inoutvec[i] = BAD_ANSWER; + } + else + inoutvec[i] = invec[i]; + } +} + +int main( int argc, char **argv ) +{ + int rank, size, i; + int data; + int errors=0; + int result = -100; + int correct_result; + MPI_Op op_assoc, op_addem; + + MTest_Init( &argc, &argv ); + MPI_Comm_rank( MPI_COMM_WORLD, &rank ); + MPI_Comm_size( MPI_COMM_WORLD, &size ); + + data = rank; + + correct_result = 0; + for (i=0;i<=rank;i++) + correct_result += i; + + MPI_Scan ( &data, &result, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD ); + if (result != correct_result) { + fprintf( stderr, "[%d] Error suming ints with scan\n", rank ); + errors++; + } + + MPI_Scan ( &data, &result, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD ); + if (result != correct_result) { + fprintf( stderr, "[%d] Error summing ints with scan (2)\n", rank ); + errors++; + } + + data = rank; + result = -100; + MPI_Op_create( (MPI_User_function *)assoc, 0, &op_assoc ); + MPI_Op_create( (MPI_User_function *)addem, 1, &op_addem ); + MPI_Scan ( &data, &result, 1, MPI_INT, op_addem, MPI_COMM_WORLD ); + if (result != correct_result) { + fprintf( stderr, "[%d] Error summing ints with scan (userop)\n", + rank ); + errors++; + } + + MPI_Scan ( &data, &result, 1, MPI_INT, op_addem, MPI_COMM_WORLD ); + if (result != correct_result) { + fprintf( stderr, "[%d] Error summing ints with scan (userop2)\n", + rank ); + errors++; + } + result = -100; + data = rank; + MPI_Scan ( &data, &result, 1, MPI_INT, op_assoc, MPI_COMM_WORLD ); + if (result == BAD_ANSWER) { + fprintf( stderr, "[%d] Error scanning with non-commutative op\n", + rank ); + errors++; + } + + MPI_Op_free( &op_assoc ); + MPI_Op_free( &op_addem ); + + MTest_Finalize( errors ); + MPI_Finalize(); + return MTestReturnValue( errors ); +} diff --git a/teshsuite/smpi/mpich3-test/coll/coll12.c b/teshsuite/smpi/mpich3-test/coll/coll12.c new file mode 100644 index 0000000000..d493a5948f --- /dev/null +++ b/teshsuite/smpi/mpich3-test/coll/coll12.c @@ -0,0 +1,73 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2001 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ + +#include +#include "mpi.h" +#include "mpitest.h" + +#define TABLE_SIZE 2 + +int main( int argc, char **argv ) +{ + int rank, size; + double a[TABLE_SIZE]; + struct { double a; int b; } in[TABLE_SIZE], out[TABLE_SIZE]; + int i; + int errors = 0; + + /* Initialize the environment and some variables */ + MTest_Init( &argc, &argv ); + MPI_Comm_rank( MPI_COMM_WORLD, &rank ); + MPI_Comm_size( MPI_COMM_WORLD, &size ); + + /* Initialize the maxloc data */ + for ( i=0; i +#include +#include "mpitest.h" + +#include +#include +#ifndef EXIT_SUCCESS +#define EXIT_SUCCESS 0 +#define EXIT_FAILURE 1 +#endif + +int main( int argc, char *argv[] ) +{ + int rank, size; + int chunk = 128; + int i; + int *sb; + int *rb; + int status; + + MTest_Init(&argc,&argv); + MPI_Comm_rank(MPI_COMM_WORLD,&rank); + MPI_Comm_size(MPI_COMM_WORLD,&size); + + for ( i=1 ; i < argc ; ++i ) { + if ( argv[i][0] != '-' ) + continue; + switch(argv[i][1]) { + case 'm': + chunk = atoi(argv[++i]); + break; + default: + fprintf(stderr,"Unrecognized argument %s\n", + argv[i]); + MPI_Abort(MPI_COMM_WORLD,EXIT_FAILURE); + } + } + + sb = (int *)malloc(size*chunk*sizeof(int)); + if ( !sb ) { + perror( "can't allocate send buffer" ); + MPI_Abort(MPI_COMM_WORLD,EXIT_FAILURE); + } + rb = (int *)malloc(size*chunk*sizeof(int)); + if ( !rb ) { + perror( "can't allocate recv buffer"); + free(sb); + MPI_Abort(MPI_COMM_WORLD,EXIT_FAILURE); + } + for ( i=0 ; i < size*chunk ; ++i ) { + sb[i] = rank + 1; + rb[i] = 0; + } + + /* fputs("Before MPI_Alltoall\n",stdout); */ + + /* This should really send MPI_CHAR, but since sb and rb were allocated + as chunk*size*sizeof(int), the buffers are large enough */ + status = MPI_Alltoall(sb,chunk,MPI_INT,rb,chunk,MPI_INT, + MPI_COMM_WORLD); + + /* fputs("Before MPI_Allreduce\n",stdout); */ + + MTest_Finalize( status ); + + free(sb); + free(rb); + + MPI_Finalize(); + + return MTestReturnValue( status ); +} + diff --git a/teshsuite/smpi/mpich3-test/coll/coll2.c b/teshsuite/smpi/mpich3-test/coll/coll2.c new file mode 100644 index 0000000000..ae08c96bd7 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/coll/coll2.c @@ -0,0 +1,67 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2001 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include "mpi.h" +#include +#include "mpitest.h" + +#define MAX_PROCESSES 10 + +int main( int argc, char **argv ) +{ + int rank, size, i,j; + int table[MAX_PROCESSES][MAX_PROCESSES]; + int errors=0; + int participants; + + MTest_Init( &argc, &argv ); + MPI_Comm_rank( MPI_COMM_WORLD, &rank ); + MPI_Comm_size( MPI_COMM_WORLD, &size ); + + /* A maximum of MAX_PROCESSES processes can participate */ + if ( size > MAX_PROCESSES ) participants = MAX_PROCESSES; + else participants = size; + + if (MAX_PROCESSES % participants) { + fprintf( stderr, "Number of processors must divide %d\n", + MAX_PROCESSES ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + if ( (rank < participants) ) { + + /* Determine what rows are my responsibility */ + int block_size = MAX_PROCESSES / participants; + int begin_row = rank * block_size; + int end_row = (rank+1) * block_size; + int send_count = block_size * MAX_PROCESSES; + int recv_count = send_count; + + /* Paint my rows my color */ + for (i=begin_row; i +#include "mpitest.h" + +#define MAX_PROCESSES 10 + +int main( int argc, char **argv ) +{ + int rank, size, i,j; + int table[MAX_PROCESSES][MAX_PROCESSES]; + int errors=0; + int participants; + int displs[MAX_PROCESSES]; + int recv_counts[MAX_PROCESSES]; + + MTest_Init( &argc, &argv ); + MPI_Comm_rank( MPI_COMM_WORLD, &rank ); + MPI_Comm_size( MPI_COMM_WORLD, &size ); + + /* A maximum of MAX_PROCESSES processes can participate */ + if ( size > MAX_PROCESSES ) participants = MAX_PROCESSES; + else participants = size; + /* while (MAX_PROCESSES % participants) participants--; */ + if (MAX_PROCESSES % participants) { + fprintf( stderr, "Number of processors must divide %d\n", + MAX_PROCESSES ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + if ( (rank < participants) ) { + + /* Determine what rows are my responsibility */ + int block_size = MAX_PROCESSES / participants; + int begin_row = rank * block_size; + int end_row = (rank+1) * block_size; + int send_count = block_size * MAX_PROCESSES; + + /* Fill in the displacements and recv_counts */ + for (i=0; i +#include "mpitest.h" + +#define MAX_PROCESSES 10 + +int main( int argc, char **argv ) +{ + int rank, size, i,j; + int table[MAX_PROCESSES][MAX_PROCESSES]; + int row[MAX_PROCESSES]; + int errors=0; + int participants; + MPI_Comm comm; + + MTest_Init( &argc, &argv ); + MPI_Comm_rank( MPI_COMM_WORLD, &rank ); + MPI_Comm_size( MPI_COMM_WORLD, &size ); + + comm = MPI_COMM_WORLD; + + /* A maximum of MAX_PROCESSES processes can participate */ + if ( size > MAX_PROCESSES ) { + participants = MAX_PROCESSES; + MPI_Comm_split( MPI_COMM_WORLD, rank < MAX_PROCESSES, rank, &comm ); + } + else { + participants = size; + MPI_Comm_dup( MPI_COMM_WORLD, &comm ); + } + if ( (rank < participants) ) { + int send_count = MAX_PROCESSES; + int recv_count = MAX_PROCESSES; + + /* If I'm the root (process 0), then fill out the big table */ + if (rank == 0) + for ( i=0; i +#include "mpitest.h" + +#define MAX_PROCESSES 10 + +int main( int argc, char **argv ) +{ + int rank, size, i,j; + int table[MAX_PROCESSES][MAX_PROCESSES]; + int row[MAX_PROCESSES]; + int errors=0; + int participants; + int displs[MAX_PROCESSES]; + int send_counts[MAX_PROCESSES]; + + MTest_Init( &argc, &argv ); + MPI_Comm_rank( MPI_COMM_WORLD, &rank ); + MPI_Comm_size( MPI_COMM_WORLD, &size ); + + /* A maximum of MAX_PROCESSES processes can participate */ + if ( size > MAX_PROCESSES ) participants = MAX_PROCESSES; + else participants = size; + if ( (rank < participants) ) { + int recv_count = MAX_PROCESSES; + + /* If I'm the root (process 0), then fill out the big table */ + /* and setup send_counts and displs arrays */ + if (rank == 0) + for ( i=0; i +#include "mpitest.h" + +#define MAX_PROCESSES 10 + +int main( int argc, char **argv ) +{ + int rank, size, i,j; + int table[MAX_PROCESSES][MAX_PROCESSES]; + int errors=0; + int participants; + int displs[MAX_PROCESSES]; + int recv_counts[MAX_PROCESSES]; + MPI_Comm test_comm; + + MTest_Init( &argc, &argv ); + MPI_Comm_rank( MPI_COMM_WORLD, &rank ); + MPI_Comm_size( MPI_COMM_WORLD, &size ); + + /* A maximum of MAX_PROCESSES processes can participate */ + participants = ( size > MAX_PROCESSES ) ? MAX_PROCESSES : size; + + if (MAX_PROCESSES % participants) { + fprintf( stderr, "Number of processors must divide %d\n", + MAX_PROCESSES ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + MPI_Comm_split(MPI_COMM_WORLD, rank +#include "mpitest.h" + +#define MAX_PROCESSES 10 + +int main( int argc, char **argv ) +{ + int rank, size, i,j; + int table[MAX_PROCESSES][MAX_PROCESSES]; + int errors=0; + int participants; + + MTest_Init( &argc, &argv ); + MPI_Comm_rank( MPI_COMM_WORLD, &rank ); + MPI_Comm_size( MPI_COMM_WORLD, &size ); + + /* A maximum of MAX_PROCESSES processes can participate */ + if ( size > MAX_PROCESSES ) participants = MAX_PROCESSES; + else participants = size; + if (MAX_PROCESSES % participants) { + fprintf( stderr, "Number of processors must divide %d\n", + MAX_PROCESSES ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + /* while (MAX_PROCESSES % participants) participants--; */ + if ( (rank < participants) ) { + + /* Determine what rows are my responsibility */ + int block_size = MAX_PROCESSES / participants; + int begin_row = rank * block_size; + int end_row = (rank+1) * block_size; + int send_count = block_size * MAX_PROCESSES; + int recv_count = send_count; + + /* Paint my rows my color */ + for (i=begin_row; i +#include "mpitest.h" + +int main( int argc, char **argv ) +{ + int rank, size, i; + int data; + int errors=0; + int result = -100; + int correct_result; + + MTest_Init( &argc, &argv ); + MPI_Comm_rank( MPI_COMM_WORLD, &rank ); + MPI_Comm_size( MPI_COMM_WORLD, &size ); + + data = rank; + + MPI_Reduce ( &data, &result, 1, MPI_INT, MPI_SUM, 0, MPI_COMM_WORLD ); + MPI_Bcast ( &result, 1, MPI_INT, 0, MPI_COMM_WORLD ); + correct_result = 0; + for(i=0;i +#include "mpitest.h" + +void addem ( int *, int *, int *, MPI_Datatype * ); + +void addem(int *invec, int *inoutvec, int *len, MPI_Datatype *dtype) +{ + int i; + for ( i=0; i<*len; i++ ) + inoutvec[i] += invec[i]; +} + +int main( int argc, char **argv ) +{ + int rank, size, i; + int data; + int errors=0; + int result = -100; + int correct_result; + MPI_Op op; + + MTest_Init( &argc, &argv ); + MPI_Comm_rank( MPI_COMM_WORLD, &rank ); + MPI_Comm_size( MPI_COMM_WORLD, &size ); + + data = rank; + MPI_Op_create( (MPI_User_function *)addem, 1, &op ); + MPI_Reduce ( &data, &result, 1, MPI_INT, op, 0, MPI_COMM_WORLD ); + MPI_Bcast ( &result, 1, MPI_INT, 0, MPI_COMM_WORLD ); + MPI_Op_free( &op ); + correct_result = 0; + for(i=0;i +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Test MPI_Exscan"; +*/ + +int main( int argc, char *argv[] ) +{ + int errs = 0; + int rank, size; + int minsize = 2, count; + int *sendbuf, *recvbuf, i; + MPI_Comm comm; + + MTest_Init( &argc, &argv ); + + /* The following illustrates the use of the routines to + run through a selection of communicators and datatypes. + Use subsets of these for tests that do not involve combinations + of communicators, datatypes, and counts of datatypes */ + while (MTestGetIntracommGeneral( &comm, minsize, 1 )) { + if (comm == MPI_COMM_NULL) continue; + + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + + for (count = 1; count < 65000; count = count * 2) { + + sendbuf = (int *)malloc( count * sizeof(int) ); + recvbuf = (int *)malloc( count * sizeof(int) ); + + for (i=0; i 0) { + int result; + for (i=0; i +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Test MPI_Exscan (simple test)"; +*/ + +int main( int argc, char *argv[] ) +{ + int errs = 0; + int rank, size; + int sendbuf[1], recvbuf[1]; + MPI_Comm comm; + + MTest_Init( &argc, &argv ); + + comm = MPI_COMM_WORLD; + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + + sendbuf[0] = rank; + recvbuf[0] = -2; + + MPI_Exscan( sendbuf, recvbuf, 1, MPI_INT, MPI_SUM, comm ); + + /* Check the results. rank 0 has no data. Input is + 0 1 2 3 4 5 6 7 8 ... + Output is + - 0 1 3 6 10 15 21 28 36 + (scan, not counting the contribution from the calling process) + */ + if (rank > 0) { + int result = (((rank) * (rank-1))/2); + /* printf( "%d: %d\n", rank, result ); */ + if (recvbuf[0] != result) { + errs++; + fprintf( stderr, "Error in recvbuf = %d on %d, expected %d\n", + recvbuf[0], rank, result ); + } + } + else if (recvbuf[0] != -2) { + errs++; + fprintf( stderr, "Error in recvbuf on zero, is %d\n", recvbuf[0] ); + } + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/coll/gather.c b/teshsuite/smpi/mpich3-test/coll/gather.c new file mode 100644 index 0000000000..7433caa465 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/coll/gather.c @@ -0,0 +1,74 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2003 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ + +#include "mpi.h" +#include "mpitest.h" +#include +#include + +/* Gather data from a vector to contiguous */ + +int main( int argc, char **argv ) +{ + MPI_Datatype vec; + MPI_Comm comm; + double *vecin, *vecout; + int minsize = 2, count; + int root, i, n, stride, errs = 0; + int rank, size; + + MTest_Init( &argc, &argv ); + + while (MTestGetIntracommGeneral( &comm, minsize, 1 )) { + if (comm == MPI_COMM_NULL) continue; + /* Determine the sender and receiver */ + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + + for (root=0; root +#include + +/* Gather data from a vector to contiguous. Use IN_PLACE */ + +int main( int argc, char **argv ) +{ + MPI_Datatype vec; + double *vecin, *vecout; + MPI_Comm comm; + int count, minsize = 2; + int root, i, n, stride, errs = 0; + int rank, size; + + MTest_Init( &argc, &argv ); + + while (MTestGetIntracommGeneral( &comm, minsize, 1 )) { + if (comm == MPI_COMM_NULL) continue; + /* Determine the sender and receiver */ + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + + for (root=0; root +#include + +/* Gather data from a vector to contiguous. Use IN_PLACE */ + +int main( int argc, char **argv ) +{ + MPI_Datatype vec; + double *vecin, *vecout; + MPI_Comm comm; + int count, minsize = 2; + int root, i, n, stride, errs = 0; + int rank, size; + + MTest_Init( &argc, &argv ); + + while (MTestGetIntracommGeneral( &comm, minsize, 1 )) { + if (comm == MPI_COMM_NULL) continue; + /* Determine the sender and receiver */ + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + + for (root=0; root +#include +#include "mpi.h" +#include "mpitest.h" + +/* Since MPICH is currently the only NBC implementation in existence, just use + * this quick-and-dirty #ifdef to decide whether to test the nonblocking + * collectives. Eventually we can add a configure option or configure test, or + * the MPI-3 standard will be released and these can be gated on a MPI_VERSION + * check */ +#if !defined(USE_STRICT_MPI) && defined(MPICH) +#define TEST_NBC_ROUTINES 1 +#endif + +int main(int argc, char *argv[]) +{ + MPI_Request request; + int size, rank; + int one = 1, two = 2, isum, sum; + MPI_Init(&argc,&argv); + MPI_Comm_size(MPI_COMM_WORLD, &size); + MPI_Comm_rank(MPI_COMM_WORLD, &rank); + assert(size == 2); +#if defined(TEST_NBC_ROUTINES) + MPI_Iallreduce(&one,&isum,1,MPI_INT,MPI_SUM,MPI_COMM_WORLD,&request); + MPI_Allreduce(&two,&sum,1,MPI_INT,MPI_SUM,MPI_COMM_WORLD); + MPI_Wait(&request,MPI_STATUS_IGNORE); + + assert(isum == 2); + assert(sum == 4); + if (rank == 0) + printf(" No errors\n"); +#endif + + MPI_Finalize(); + return 0; +} + diff --git a/teshsuite/smpi/mpich3-test/coll/ibarrier.c b/teshsuite/smpi/mpich3-test/coll/ibarrier.c new file mode 100644 index 0000000000..bf2508bb4a --- /dev/null +++ b/teshsuite/smpi/mpich3-test/coll/ibarrier.c @@ -0,0 +1,38 @@ +/* -*- Mode: c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2013 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ + +/* Regression test for ticket #1785, contributed by Jed Brown. The test was + * hanging indefinitely under a buggy version of ch3:sock. */ + +#include +#include +#include + +#if !defined(USE_STRICT_MPI) && defined(MPICH) +#define TEST_NBC_ROUTINES 1 +#endif + +int main(int argc, char *argv[]) +{ + MPI_Request barrier; + int rank,i,done; + + MPI_Init(&argc,&argv); + MPI_Comm_rank(MPI_COMM_WORLD,&rank); + #if defined(TEST_NBC_ROUTINES) + MPI_Ibarrier(MPI_COMM_WORLD,&barrier); + for (i=0,done=0; !done; i++) { + usleep(1000); + /*printf("[%d] MPI_Test: %d\n",rank,i);*/ + MPI_Test(&barrier,&done,MPI_STATUS_IGNORE); + } + #endif + if (rank == 0) + printf(" No Errors\n"); + + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/coll/icallgather.c b/teshsuite/smpi/mpich3-test/coll/icallgather.c new file mode 100644 index 0000000000..987e01ab74 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/coll/icallgather.c @@ -0,0 +1,107 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2003 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include "mpi.h" +#include +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Simple intercomm allgather test"; +*/ + +int main( int argc, char *argv[] ) +{ + int errs = 0, err; + int *rbuf = 0, *sbuf = 0; + int leftGroup, i, count, rank, rsize; + MPI_Comm comm; + MPI_Datatype datatype; + + MTest_Init( &argc, &argv ); + + datatype = MPI_INT; + /* Get an intercommunicator */ + while (MTestGetIntercomm( &comm, &leftGroup, 4 )) { + if (comm == MPI_COMM_NULL) continue; + MPI_Comm_rank( comm, &rank ); + MPI_Comm_remote_size( comm, &rsize ); + + /* To improve reporting of problems about operations, we + change the error handler to errors return */ + MPI_Errhandler_set( comm, MPI_ERRORS_RETURN ); + + for (count = 1; count < 65000; count = 2 * count) { + /* The left group will send rank to the right group; + The right group will send -rank to the left group */ + rbuf = (int *)malloc( count * rsize * sizeof(int) ); + sbuf = (int *)malloc( count * sizeof(int) ); + for (i=0; i +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Simple intercomm allgatherv test"; +*/ + +int main( int argc, char *argv[] ) +{ + int errs = 0, err; + int *rbuf = 0, *sbuf = 0; + int *recvcounts, *recvdispls; + int leftGroup, i, count, rank, rsize; + MPI_Comm comm; + MPI_Datatype datatype; + + MTest_Init( &argc, &argv ); + + datatype = MPI_INT; + /* Get an intercommunicator */ + while (MTestGetIntercomm( &comm, &leftGroup, 4 )) { + if (comm == MPI_COMM_NULL) continue; + MPI_Comm_rank( comm, &rank ); + MPI_Comm_remote_size( comm, &rsize ); + + /* To improve reporting of problems about operations, we + change the error handler to errors return */ + MPI_Errhandler_set( comm, MPI_ERRORS_RETURN ); + + for (count = 1; count < 65000; count = 2 * count) { + /* The left group will send rank to the right group; + The right group will send -rank to the left group */ + rbuf = (int *)malloc( count * rsize * sizeof(int) ); + sbuf = (int *)malloc( count * sizeof(int) ); + recvcounts = (int *) malloc( rsize * sizeof(int) ); + recvdispls = (int *) malloc( rsize * sizeof(int) ); + for (i=0; i +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Simple intercomm allreduce test"; +*/ + +int main( int argc, char *argv[] ) +{ + int errs = 0, err; + int *sendbuf = 0, *recvbuf = 0; + int leftGroup, i, count, rank, rsize; + MPI_Comm comm; + MPI_Datatype datatype; + + MTest_Init( &argc, &argv ); + + datatype = MPI_INT; + /* Get an intercommunicator */ + while (MTestGetIntercomm( &comm, &leftGroup, 4 )) { + if (comm == MPI_COMM_NULL) continue; + MPI_Comm_rank( comm, &rank ); + MPI_Comm_remote_size( comm, &rsize ); + + /* To improve reporting of problems about operations, we + change the error handler to errors return */ + MPI_Errhandler_set( comm, MPI_ERRORS_RETURN ); + + for (count = 1; count < 65000; count = 2 * count) { + /* printf( "rank = %d(%d)\n", rank, leftGroup ); fflush(stdout); */ + sendbuf = (int *)malloc( count * sizeof(int) ); + recvbuf = (int *)malloc( count * sizeof(int) ); + if (leftGroup) { + for (i=0; i +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Simple intercomm alltoall test"; +*/ + +int main( int argc, char *argv[] ) +{ + int errs = 0, err; + int *sendbuf = 0, *recvbuf = 0; + int leftGroup, i, j, idx, count, rrank, rsize; + MPI_Comm comm; + MPI_Datatype datatype; + + MTest_Init( &argc, &argv ); + + datatype = MPI_INT; + while (MTestGetIntercomm( &comm, &leftGroup, 4 )) { + if (comm == MPI_COMM_NULL) continue; + for (count = 1; count < 66000; count = 2 * count) { + /* Get an intercommunicator */ + MPI_Comm_remote_size( comm, &rsize ); + MPI_Comm_rank( comm, &rrank ); + sendbuf = (int *)malloc( rsize * count * sizeof(int) ); + recvbuf = (int *)malloc( rsize * count * sizeof(int) ); + for (i=0; i +#include + +/* + This program tests MPI_Alltoallv by having processor i send different + amounts of data to each processor. + + Because there are separate send and receive types to alltoallv, + there need to be tests to rearrange data on the fly. Not done yet. + + The first test sends i items to processor i from all processors. + + Currently, the test uses only MPI_INT; this is adequate for testing systems + that use point-to-point operations + */ + +int main( int argc, char **argv ) +{ + MPI_Comm comm; + int *sbuf, *rbuf; + int rank, size, lsize, asize; + int *sendcounts, *recvcounts, *rdispls, *sdispls; + int i, j, *p, err; + int leftGroup; + + MTest_Init( &argc, &argv ); + err = 0; + + while (MTestGetIntercomm( &comm, &leftGroup, 4 )) { + if (comm == MPI_COMM_NULL) continue; + + /* Create the buffer */ + MPI_Comm_size( comm, &lsize ); + MPI_Comm_remote_size( comm, &size ); + asize = (lsize > size) ? lsize : size; + MPI_Comm_rank( comm, &rank ); + sbuf = (int *)malloc( size * size * sizeof(int) ); + rbuf = (int *)malloc( asize * asize * sizeof(int) ); + if (!sbuf || !rbuf) { + fprintf( stderr, "Could not allocated buffers!\n" ); + MPI_Abort( comm, 1 ); + } + + /* Load up the buffers */ + for (i=0; i +#include + +/* + This program tests MPI_Alltoallw by having processor i send different + amounts of data to each processor. This is just the MPI_Alltoallv test, + but with displacements in bytes rather than units of the datatype. + + Because there are separate send and receive types to alltoallw, + there need to be tests to rearrange data on the fly. Not done yet. + + The first test sends i items to processor i from all processors. + + Currently, the test uses only MPI_INT; this is adequate for testing systems + that use point-to-point operations + */ + +int main( int argc, char **argv ) +{ + + MPI_Comm comm; + int *sbuf, *rbuf; + int rank, size, lsize, asize; + int *sendcounts, *recvcounts, *rdispls, *sdispls; + int i, j, *p, err; + MPI_Datatype *sendtypes, *recvtypes; + int leftGroup; + + MTest_Init( &argc, &argv ); + err = 0; + + while (MTestGetIntercomm( &comm, &leftGroup, 4 )) { + if (comm == MPI_COMM_NULL) continue; + + /* Create the buffer */ + MPI_Comm_size( comm, &lsize ); + MPI_Comm_remote_size( comm, &size ); + asize = (lsize > size) ? lsize : size; + MPI_Comm_rank( comm, &rank ); + sbuf = (int *)malloc( size * size * sizeof(int) ); + rbuf = (int *)malloc( asize * asize * sizeof(int) ); + if (!sbuf || !rbuf) { + fprintf( stderr, "Could not allocated buffers!\n" ); + MPI_Abort( comm, 1 ); + } + + /* Load up the buffers */ + for (i=0; i +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Simple intercomm barrier test"; +*/ + +/* This only checks that the Barrier operation accepts intercommunicators. + It does not check for the semantics of a intercomm barrier (all processes + in the local group can exit when (but not before) all processes in the + remote group enter the barrier */ +int main( int argc, char *argv[] ) +{ + int errs = 0, err; + int leftGroup; + MPI_Comm comm; + MPI_Datatype datatype; + + MTest_Init( &argc, &argv ); + + datatype = MPI_INT; + /* Get an intercommunicator */ + while (MTestGetIntercomm( &comm, &leftGroup, 4 )) { + if (comm == MPI_COMM_NULL) + continue; + + /* To improve reporting of problems about operations, we + change the error handler to errors return */ + MPI_Comm_set_errhandler( comm, MPI_ERRORS_RETURN ); + if (leftGroup) { + err = MPI_Barrier( comm ); + if (err) { + errs++; + MTestPrintError( err ); + } + } + else { + /* In the right group */ + err = MPI_Barrier( comm ); + if (err) { + errs++; + MTestPrintError( err ); + } + } + MTestFreeComm( &comm ); + } + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/coll/icbcast.c b/teshsuite/smpi/mpich3-test/coll/icbcast.c new file mode 100644 index 0000000000..660d8614e2 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/coll/icbcast.c @@ -0,0 +1,87 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2003 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include "mpi.h" +#include +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Simple intercomm broadcast test"; +*/ + +int main( int argc, char *argv[] ) +{ + int errs = 0, err; + int *buf = 0; + int leftGroup, i, count, rank; + MPI_Comm comm; + MPI_Datatype datatype; + + MTest_Init( &argc, &argv ); + + datatype = MPI_INT; + /* Get an intercommunicator */ + while (MTestGetIntercomm( &comm, &leftGroup, 4 )) { + if (comm == MPI_COMM_NULL) + continue; + + MPI_Comm_rank( comm, &rank ); + + /* To improve reporting of problems about operations, we + change the error handler to errors return */ + MPI_Comm_set_errhandler( comm, MPI_ERRORS_RETURN ); + + for (count = 1; count < 65000; count = 2 * count) { + buf = (int *)malloc( count * sizeof(int) ); + if (leftGroup) { + if (rank == 0) { + for (i=0; i +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Simple intercomm gather test"; +*/ + +int main( int argc, char *argv[] ) +{ + int errs = 0, err; + int *buf = 0; + int leftGroup, i, count, rank, rsize, size; + MPI_Comm comm; + MPI_Datatype datatype; + + MTest_Init( &argc, &argv ); + + datatype = MPI_INT; + /* Get an intercommunicator */ + while (MTestGetIntercomm( &comm, &leftGroup, 4 )) { + if (comm == MPI_COMM_NULL) continue; + MPI_Comm_rank( comm, &rank ); + MPI_Comm_remote_size( comm, &rsize ); + MPI_Comm_size( comm, &size ); + /* To improve reporting of problems about operations, we + change the error handler to errors return */ + MPI_Comm_set_errhandler( comm, MPI_ERRORS_RETURN ); + for (count = 1; count < 65000; count = 2 * count) { + if (leftGroup) { + buf = (int *)malloc( count * rsize * sizeof(int) ); + for (i=0; i +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Simple intercomm gatherv test"; +*/ + +int main( int argc, char *argv[] ) +{ + int errs = 0, err; + int *buf = 0; + int *recvcounts; + int *recvdispls; + int leftGroup, i, count, rank, rsize, size; + MPI_Comm comm; + MPI_Datatype datatype; + + MTest_Init( &argc, &argv ); + + datatype = MPI_INT; + while (MTestGetIntercomm( &comm, &leftGroup, 4 )) { + if (comm == MPI_COMM_NULL) continue; + MPI_Comm_rank( comm, &rank ); + MPI_Comm_remote_size( comm, &rsize ); + MPI_Comm_size( comm, &size ); + + /* To improve reporting of problems about operations, we + change the error handler to errors return */ + MPI_Comm_set_errhandler( comm, MPI_ERRORS_RETURN ); + + for (count = 1; count < 65000; count = 2 * count) { + /* Get an intercommunicator */ + recvcounts = (int *)malloc( rsize * sizeof(int) ); + recvdispls = (int *)malloc( rsize * sizeof(int) ); + /* This simple test duplicates the Gather test, + using the same lengths for all messages */ + for (i=0; i +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Simple intercomm reduce test"; +*/ + +int main( int argc, char *argv[] ) +{ + int errs = 0, err; + int *sendbuf = 0, *recvbuf=0; + int leftGroup, i, count, rank, rsize; + MPI_Comm comm; + MPI_Datatype datatype; + + MTest_Init( &argc, &argv ); + + datatype = MPI_INT; + /* Get an intercommunicator */ + while (MTestGetIntercomm( &comm, &leftGroup, 4 )) { + if (comm == MPI_COMM_NULL) + continue; + + MPI_Comm_rank( comm, &rank ); + MPI_Comm_remote_size( comm, &rsize ); + + /* To improve reporting of problems about operations, we + change the error handler to errors return */ + MPI_Comm_set_errhandler( comm, MPI_ERRORS_RETURN ); + + for (count = 1; count < 65000; count = 2 * count) { + sendbuf = (int *)malloc( count * sizeof(int) ); + recvbuf = (int *)malloc( count * sizeof(int) ); + for (i=0; i +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Simple intercomm scatter test"; +*/ + +int main( int argc, char *argv[] ) +{ + int errs = 0, err; + int *buf = 0; + int leftGroup, i, count, rank, size, rsize; + MPI_Comm comm; + MPI_Datatype datatype; + + MTest_Init( &argc, &argv ); + + datatype = MPI_INT; + /* Get an intercommunicator */ + while (MTestGetIntercomm( &comm, &leftGroup, 4 )) { + if (comm == MPI_COMM_NULL) continue; + MPI_Comm_remote_size( comm, &rsize ); + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + + /* To improve reporting of problems about operations, we + change the error handler to errors return */ + MPI_Comm_set_errhandler( comm, MPI_ERRORS_RETURN ); + + for (count = 1; count < 65000; count = 2 * count) { + buf = 0; + if (leftGroup) { + buf = (int *)malloc( count * rsize * sizeof(int) ); + if (rank == 0) { + for (i=0; i +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Simple intercomm scatterv test"; +*/ + +int main( int argc, char *argv[] ) +{ + int errs = 0, err; + int *buf = 0; + int *sendcounts; + int *senddispls; + int leftGroup, i, count, rank, rsize, size; + MPI_Comm comm; + MPI_Datatype datatype; + + MTest_Init( &argc, &argv ); + + datatype = MPI_INT; + /* Get an intercommunicator */ + while (MTestGetIntercomm( &comm, &leftGroup, 4 )) { + if (comm == MPI_COMM_NULL) continue; + MPI_Comm_remote_size( comm, &rsize ); + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + + /* To improve reporting of problems about operations, we + change the error handler to errors return */ + MPI_Comm_set_errhandler( comm, MPI_ERRORS_RETURN ); + + for (count = 1; count < 65000; count = 2 * count) { + buf = 0; + sendcounts = (int *)malloc( rsize * sizeof(int) ); + senddispls = (int *)malloc( rsize * sizeof(int) ); + for (i=0; i +#include + +int add ( double *, double *, int *, MPI_Datatype * ); +/* + * User-defined operation on a long value (tests proper handling of + * possible pipelining in the implementation of reductions with user-defined + * operations). + */ +int add( double *invec, double *inoutvec, int *len, MPI_Datatype *dtype ) +{ + int i, n = *len; + for (i=0; i +#include +#include "mpitest.h" +/* USE_STRICT_MPI may be defined in mpitestconf.h */ +#include "mpitestconf.h" + +#define NUM_INTS (2) + +#define my_assert(cond_) \ + do { \ + if (!(cond_)) { \ + fprintf(stderr, "assertion (%s) failed, aborting\n", #cond_); \ + MPI_Abort(MPI_COMM_WORLD, 1); \ + } \ + } while (0) + +int main(int argc, char **argv) +{ + int errs = 0; + int i; + int rank, size; + int *sbuf = NULL; + int *rbuf = NULL; + int *scounts = NULL; + int *rcounts = NULL; + int *sdispls = NULL; + int *rdispls = NULL; + int *types = NULL; + MPI_Comm comm; + MPI_Request req; + + /* intentionally not using MTest_Init/MTest_Finalize in order to make it + * easy to take this test and use it as an NBC sanity test outside of the + * MPICH test suite */ + MPI_Init(&argc, &argv); + + comm = MPI_COMM_WORLD; + + MPI_Comm_size(comm, &size); + MPI_Comm_rank(comm, &rank); + +#if !defined(USE_STRICT_MPI) && defined(MPICH) + /* enough space for every process to contribute at least NUM_INTS ints to any + * collective operation */ + sbuf = malloc(NUM_INTS*size*sizeof(int)); + my_assert(sbuf); + rbuf = malloc(NUM_INTS*size*sizeof(int)); + my_assert(rbuf); + scounts = malloc(size*sizeof(int)); + my_assert(scounts); + rcounts = malloc(size*sizeof(int)); + my_assert(rcounts); + sdispls = malloc(size*sizeof(int)); + my_assert(sdispls); + rdispls = malloc(size*sizeof(int)); + my_assert(rdispls); + types = malloc(size*sizeof(int)); + my_assert(types); + + for (i = 0; i < size; ++i) { + sbuf[2*i] = i; + sbuf[2*i+1] = i; + rbuf[2*i] = i; + rbuf[2*i+1] = i; + scounts[i] = NUM_INTS; + rcounts[i] = NUM_INTS; + sdispls[i] = i * NUM_INTS; + rdispls[i] = i * NUM_INTS; + types[i] = MPI_INT; + } + + MPI_Ibarrier(comm, &req); + MPI_Wait(&req, MPI_STATUS_IGNORE); + + MPI_Ibcast(sbuf, NUM_INTS, MPI_INT, 0, comm, &req); + MPI_Wait(&req, MPI_STATUS_IGNORE); + + MPI_Igather(sbuf, NUM_INTS, MPI_INT, rbuf, NUM_INTS, MPI_INT, 0, comm, &req); + MPI_Wait(&req, MPI_STATUS_IGNORE); + + MPI_Igatherv(sbuf, NUM_INTS, MPI_INT, rbuf, rcounts, rdispls, MPI_INT, 0, comm, &req); + MPI_Wait(&req, MPI_STATUS_IGNORE); + + MPI_Iscatter(sbuf, NUM_INTS, MPI_INT, rbuf, NUM_INTS, MPI_INT, 0, comm, &req); + MPI_Wait(&req, MPI_STATUS_IGNORE); + + MPI_Iscatterv(sbuf, scounts, sdispls, MPI_INT, rbuf, NUM_INTS, MPI_INT, 0, comm, &req); + MPI_Wait(&req, MPI_STATUS_IGNORE); + + MPI_Iallgather(sbuf, NUM_INTS, MPI_INT, rbuf, NUM_INTS, MPI_INT, comm, &req); + MPI_Wait(&req, MPI_STATUS_IGNORE); + + MPI_Iallgatherv(sbuf, NUM_INTS, MPI_INT, rbuf, rcounts, rdispls, MPI_INT, comm, &req); + MPI_Wait(&req, MPI_STATUS_IGNORE); + + MPI_Ialltoall(sbuf, NUM_INTS, MPI_INT, rbuf, NUM_INTS, MPI_INT, comm, &req); + MPI_Wait(&req, MPI_STATUS_IGNORE); + + MPI_Ialltoallv(sbuf, scounts, sdispls, MPI_INT, rbuf, rcounts, rdispls, MPI_INT, comm, &req); + MPI_Wait(&req, MPI_STATUS_IGNORE); + + MPI_Ialltoallw(sbuf, scounts, sdispls, types, rbuf, rcounts, rdispls, types, comm, &req); + MPI_Wait(&req, MPI_STATUS_IGNORE); + + MPI_Ireduce(sbuf, rbuf, NUM_INTS, MPI_INT, MPI_SUM, 0, comm, &req); + MPI_Wait(&req, MPI_STATUS_IGNORE); + + MPI_Iallreduce(sbuf, rbuf, NUM_INTS, MPI_INT, MPI_SUM, comm, &req); + MPI_Wait(&req, MPI_STATUS_IGNORE); + + MPI_Ireduce_scatter(sbuf, rbuf, rcounts, MPI_INT, MPI_SUM, comm, &req); + MPI_Wait(&req, MPI_STATUS_IGNORE); + + MPI_Ireduce_scatter_block(sbuf, rbuf, NUM_INTS, MPI_INT, MPI_SUM, comm, &req); + MPI_Wait(&req, MPI_STATUS_IGNORE); + + MPI_Iscan(sbuf, rbuf, NUM_INTS, MPI_INT, MPI_SUM, comm, &req); + MPI_Wait(&req, MPI_STATUS_IGNORE); + + MPI_Iexscan(sbuf, rbuf, NUM_INTS, MPI_INT, MPI_SUM, comm, &req); + MPI_Wait(&req, MPI_STATUS_IGNORE); + +#endif + + if (sbuf) free(sbuf); + if (rbuf) free(rbuf); + if (scounts) free(scounts); + if (rcounts) free(rcounts); + if (sdispls) free(sdispls); + if (rdispls) free(rdispls); + + if (rank == 0) { + if (errs) + fprintf(stderr, "Found %d errors\n", errs); + else + printf(" No errors\n"); + } + MPI_Finalize(); + return 0; +} + diff --git a/teshsuite/smpi/mpich3-test/coll/nonblocking2.c b/teshsuite/smpi/mpich3-test/coll/nonblocking2.c new file mode 100644 index 0000000000..a323596f2f --- /dev/null +++ b/teshsuite/smpi/mpich3-test/coll/nonblocking2.c @@ -0,0 +1,468 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2011 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ + +/* A basic test of all 17 nonblocking collective operations specified by the + * draft MPI-3 standard. It only exercises the intracommunicator functionality, + * does not use MPI_IN_PLACE, and only transmits/receives simple integer types + * with relatively small counts. It does check a few fancier issues, such as + * ensuring that "premature user releases" of MPI_Op and MPI_Datatype objects + * does not result in an error or segfault. */ + +#include "mpi.h" +#include +#include +/* USE_STRICT_MPI may be defined in mpitestconf.h */ +#include "mpitestconf.h" + +#define COUNT (10) +#define PRIME (17) + +#define my_assert(cond_) \ + do { \ + if (!(cond_)) { \ + fprintf(stderr, "assertion (%s) failed, aborting\n", #cond_); \ + MPI_Abort(MPI_COMM_WORLD, 1); \ + } \ + } while (0) + +/* Since MPICH is currently the only NBC implementation in existence, just use + * this quick-and-dirty #ifdef to decide whether to test the nonblocking + * collectives. Eventually we can add a configure option or configure test, or + * the MPI-3 standard will be released and these can be gated on a MPI_VERSION + * check */ +#if !defined(USE_STRICT_MPI) && defined(MPICH) +#define TEST_NBC_ROUTINES 1 +#endif + +static void sum_fn(void *invec, void *inoutvec, int *len, MPI_Datatype *datatype) +{ + int i; + int *in = invec; + int *inout = inoutvec; + for (i = 0; i < *len; ++i) { + inout[i] = in[i] + inout[i]; + } +} + + +int main(int argc, char **argv) +{ + int i, j; + int rank, size; + int *buf = NULL; + int *recvbuf = NULL; + int *sendcounts = NULL; + int *recvcounts = NULL; + int *sdispls = NULL; + int *rdispls = NULL; + int *sendtypes = NULL; + int *recvtypes = NULL; + char *buf_alias = NULL; + MPI_Request req; + + MPI_Init(&argc, &argv); + MPI_Comm_rank(MPI_COMM_WORLD, &rank); + MPI_Comm_size(MPI_COMM_WORLD, &size); +#if defined(TEST_NBC_ROUTINES) + + buf = malloc(COUNT*size*sizeof(int)); + recvbuf = malloc(COUNT*size*sizeof(int)); + sendcounts = malloc(size*sizeof(int)); + recvcounts = malloc(size*sizeof(int)); + sdispls = malloc(size*sizeof(int)); + rdispls = malloc(size*sizeof(int)); + sendtypes = malloc(size*sizeof(MPI_Datatype)); + recvtypes = malloc(size*sizeof(MPI_Datatype)); + + /* MPI_Ibcast */ + for (i = 0; i < COUNT; ++i) { + if (rank == 0) { + buf[i] = i; + } + else { + buf[i] = 0xdeadbeef; + } + } + MPI_Ibcast(buf, COUNT, MPI_INT, 0, MPI_COMM_WORLD, &req); + MPI_Wait(&req, MPI_STATUS_IGNORE); + + for (i = 0; i < COUNT; ++i) { + if (buf[i] != i) + printf("buf[%d]=%d i=%d\n", i, buf[i], i); + my_assert(buf[i] == i); + } + + /* MPI_Ibcast (again, but designed to stress scatter/allgather impls) */ + buf_alias = (char *)buf; + my_assert(COUNT*size*sizeof(int) > PRIME); /* sanity */ + for (i = 0; i < PRIME; ++i) { + if (rank == 0) + buf_alias[i] = i; + else + buf_alias[i] = 0xdb; + } + for (i = PRIME; i < COUNT * size * sizeof(int); ++i) { + buf_alias[i] = 0xbf; + } + MPI_Ibcast(buf, PRIME, MPI_SIGNED_CHAR, 0, MPI_COMM_WORLD, &req); + MPI_Wait(&req, MPI_STATUS_IGNORE); + for (i = 0; i < PRIME; ++i) { + if (buf_alias[i] != i) + printf("buf_alias[%d]=%d i=%d\n", i, buf_alias[i], i); + my_assert(buf_alias[i] == i); + } + + /* MPI_Ibarrier */ + MPI_Ibarrier(MPI_COMM_WORLD, &req); + MPI_Wait(&req, MPI_STATUS_IGNORE); + + /* MPI_Ireduce */ + for (i = 0; i < COUNT; ++i) { + buf[i] = rank + i; + recvbuf[i] = 0xdeadbeef; + } + MPI_Ireduce(buf, recvbuf, COUNT, MPI_INT, MPI_SUM, 0, MPI_COMM_WORLD, &req); + MPI_Wait(&req, MPI_STATUS_IGNORE); + if (rank == 0) { + for (i = 0; i < COUNT; ++i) { + if (recvbuf[i] != ((size * (size-1) / 2) + (i * size))) + printf("got recvbuf[%d]=%d, expected %d\n", i, recvbuf[i], ((size * (size-1) / 2) + (i * size))); + my_assert(recvbuf[i] == ((size * (size-1) / 2) + (i * size))); + } + } + + /* same again, use a user op and free it before the wait */ + { + MPI_Op op = MPI_OP_NULL; + MPI_Op_create(sum_fn, /*commute=*/1, &op); + + for (i = 0; i < COUNT; ++i) { + buf[i] = rank + i; + recvbuf[i] = 0xdeadbeef; + } + MPI_Ireduce(buf, recvbuf, COUNT, MPI_INT, op, 0, MPI_COMM_WORLD, &req); + MPI_Op_free(&op); + MPI_Wait(&req, MPI_STATUS_IGNORE); + if (rank == 0) { + for (i = 0; i < COUNT; ++i) { + if (recvbuf[i] != ((size * (size-1) / 2) + (i * size))) + printf("got recvbuf[%d]=%d, expected %d\n", i, recvbuf[i], ((size * (size-1) / 2) + (i * size))); + my_assert(recvbuf[i] == ((size * (size-1) / 2) + (i * size))); + } + } + } + + /* MPI_Iallreduce */ + for (i = 0; i < COUNT; ++i) { + buf[i] = rank + i; + recvbuf[i] = 0xdeadbeef; + } + MPI_Iallreduce(buf, recvbuf, COUNT, MPI_INT, MPI_SUM, MPI_COMM_WORLD, &req); + MPI_Wait(&req, MPI_STATUS_IGNORE); + for (i = 0; i < COUNT; ++i) { + if (recvbuf[i] != ((size * (size-1) / 2) + (i * size))) + printf("got recvbuf[%d]=%d, expected %d\n", i, recvbuf[i], ((size * (size-1) / 2) + (i * size))); + my_assert(recvbuf[i] == ((size * (size-1) / 2) + (i * size))); + } + + /* MPI_Ialltoallv (a weak test, neither irregular nor sparse) */ + for (i = 0; i < size; ++i) { + sendcounts[i] = COUNT; + recvcounts[i] = COUNT; + sdispls[i] = COUNT * i; + rdispls[i] = COUNT * i; + for (j = 0; j < COUNT; ++j) { + buf[i*COUNT+j] = rank + (i * j); + recvbuf[i*COUNT+j] = 0xdeadbeef; + } + } + MPI_Ialltoallv(buf, sendcounts, sdispls, MPI_INT, recvbuf, recvcounts, rdispls, MPI_INT, MPI_COMM_WORLD, &req); + MPI_Wait(&req, MPI_STATUS_IGNORE); + for (i = 0; i < size; ++i) { + for (j = 0; j < COUNT; ++j) { + /*printf("recvbuf[%d*COUNT+%d]=%d, expecting %d\n", i, j, recvbuf[i*COUNT+j], (i + (rank * j)));*/ + my_assert(recvbuf[i*COUNT+j] == (i + (rank * j))); + } + } + + /* MPI_Igather */ + for (i = 0; i < size*COUNT; ++i) { + buf[i] = rank + i; + recvbuf[i] = 0xdeadbeef; + } + MPI_Igather(buf, COUNT, MPI_INT, recvbuf, COUNT, MPI_INT, 0, MPI_COMM_WORLD, &req); + MPI_Wait(&req, MPI_STATUS_IGNORE); + if (rank == 0) { + for (i = 0; i < size; ++i) { + for (j = 0; j < COUNT; ++j) { + my_assert(recvbuf[i*COUNT+j] == i + j); + } + } + } + else { + for (i = 0; i < size*COUNT; ++i) { + my_assert(recvbuf[i] == 0xdeadbeef); + } + } + + /* same test again, just use a dup'ed datatype and free it before the wait */ + { + MPI_Datatype type = MPI_DATATYPE_NULL; + MPI_Type_dup(MPI_INT, &type); + + for (i = 0; i < size*COUNT; ++i) { + buf[i] = rank + i; + recvbuf[i] = 0xdeadbeef; + } + MPI_Igather(buf, COUNT, MPI_INT, recvbuf, COUNT, type, 0, MPI_COMM_WORLD, &req); + MPI_Type_free(&type); /* should cause implementations that don't refcount + correctly to blow up or hang in the wait */ + MPI_Wait(&req, MPI_STATUS_IGNORE); + if (rank == 0) { + for (i = 0; i < size; ++i) { + for (j = 0; j < COUNT; ++j) { + my_assert(recvbuf[i*COUNT+j] == i + j); + } + } + } + else { + for (i = 0; i < size*COUNT; ++i) { + my_assert(recvbuf[i] == 0xdeadbeef); + } + } + } + + /* MPI_Iscatter */ + for (i = 0; i < size; ++i) { + for (j = 0; j < COUNT; ++j) { + if (rank == 0) + buf[i*COUNT+j] = i + j; + else + buf[i*COUNT+j] = 0xdeadbeef; + recvbuf[i*COUNT+j] = 0xdeadbeef; + } + } + MPI_Iscatter(buf, COUNT, MPI_INT, recvbuf, COUNT, MPI_INT, 0, MPI_COMM_WORLD, &req); + MPI_Wait(&req, MPI_STATUS_IGNORE); + for (j = 0; j < COUNT; ++j) { + my_assert(recvbuf[j] == rank + j); + } + if (rank != 0) { + for (i = 0; i < size*COUNT; ++i) { + /* check we didn't corrupt the sendbuf somehow */ + my_assert(buf[i] == 0xdeadbeef); + } + } + + /* MPI_Iscatterv */ + for (i = 0; i < size; ++i) { + /* weak test, just test the regular case where all counts are equal */ + sendcounts[i] = COUNT; + sdispls[i] = i * COUNT; + for (j = 0; j < COUNT; ++j) { + if (rank == 0) + buf[i*COUNT+j] = i + j; + else + buf[i*COUNT+j] = 0xdeadbeef; + recvbuf[i*COUNT+j] = 0xdeadbeef; + } + } + MPI_Iscatterv(buf, sendcounts, sdispls, MPI_INT, recvbuf, COUNT, MPI_INT, 0, MPI_COMM_WORLD, &req); + MPI_Wait(&req, MPI_STATUS_IGNORE); + for (j = 0; j < COUNT; ++j) { + my_assert(recvbuf[j] == rank + j); + } + if (rank != 0) { + for (i = 0; i < size*COUNT; ++i) { + /* check we didn't corrupt the sendbuf somehow */ + my_assert(buf[i] == 0xdeadbeef); + } + } + for (i = 1; i < size; ++i) { + for (j = 0; j < COUNT; ++j) { + /* check we didn't corrupt the rest of the recvbuf */ + my_assert(recvbuf[i*COUNT+j] == 0xdeadbeef); + } + } + + /* MPI_Ireduce_scatter */ + for (i = 0; i < size; ++i) { + recvcounts[i] = COUNT; + for (j = 0; j < COUNT; ++j) { + buf[i*COUNT+j] = rank + i; + recvbuf[i*COUNT+j] = 0xdeadbeef; + } + } + MPI_Ireduce_scatter(buf, recvbuf, recvcounts, MPI_INT, MPI_SUM, MPI_COMM_WORLD, &req); + MPI_Wait(&req, MPI_STATUS_IGNORE); + for (j = 0; j < COUNT; ++j) { + my_assert(recvbuf[j] == (size * rank + ((size - 1) * size) / 2)); + } + for (i = 1; i < size; ++i) { + for (j = 0; j < COUNT; ++j) { + /* check we didn't corrupt the rest of the recvbuf */ + my_assert(recvbuf[i*COUNT+j] == 0xdeadbeef); + } + } + + /* MPI_Ireduce_scatter_block */ + for (i = 0; i < size; ++i) { + for (j = 0; j < COUNT; ++j) { + buf[i*COUNT+j] = rank + i; + recvbuf[i*COUNT+j] = 0xdeadbeef; + } + } + MPI_Ireduce_scatter_block(buf, recvbuf, COUNT, MPI_INT, MPI_SUM, MPI_COMM_WORLD, &req); + MPI_Wait(&req, MPI_STATUS_IGNORE); + for (j = 0; j < COUNT; ++j) { + my_assert(recvbuf[j] == (size * rank + ((size - 1) * size) / 2)); + } + for (i = 1; i < size; ++i) { + for (j = 0; j < COUNT; ++j) { + /* check we didn't corrupt the rest of the recvbuf */ + my_assert(recvbuf[i*COUNT+j] == 0xdeadbeef); + } + } + + /* MPI_Igatherv */ + for (i = 0; i < size*COUNT; ++i) { + buf[i] = 0xdeadbeef; + recvbuf[i] = 0xdeadbeef; + } + for (i = 0; i < COUNT; ++i) { + buf[i] = rank + i; + } + for (i = 0; i < size; ++i) { + recvcounts[i] = COUNT; + rdispls[i] = i * COUNT; + } + MPI_Igatherv(buf, COUNT, MPI_INT, recvbuf, recvcounts, rdispls, MPI_INT, 0, MPI_COMM_WORLD, &req); + MPI_Wait(&req, MPI_STATUS_IGNORE); + if (rank == 0) { + for (i = 0; i < size; ++i) { + for (j = 0; j < COUNT; ++j) { + my_assert(recvbuf[i*COUNT+j] == i + j); + } + } + } + else { + for (i = 0; i < size*COUNT; ++i) { + my_assert(recvbuf[i] == 0xdeadbeef); + } + } + + /* MPI_Ialltoall */ + for (i = 0; i < size; ++i) { + for (j = 0; j < COUNT; ++j) { + buf[i*COUNT+j] = rank + (i * j); + recvbuf[i*COUNT+j] = 0xdeadbeef; + } + } + MPI_Ialltoall(buf, COUNT, MPI_INT, recvbuf, COUNT, MPI_INT, MPI_COMM_WORLD, &req); + MPI_Wait(&req, MPI_STATUS_IGNORE); + for (i = 0; i < size; ++i) { + for (j = 0; j < COUNT; ++j) { + /*printf("recvbuf[%d*COUNT+%d]=%d, expecting %d\n", i, j, recvbuf[i*COUNT+j], (i + (i * j)));*/ + my_assert(recvbuf[i*COUNT+j] == (i + (rank * j))); + } + } + + /* MPI_Iallgather */ + for (i = 0; i < size*COUNT; ++i) { + buf[i] = rank + i; + recvbuf[i] = 0xdeadbeef; + } + MPI_Iallgather(buf, COUNT, MPI_INT, recvbuf, COUNT, MPI_INT, MPI_COMM_WORLD, &req); + MPI_Wait(&req, MPI_STATUS_IGNORE); + for (i = 0; i < size; ++i) { + for (j = 0; j < COUNT; ++j) { + my_assert(recvbuf[i*COUNT+j] == i + j); + } + } + + /* MPI_Iallgatherv */ + for (i = 0; i < size; ++i) { + for (j = 0; j < COUNT; ++j) { + recvbuf[i*COUNT+j] = 0xdeadbeef; + } + recvcounts[i] = COUNT; + rdispls[i] = i * COUNT; + } + for (i = 0; i < COUNT; ++i) + buf[i] = rank + i; + MPI_Iallgatherv(buf, COUNT, MPI_INT, recvbuf, recvcounts, rdispls, MPI_INT, MPI_COMM_WORLD, &req); + MPI_Wait(&req, MPI_STATUS_IGNORE); + for (i = 0; i < size; ++i) { + for (j = 0; j < COUNT; ++j) { + my_assert(recvbuf[i*COUNT+j] == i + j); + } + } + + /* MPI_Iscan */ + for (i = 0; i < COUNT; ++i) { + buf[i] = rank + i; + recvbuf[i] = 0xdeadbeef; + } + MPI_Iscan(buf, recvbuf, COUNT, MPI_INT, MPI_SUM, MPI_COMM_WORLD, &req); + MPI_Wait(&req, MPI_STATUS_IGNORE); + for (i = 0; i < COUNT; ++i) { + my_assert(recvbuf[i] == ((rank * (rank+1) / 2) + (i * (rank + 1)))); + } + + /* MPI_Iexscan */ + for (i = 0; i < COUNT; ++i) { + buf[i] = rank + i; + recvbuf[i] = 0xdeadbeef; + } + MPI_Iexscan(buf, recvbuf, COUNT, MPI_INT, MPI_SUM, MPI_COMM_WORLD, &req); + MPI_Wait(&req, MPI_STATUS_IGNORE); + for (i = 0; i < COUNT; ++i) { + if (rank == 0) + my_assert(recvbuf[i] == 0xdeadbeef); + else + my_assert(recvbuf[i] == ((rank * (rank+1) / 2) + (i * (rank + 1)) - (rank + i))); + } + + /* MPI_Ialltoallw (a weak test, neither irregular nor sparse) */ + for (i = 0; i < size; ++i) { + sendcounts[i] = COUNT; + recvcounts[i] = COUNT; + sdispls[i] = COUNT * i * sizeof(int); + rdispls[i] = COUNT * i * sizeof(int); + sendtypes[i] = MPI_INT; + recvtypes[i] = MPI_INT; + for (j = 0; j < COUNT; ++j) { + buf[i*COUNT+j] = rank + (i * j); + recvbuf[i*COUNT+j] = 0xdeadbeef; + } + } + MPI_Ialltoallw(buf, sendcounts, sdispls, sendtypes, recvbuf, recvcounts, rdispls, recvtypes, MPI_COMM_WORLD, &req); + MPI_Wait(&req, MPI_STATUS_IGNORE); + for (i = 0; i < size; ++i) { + for (j = 0; j < COUNT; ++j) { + /*printf("recvbuf[%d*COUNT+%d]=%d, expecting %d\n", i, j, recvbuf[i*COUNT+j], (i + (rank * j)));*/ + my_assert(recvbuf[i*COUNT+j] == (i + (rank * j))); + } + } + +#endif /* defined(TEST_NBC_ROUTINES) */ + + if (rank == 0) + printf(" No Errors\n"); + + + MPI_Finalize(); + free(buf); + free(recvbuf); + free(sendcounts); + free(recvcounts); + free(rdispls); + free(sdispls); + free(recvtypes); + free(sendtypes); + return 0; +} + diff --git a/teshsuite/smpi/mpich3-test/coll/nonblocking3.c b/teshsuite/smpi/mpich3-test/coll/nonblocking3.c new file mode 100644 index 0000000000..e072def468 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/coll/nonblocking3.c @@ -0,0 +1,842 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2011 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ + +/* This test attempts to execute multiple simultaneous nonblocking collective + * (NBC) MPI routines at the same time, and manages their completion with a + * variety of routines (MPI_{Wait,Test}{,_all,_any,_some}). It also throws a + * few point-to-point operations into the mix. + * + * Possible improvements: + * - post operations on multiple comms from multiple threads + */ + +#include "mpi.h" +#include +#include +#include +#include +/* USE_STRICT_MPI may be defined in mpitestconf.h */ +#include "mpitestconf.h" + +#ifdef HAVE_UNISTD_H +#include +#endif + +static int errs = 0; + +/* Constants that control the high level test harness behavior. */ +/* MAIN_ITERATIONS is how many NBC ops the test will attempt to issue. */ +#define MAIN_ITERATIONS (100000) +/* WINDOW is the maximum number of outstanding NBC requests at any given time */ +#define WINDOW (20) +/* we sleep with probability 1/CHANCE_OF_SLEEP */ +#define CHANCE_OF_SLEEP (1000) +/* JITTER_DELAY is denominated in microseconds (us) */ +#define JITTER_DELAY (50000) /* 0.05 seconds */ +/* NUM_COMMS is the number of communicators on which ops will be posted */ +#define NUM_COMMS (4) + +/* Constants that control behavior of the individual testing operations. + * Altering these can help to explore the testing space, but increasing them too + * much can consume too much memory (often O(n^2) usage). */ +/* FIXME is COUNT==10 too limiting? should we try a larger count too (~500)? */ +#define COUNT (10) +#define PRIME (17) + +#define my_assert(cond_) \ + do { \ + if (!(cond_)) { \ + ++errs; \ + if (errs < 10) { \ + fprintf(stderr, "assertion (%s) failed on line %d\n", #cond_, __LINE__); \ + } \ + } \ + } while (0) + +/* Since MPICH is currently the only NBC implementation in existence, just use + * this quick-and-dirty #ifdef to decide whether to test the nonblocking + * collectives. Eventually we can add a configure option or configure test, or + * the MPI-3 standard will be released and these can be gated on a MPI_VERSION + * check */ +#if !defined(USE_STRICT_MPI) && defined(MPICH) +#define TEST_NBC_ROUTINES 1 +#endif + +#if defined(TEST_NBC_ROUTINES) +/* Intended to act like "rand_r", but we can be sure that it will exist and be + * consistent across all of comm world. Returns a number in the range + * [0,GEN_PRN_MAX] */ +#define GEN_PRN_MAX (4294967291-1) +static unsigned int gen_prn(unsigned int x) +{ + /* a simple "multiplicative congruential method" PRNG, with parameters: + * m=4294967291, largest 32-bit prime + * a=279470273, good primitive root of m from "TABLES OF LINEAR + * CONGRUENTIAL GENERATORS OF DIFFERENT SIZES AND GOOD + * LATTICE STRUCTURE", by Pierre L’Ecuyer */ + return (279470273UL * (unsigned long)x) % 4294967291UL; +} + +/* given a random unsigned int value "rndval_" from gen_prn, this evaluates to a + * value in the range [min_,max_) */ +#define rand_range(rndval_,min_,max_) \ + ((unsigned int)((min_) + ((rndval_) * (1.0 / (GEN_PRN_MAX+1.0)) * ((max_) - (min_))))) + + +static void sum_fn(void *invec, void *inoutvec, int *len, MPI_Datatype *datatype) +{ + int i; + int *in = invec; + int *inout = inoutvec; + for (i = 0; i < *len; ++i) { + inout[i] = in[i] + inout[i]; + } +} + +/* used to keep track of buffers that should be freed after the corresponding + * operation has completed */ +struct laundry { + int case_num; /* which test case initiated this req/laundry */ + MPI_Comm comm; + int *buf; + int *recvbuf; + int *sendcounts; + int *recvcounts; + int *sdispls; + int *rdispls; + int *sendtypes; + int *recvtypes; +}; + +static void cleanup_laundry(struct laundry *l) +{ + l->case_num = -1; + l->comm = MPI_COMM_NULL; + if (l->buf) free(l->buf); + if (l->recvbuf) free(l->recvbuf); + if (l->sendcounts) free(l->sendcounts); + if (l->recvcounts) free(l->recvcounts); + if (l->sdispls) free(l->sdispls); + if (l->rdispls) free(l->rdispls); + if (l->sendtypes) free(l->sendtypes); + if (l->recvtypes) free(l->recvtypes); +} + +/* Starts a "random" operation on "comm" corresponding to "rndnum" and returns + * in (*req) a request handle corresonding to that operation. This call should + * be considered collective over comm (with a consistent value for "rndnum"), + * even though the operation may only be a point-to-point request. */ +static void start_random_nonblocking(MPI_Comm comm, unsigned int rndnum, MPI_Request *req, struct laundry *l) +{ + int i, j; + int rank, size; + int *buf = NULL; + int *recvbuf = NULL; + int *sendcounts = NULL; + int *recvcounts = NULL; + int *sdispls = NULL; + int *rdispls = NULL; + int *sendtypes = NULL; + int *recvtypes = NULL; + char *buf_alias = NULL; + + MPI_Comm_rank(comm, &rank); + MPI_Comm_size(comm, &size); + + *req = MPI_REQUEST_NULL; + + l->case_num = -1; + l->comm = comm; + + l->buf = buf = malloc(COUNT*size*sizeof(int)); + l->recvbuf = recvbuf = malloc(COUNT*size*sizeof(int)); + l->sendcounts = sendcounts = malloc(size*sizeof(int)); + l->recvcounts = recvcounts = malloc(size*sizeof(int)); + l->sdispls = sdispls = malloc(size*sizeof(int)); + l->rdispls = rdispls = malloc(size*sizeof(int)); + l->sendtypes = sendtypes = malloc(size*sizeof(MPI_Datatype)); + l->recvtypes = recvtypes = malloc(size*sizeof(MPI_Datatype)); + +#define NUM_CASES (21) + l->case_num = rand_range(rndnum, 0, NUM_CASES); + switch (l->case_num) { + case 0: /* MPI_Ibcast */ + for (i = 0; i < COUNT; ++i) { + if (rank == 0) { + buf[i] = i; + } + else { + buf[i] = 0xdeadbeef; + } + } + MPI_Ibcast(buf, COUNT, MPI_INT, 0, comm, req); + break; + + case 1: /* MPI_Ibcast (again, but designed to stress scatter/allgather impls) */ + /* FIXME fiddle with PRIME and buffer allocation s.t. PRIME is much larger (1021?) */ + buf_alias = (char *)buf; + my_assert(COUNT*size*sizeof(int) > PRIME); /* sanity */ + for (i = 0; i < PRIME; ++i) { + if (rank == 0) + buf_alias[i] = i; + else + buf_alias[i] = 0xdb; + } + for (i = PRIME; i < COUNT * size * sizeof(int); ++i) { + buf_alias[i] = 0xbf; + } + MPI_Ibcast(buf, PRIME, MPI_SIGNED_CHAR, 0, comm, req); + break; + + case 2: /* MPI_Ibarrier */ + MPI_Ibarrier(comm, req); + break; + + case 3: /* MPI_Ireduce */ + for (i = 0; i < COUNT; ++i) { + buf[i] = rank + i; + recvbuf[i] = 0xdeadbeef; + } + MPI_Ireduce(buf, recvbuf, COUNT, MPI_INT, MPI_SUM, 0, comm, req); + break; + + case 4: /* same again, use a user op and free it before the wait */ + { + MPI_Op op = MPI_OP_NULL; + MPI_Op_create(sum_fn, /*commute=*/1, &op); + for (i = 0; i < COUNT; ++i) { + buf[i] = rank + i; + recvbuf[i] = 0xdeadbeef; + } + MPI_Ireduce(buf, recvbuf, COUNT, MPI_INT, op, 0, comm, req); + MPI_Op_free(&op); + } + break; + + case 5: /* MPI_Iallreduce */ + for (i = 0; i < COUNT; ++i) { + buf[i] = rank + i; + recvbuf[i] = 0xdeadbeef; + } + MPI_Iallreduce(buf, recvbuf, COUNT, MPI_INT, MPI_SUM, comm, req); + break; + + case 6: /* MPI_Ialltoallv (a weak test, neither irregular nor sparse) */ + for (i = 0; i < size; ++i) { + sendcounts[i] = COUNT; + recvcounts[i] = COUNT; + sdispls[i] = COUNT * i; + rdispls[i] = COUNT * i; + for (j = 0; j < COUNT; ++j) { + buf[i*COUNT+j] = rank + (i * j); + recvbuf[i*COUNT+j] = 0xdeadbeef; + } + } + MPI_Ialltoallv(buf, sendcounts, sdispls, MPI_INT, recvbuf, recvcounts, rdispls, MPI_INT, comm, req); + break; + + case 7: /* MPI_Igather */ + for (i = 0; i < size*COUNT; ++i) { + buf[i] = rank + i; + recvbuf[i] = 0xdeadbeef; + } + MPI_Igather(buf, COUNT, MPI_INT, recvbuf, COUNT, MPI_INT, 0, comm, req); + break; + + case 8: /* same test again, just use a dup'ed datatype and free it before the wait */ + { + MPI_Datatype type = MPI_DATATYPE_NULL; + MPI_Type_dup(MPI_INT, &type); + for (i = 0; i < size*COUNT; ++i) { + buf[i] = rank + i; + recvbuf[i] = 0xdeadbeef; + } + MPI_Igather(buf, COUNT, MPI_INT, recvbuf, COUNT, type, 0, comm, req); + MPI_Type_free(&type); /* should cause implementations that don't refcount + correctly to blow up or hang in the wait */ + } + break; + + case 9: /* MPI_Iscatter */ + for (i = 0; i < size; ++i) { + for (j = 0; j < COUNT; ++j) { + if (rank == 0) + buf[i*COUNT+j] = i + j; + else + buf[i*COUNT+j] = 0xdeadbeef; + recvbuf[i*COUNT+j] = 0xdeadbeef; + } + } + MPI_Iscatter(buf, COUNT, MPI_INT, recvbuf, COUNT, MPI_INT, 0, comm, req); + break; + + case 10: /* MPI_Iscatterv */ + for (i = 0; i < size; ++i) { + /* weak test, just test the regular case where all counts are equal */ + sendcounts[i] = COUNT; + sdispls[i] = i * COUNT; + for (j = 0; j < COUNT; ++j) { + if (rank == 0) + buf[i*COUNT+j] = i + j; + else + buf[i*COUNT+j] = 0xdeadbeef; + recvbuf[i*COUNT+j] = 0xdeadbeef; + } + } + MPI_Iscatterv(buf, sendcounts, sdispls, MPI_INT, recvbuf, COUNT, MPI_INT, 0, comm, req); + break; + + case 11: /* MPI_Ireduce_scatter */ + for (i = 0; i < size; ++i) { + recvcounts[i] = COUNT; + for (j = 0; j < COUNT; ++j) { + buf[i*COUNT+j] = rank + i; + recvbuf[i*COUNT+j] = 0xdeadbeef; + } + } + MPI_Ireduce_scatter(buf, recvbuf, recvcounts, MPI_INT, MPI_SUM, comm, req); + break; + + case 12: /* MPI_Ireduce_scatter_block */ + for (i = 0; i < size; ++i) { + for (j = 0; j < COUNT; ++j) { + buf[i*COUNT+j] = rank + i; + recvbuf[i*COUNT+j] = 0xdeadbeef; + } + } + MPI_Ireduce_scatter_block(buf, recvbuf, COUNT, MPI_INT, MPI_SUM, comm, req); + break; + + case 13: /* MPI_Igatherv */ + for (i = 0; i < size*COUNT; ++i) { + buf[i] = 0xdeadbeef; + recvbuf[i] = 0xdeadbeef; + } + for (i = 0; i < COUNT; ++i) { + buf[i] = rank + i; + } + for (i = 0; i < size; ++i) { + recvcounts[i] = COUNT; + rdispls[i] = i * COUNT; + } + MPI_Igatherv(buf, COUNT, MPI_INT, recvbuf, recvcounts, rdispls, MPI_INT, 0, comm, req); + break; + + case 14: /* MPI_Ialltoall */ + for (i = 0; i < size; ++i) { + for (j = 0; j < COUNT; ++j) { + buf[i*COUNT+j] = rank + (i * j); + recvbuf[i*COUNT+j] = 0xdeadbeef; + } + } + MPI_Ialltoall(buf, COUNT, MPI_INT, recvbuf, COUNT, MPI_INT, comm, req); + break; + + case 15: /* MPI_Iallgather */ + for (i = 0; i < size*COUNT; ++i) { + buf[i] = rank + i; + recvbuf[i] = 0xdeadbeef; + } + MPI_Iallgather(buf, COUNT, MPI_INT, recvbuf, COUNT, MPI_INT, comm, req); + break; + + case 16: /* MPI_Iallgatherv */ + for (i = 0; i < size; ++i) { + for (j = 0; j < COUNT; ++j) { + recvbuf[i*COUNT+j] = 0xdeadbeef; + } + recvcounts[i] = COUNT; + rdispls[i] = i * COUNT; + } + for (i = 0; i < COUNT; ++i) + buf[i] = rank + i; + MPI_Iallgatherv(buf, COUNT, MPI_INT, recvbuf, recvcounts, rdispls, MPI_INT, comm, req); + break; + + case 17: /* MPI_Iscan */ + for (i = 0; i < COUNT; ++i) { + buf[i] = rank + i; + recvbuf[i] = 0xdeadbeef; + } + MPI_Iscan(buf, recvbuf, COUNT, MPI_INT, MPI_SUM, comm, req); + break; + + case 18: /* MPI_Iexscan */ + for (i = 0; i < COUNT; ++i) { + buf[i] = rank + i; + recvbuf[i] = 0xdeadbeef; + } + MPI_Iexscan(buf, recvbuf, COUNT, MPI_INT, MPI_SUM, comm, req); + break; + + case 19: /* MPI_Ialltoallw (a weak test, neither irregular nor sparse) */ + for (i = 0; i < size; ++i) { + sendcounts[i] = COUNT; + recvcounts[i] = COUNT; + sdispls[i] = COUNT * i * sizeof(int); + rdispls[i] = COUNT * i * sizeof(int); + sendtypes[i] = MPI_INT; + recvtypes[i] = MPI_INT; + for (j = 0; j < COUNT; ++j) { + buf[i*COUNT+j] = rank + (i * j); + recvbuf[i*COUNT+j] = 0xdeadbeef; + } + } + MPI_Ialltoallw(buf, sendcounts, sdispls, sendtypes, recvbuf, recvcounts, rdispls, recvtypes, comm, req); + break; + + case 20: /* basic pt2pt MPI_Isend/MPI_Irecv pairing */ + /* even ranks send to odd ranks, but only if we have a full pair */ + if ((rank % 2 != 0) || (rank != size-1)) { + for (j = 0; j < COUNT; ++j) { + buf[j] = j; + recvbuf[j] = 0xdeadbeef; + } + if (rank % 2 == 0) + MPI_Isend(buf, COUNT, MPI_INT, rank+1, 5, comm, req); + else + MPI_Irecv(recvbuf, COUNT, MPI_INT, rank-1, 5, comm, req); + } + break; + + default: + fprintf(stderr, "unexpected value for l->case_num=%d)\n", (l->case_num)); + MPI_Abort(comm, 1); + break; + } +} + +static void check_after_completion(struct laundry *l) +{ + int i, j; + int rank, size; + MPI_Comm comm = l->comm; + int *buf = l->buf; + int *recvbuf = l->recvbuf; + int *sendcounts = l->sendcounts; + int *recvcounts = l->recvcounts; + int *sdispls = l->sdispls; + int *rdispls = l->rdispls; + int *sendtypes = l->sendtypes; + int *recvtypes = l->recvtypes; + char *buf_alias = (char *)buf; + + MPI_Comm_rank(comm, &rank); + MPI_Comm_size(comm, &size); + + /* these cases all correspond to cases in start_random_nonblocking */ + switch (l->case_num) { + case 0: /* MPI_Ibcast */ + for (i = 0; i < COUNT; ++i) { + if (buf[i] != i) + printf("buf[%d]=%d i=%d\n", i, buf[i], i); + my_assert(buf[i] == i); + } + break; + + case 1: /* MPI_Ibcast (again, but designed to stress scatter/allgather impls) */ + for (i = 0; i < PRIME; ++i) { + if (buf_alias[i] != i) + printf("buf_alias[%d]=%d i=%d\n", i, buf_alias[i], i); + my_assert(buf_alias[i] == i); + } + break; + + case 2: /* MPI_Ibarrier */ + /* nothing to check */ + break; + + case 3: /* MPI_Ireduce */ + if (rank == 0) { + for (i = 0; i < COUNT; ++i) { + if (recvbuf[i] != ((size * (size-1) / 2) + (i * size))) + printf("got recvbuf[%d]=%d, expected %d\n", i, recvbuf[i], ((size * (size-1) / 2) + (i * size))); + my_assert(recvbuf[i] == ((size * (size-1) / 2) + (i * size))); + } + } + break; + + case 4: /* same again, use a user op and free it before the wait */ + if (rank == 0) { + for (i = 0; i < COUNT; ++i) { + if (recvbuf[i] != ((size * (size-1) / 2) + (i * size))) + printf("got recvbuf[%d]=%d, expected %d\n", i, recvbuf[i], ((size * (size-1) / 2) + (i * size))); + my_assert(recvbuf[i] == ((size * (size-1) / 2) + (i * size))); + } + } + break; + + case 5: /* MPI_Iallreduce */ + for (i = 0; i < COUNT; ++i) { + if (recvbuf[i] != ((size * (size-1) / 2) + (i * size))) + printf("got recvbuf[%d]=%d, expected %d\n", i, recvbuf[i], ((size * (size-1) / 2) + (i * size))); + my_assert(recvbuf[i] == ((size * (size-1) / 2) + (i * size))); + } + break; + + case 6: /* MPI_Ialltoallv (a weak test, neither irregular nor sparse) */ + for (i = 0; i < size; ++i) { + for (j = 0; j < COUNT; ++j) { + /*printf("recvbuf[%d*COUNT+%d]=%d, expecting %d\n", i, j, recvbuf[i*COUNT+j], (i + (rank * j)));*/ + my_assert(recvbuf[i*COUNT+j] == (i + (rank * j))); + } + } + break; + + case 7: /* MPI_Igather */ + if (rank == 0) { + for (i = 0; i < size; ++i) { + for (j = 0; j < COUNT; ++j) { + my_assert(recvbuf[i*COUNT+j] == i + j); + } + } + } + else { + for (i = 0; i < size*COUNT; ++i) { + my_assert(recvbuf[i] == 0xdeadbeef); + } + } + break; + + case 8: /* same test again, just use a dup'ed datatype and free it before the wait */ + if (rank == 0) { + for (i = 0; i < size; ++i) { + for (j = 0; j < COUNT; ++j) { + my_assert(recvbuf[i*COUNT+j] == i + j); + } + } + } + else { + for (i = 0; i < size*COUNT; ++i) { + my_assert(recvbuf[i] == 0xdeadbeef); + } + } + break; + + case 9: /* MPI_Iscatter */ + for (j = 0; j < COUNT; ++j) { + my_assert(recvbuf[j] == rank + j); + } + if (rank != 0) { + for (i = 0; i < size*COUNT; ++i) { + /* check we didn't corrupt the sendbuf somehow */ + my_assert(buf[i] == 0xdeadbeef); + } + } + break; + + case 10: /* MPI_Iscatterv */ + for (j = 0; j < COUNT; ++j) { + my_assert(recvbuf[j] == rank + j); + } + if (rank != 0) { + for (i = 0; i < size*COUNT; ++i) { + /* check we didn't corrupt the sendbuf somehow */ + my_assert(buf[i] == 0xdeadbeef); + } + } + for (i = 1; i < size; ++i) { + for (j = 0; j < COUNT; ++j) { + /* check we didn't corrupt the rest of the recvbuf */ + my_assert(recvbuf[i*COUNT+j] == 0xdeadbeef); + } + } + break; + + case 11: /* MPI_Ireduce_scatter */ + for (j = 0; j < COUNT; ++j) { + my_assert(recvbuf[j] == (size * rank + ((size - 1) * size) / 2)); + } + for (i = 1; i < size; ++i) { + for (j = 0; j < COUNT; ++j) { + /* check we didn't corrupt the rest of the recvbuf */ + my_assert(recvbuf[i*COUNT+j] == 0xdeadbeef); + } + } + break; + + case 12: /* MPI_Ireduce_scatter_block */ + for (j = 0; j < COUNT; ++j) { + my_assert(recvbuf[j] == (size * rank + ((size - 1) * size) / 2)); + } + for (i = 1; i < size; ++i) { + for (j = 0; j < COUNT; ++j) { + /* check we didn't corrupt the rest of the recvbuf */ + my_assert(recvbuf[i*COUNT+j] == 0xdeadbeef); + } + } + break; + + case 13: /* MPI_Igatherv */ + if (rank == 0) { + for (i = 0; i < size; ++i) { + for (j = 0; j < COUNT; ++j) { + my_assert(recvbuf[i*COUNT+j] == i + j); + } + } + } + else { + for (i = 0; i < size*COUNT; ++i) { + my_assert(recvbuf[i] == 0xdeadbeef); + } + } + break; + + case 14: /* MPI_Ialltoall */ + for (i = 0; i < size; ++i) { + for (j = 0; j < COUNT; ++j) { + /*printf("recvbuf[%d*COUNT+%d]=%d, expecting %d\n", i, j, recvbuf[i*COUNT+j], (i + (i * j)));*/ + my_assert(recvbuf[i*COUNT+j] == (i + (rank * j))); + } + } + break; + + case 15: /* MPI_Iallgather */ + for (i = 0; i < size; ++i) { + for (j = 0; j < COUNT; ++j) { + my_assert(recvbuf[i*COUNT+j] == i + j); + } + } + break; + + case 16: /* MPI_Iallgatherv */ + for (i = 0; i < size; ++i) { + for (j = 0; j < COUNT; ++j) { + my_assert(recvbuf[i*COUNT+j] == i + j); + } + } + break; + + case 17: /* MPI_Iscan */ + for (i = 0; i < COUNT; ++i) { + my_assert(recvbuf[i] == ((rank * (rank+1) / 2) + (i * (rank + 1)))); + } + break; + + case 18: /* MPI_Iexscan */ + for (i = 0; i < COUNT; ++i) { + if (rank == 0) + my_assert(recvbuf[i] == 0xdeadbeef); + else + my_assert(recvbuf[i] == ((rank * (rank+1) / 2) + (i * (rank + 1)) - (rank + i))); + } + break; + + case 19: /* MPI_Ialltoallw (a weak test, neither irregular nor sparse) */ + for (i = 0; i < size; ++i) { + for (j = 0; j < COUNT; ++j) { + /*printf("recvbuf[%d*COUNT+%d]=%d, expecting %d\n", i, j, recvbuf[i*COUNT+j], (i + (rank * j)));*/ + my_assert(recvbuf[i*COUNT+j] == (i + (rank * j))); + } + } + break; + + case 20: /* basic pt2pt MPI_Isend/MPI_Irecv pairing */ + /* even ranks send to odd ranks, but only if we have a full pair */ + if ((rank % 2 != 0) || (rank != size-1)) { + for (j = 0; j < COUNT; ++j) { + /* only odd procs did a recv */ + if (rank % 2 == 0) { + my_assert(recvbuf[j] == 0xdeadbeef); + } + else { + if (recvbuf[j] != j) printf("recvbuf[%d]=%d j=%d\n", j, recvbuf[j], j); + my_assert(recvbuf[j] == j); + } + } + } + break; + + default: + printf("invalid case_num (%d) detected\n", l->case_num); + assert(0); + break; + } +} +#undef NUM_CASES + +static void complete_something_somehow(unsigned int rndnum, int numreqs, MPI_Request reqs[], int *outcount, int indices[]) +{ + int i, idx, flag; + +#define COMPLETION_CASES (8) + switch (rand_range(rndnum, 0, COMPLETION_CASES)) { + case 0: + MPI_Waitall(numreqs, reqs, MPI_STATUSES_IGNORE); + *outcount = numreqs; + for (i = 0; i < numreqs; ++i) { + indices[i] = i; + } + break; + + case 1: + MPI_Testsome(numreqs, reqs, outcount, indices, MPI_STATUS_IGNORE); + if (*outcount == MPI_UNDEFINED) { + *outcount = 0; + } + break; + + case 2: + MPI_Waitsome(numreqs, reqs, outcount, indices, MPI_STATUS_IGNORE); + if (*outcount == MPI_UNDEFINED) { + *outcount = 0; + } + break; + + case 3: + MPI_Waitany(numreqs, reqs, &idx, MPI_STATUS_IGNORE); + if (idx == MPI_UNDEFINED) { + *outcount = 0; + } + else { + *outcount = 1; + indices[0] = idx; + } + break; + + case 4: + MPI_Testany(numreqs, reqs, &idx, &flag, MPI_STATUS_IGNORE); + if (idx == MPI_UNDEFINED) { + *outcount = 0; + } + else { + *outcount = 1; + indices[0] = idx; + } + break; + + case 5: + MPI_Testall(numreqs, reqs, &flag, MPI_STATUSES_IGNORE); + if (flag) { + *outcount = numreqs; + for (i = 0; i < numreqs; ++i) { + indices[i] = i; + } + } + else { + *outcount = 0; + } + break; + + case 6: + /* select a new random index and wait on it */ + rndnum = gen_prn(rndnum); + idx = rand_range(rndnum, 0, numreqs); + MPI_Wait(&reqs[idx], MPI_STATUS_IGNORE); + *outcount = 1; + indices[0] = idx; + break; + + case 7: + /* select a new random index and wait on it */ + rndnum = gen_prn(rndnum); + idx = rand_range(rndnum, 0, numreqs); + MPI_Test(&reqs[idx], &flag, MPI_STATUS_IGNORE); + *outcount = (flag ? 1 : 0); + indices[0] = idx; + break; + + default: + assert(0); + break; + } +#undef COMPLETION_CASES +} +#endif /* defined(TEST_NBC_ROUTINES) */ + +int main(int argc, char **argv) +{ + int i, num_posted, num_completed; + int wrank, wsize; + unsigned int seed = 0x10bc; + unsigned int post_seq, complete_seq; +#if defined(TEST_NBC_ROUTINES) + struct laundry larr[WINDOW]; +#endif + MPI_Request reqs[WINDOW]; + int outcount; + int indices[WINDOW]; + MPI_Comm comms[NUM_COMMS]; + MPI_Comm comm; + + MPI_Init(&argc, &argv); + MPI_Comm_rank(MPI_COMM_WORLD, &wrank); + MPI_Comm_size(MPI_COMM_WORLD, &wsize); + +#if defined(TEST_NBC_ROUTINES) + + /* it is critical that all processes in the communicator start with a + * consistent value for "post_seq" */ + post_seq = complete_seq = gen_prn(seed); + + num_completed = 0; + num_posted = 0; + + /* construct all of the communicators, just dups of comm world for now */ + for (i = 0; i < NUM_COMMS; ++i) { + MPI_Comm_dup(MPI_COMM_WORLD, &comms[i]); + } + + /* fill the entire window of ops */ + for (i = 0; i < WINDOW; ++i) { + reqs[i] = MPI_REQUEST_NULL; + memset(&larr[i], 0, sizeof(struct laundry)); + larr[i].case_num = -1; + + /* randomly select a comm, using a new seed to avoid correlating + * particular kinds of NBC ops with particular communicators */ + comm = comms[rand_range(gen_prn(post_seq), 0, NUM_COMMS)]; + + start_random_nonblocking(comm, post_seq, &reqs[i], &larr[i]); + ++num_posted; + post_seq = gen_prn(post_seq); + } + + /* now loop repeatedly, completing ops with "random" completion functions, + * until we've posted and completed MAIN_ITERATIONS ops */ + while (num_completed < MAIN_ITERATIONS) { + complete_something_somehow(complete_seq, WINDOW, reqs, &outcount, indices); + complete_seq = gen_prn(complete_seq); + for (i = 0; i < outcount; ++i) { + int idx = indices[i]; + assert(reqs[idx] == MPI_REQUEST_NULL); + if (larr[idx].case_num != -1) { + check_after_completion(&larr[idx]); + cleanup_laundry(&larr[idx]); + ++num_completed; + if (num_posted < MAIN_ITERATIONS) { + comm = comms[rand_range(gen_prn(post_seq), 0, NUM_COMMS)]; + start_random_nonblocking(comm, post_seq, &reqs[idx], &larr[idx]); + ++num_posted; + post_seq = gen_prn(post_seq); + } + } + } + + /* "randomly" and infrequently introduce some jitter into the system */ + if (0 == rand_range(gen_prn(complete_seq + wrank), 0, CHANCE_OF_SLEEP)) { + usleep(JITTER_DELAY); /* take a short nap */ + } + } + + for (i = 0; i < NUM_COMMS; ++i) { + MPI_Comm_free(&comms[i]); + } + +#endif /* defined(TEST_NBC_ROUTINES) */ + + if (wrank == 0) { + if (errs) + printf("found %d errors\n", errs); + else + printf(" No errors\n"); + } + + MPI_Finalize(); + + return 0; +} + diff --git a/teshsuite/smpi/mpich3-test/coll/op_commutative.c b/teshsuite/smpi/mpich3-test/coll/op_commutative.c new file mode 100644 index 0000000000..cc2b80a872 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/coll/op_commutative.c @@ -0,0 +1,107 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2009 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include "mpi.h" +#include +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "A simple test of MPI_Op_create/commute/free"; +*/ + +static int errs = 0; + +/* +static void comm_user_op(void *invec, void *inoutvec, int *len, MPI_Datatype *datatype) +{ + user_op(invec, inoutvec, len, datatype); +} +*/ + +/* +static void noncomm_user_op(void *invec, void *inoutvec, int *len, MPI_Datatype *datatype) +{ + user_op(invec, inoutvec, len, datatype); +} +*/ + +static void user_op(void *invec, void *inoutvec, int *len, MPI_Datatype *datatype) +{ + int i; + int *invec_int = (int *)invec; + int *inoutvec_int = (int *)inoutvec; + + if (*datatype != MPI_INT) { + ++errs; + printf("invalid datatype passed to user_op"); + return; + } + + for (i = 0; i < *len; ++i) { + inoutvec_int[i] = invec_int[i] * 2 + inoutvec_int[i]; + } +} + + +int main( int argc, char *argv[] ) +{ + MPI_Op c_uop = MPI_OP_NULL; + MPI_Op nc_uop = MPI_OP_NULL; + int is_commutative = 0; + + MTest_Init(&argc, &argv); + + /* make sure that user-define ops work too */ + MPI_Op_create(&user_op, 1/*commute*/, &c_uop); + MPI_Op_create(&user_op, 0/*!commute*/, &nc_uop); + +#if MTEST_HAVE_MIN_MPI_VERSION(2,2) + /* this function was added in MPI-2.2 */ + +#define CHECK_COMMUTATIVE(op_) \ + do { \ + MPI_Op_commutative((op_), &is_commutative); \ + if (!is_commutative) { ++errs; } \ + } while (0) + + /* Check all predefined reduction operations for commutivity. + * This list is from section 5.9.2 of the MPI-2.1 standard */ + CHECK_COMMUTATIVE(MPI_MAX); + CHECK_COMMUTATIVE(MPI_MIN); + CHECK_COMMUTATIVE(MPI_SUM); + CHECK_COMMUTATIVE(MPI_PROD); + CHECK_COMMUTATIVE(MPI_LAND); + CHECK_COMMUTATIVE(MPI_BAND); + CHECK_COMMUTATIVE(MPI_LOR); + CHECK_COMMUTATIVE(MPI_BOR); + CHECK_COMMUTATIVE(MPI_LXOR); + CHECK_COMMUTATIVE(MPI_BXOR); + CHECK_COMMUTATIVE(MPI_MAXLOC); + CHECK_COMMUTATIVE(MPI_MINLOC); + +#undef CHECK_COMMUTATIVE + + MPI_Op_commutative(c_uop, &is_commutative); + if (!is_commutative) { + ++errs; + } + + /* also check our non-commutative user defined operation */ + MPI_Op_commutative(nc_uop, &is_commutative); + if (is_commutative) { + ++errs; + } +#endif + + MPI_Op_free(&nc_uop); + MPI_Op_free(&c_uop); + + MTest_Finalize(errs); + MPI_Finalize(); + return 0; +} + diff --git a/teshsuite/smpi/mpich3-test/coll/opband.c b/teshsuite/smpi/mpich3-test/coll/opband.c new file mode 100644 index 0000000000..b8ac9d0a7c --- /dev/null +++ b/teshsuite/smpi/mpich3-test/coll/opband.c @@ -0,0 +1,370 @@ +/* -*- 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 "mpitestconf.h" +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Test MPI_BAND operations on optional datatypes dupported by MPICH"; +*/ + +/* + * This test looks at the handling of logical and for types that are not + * integers or are not required integers (e.g., long long). MPICH allows + * these as well. A strict MPI test should not include this test. + */ +int main( int argc, char *argv[] ) +{ + int errs = 0; + int rc; + int rank, size; + MPI_Comm comm; + char cinbuf[3], coutbuf[3]; + signed char scinbuf[3], scoutbuf[3]; + unsigned char ucinbuf[3], ucoutbuf[3]; + short sinbuf[3], soutbuf[3]; + unsigned short usinbuf[3], usoutbuf[3]; + long linbuf[3], loutbuf[3]; + unsigned long ulinbuf[3], uloutbuf[3]; + unsigned uinbuf[3], uoutbuf[3]; + + + MTest_Init( &argc, &argv ); + + comm = MPI_COMM_WORLD; + /* Set errors return so that we can provide better information + should a routine reject one of the operand/datatype pairs */ + MPI_Errhandler_set( comm, MPI_ERRORS_RETURN ); + + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + +#ifndef USE_STRICT_MPI + /* char */ + MTestPrintfMsg( 10, "Reduce of MPI_CHAR\n" ); + cinbuf[0] = 0xff; + cinbuf[1] = 0; + cinbuf[2] = (rank > 0) ? 0xff : 0xf0; + + coutbuf[0] = 0; + coutbuf[1] = 1; + coutbuf[2] = 1; + rc = MPI_Reduce( cinbuf, coutbuf, 3, MPI_CHAR, MPI_BAND, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_BAND and MPI_CHAR", rc ); + errs++; + } + else { + if (rank == 0) { + if (coutbuf[0] != (char)0xff) { + errs++; + fprintf( stderr, "char BAND(1) test failed\n" ); + } + if (coutbuf[1]) { + errs++; + fprintf( stderr, "char BAND(0) test failed\n" ); + } + if (coutbuf[2] != (char)0xf0 && size > 1) { + errs++; + fprintf( stderr, "char BAND(>) test failed\n" ); + } + } + } +#endif /* USE_STRICT_MPI */ + + /* signed char */ + MTestPrintfMsg( 10, "Reduce of MPI_SIGNED_CHAR\n" ); + scinbuf[0] = 0xff; + scinbuf[1] = 0; + scinbuf[2] = (rank > 0) ? 0xff : 0xf0; + + scoutbuf[0] = 0; + scoutbuf[1] = 1; + scoutbuf[2] = 1; + rc = MPI_Reduce( scinbuf, scoutbuf, 3, MPI_SIGNED_CHAR, MPI_BAND, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_BAND and MPI_SIGNED_CHAR", rc ); + errs++; + } + else { + if (rank == 0) { + if (scoutbuf[0] != (signed char)0xff) { + errs++; + fprintf( stderr, "signed char BAND(1) test failed\n" ); + } + if (scoutbuf[1]) { + errs++; + fprintf( stderr, "signed char BAND(0) test failed\n" ); + } + if (scoutbuf[2] != (signed char)0xf0 && size > 1) { + errs++; + fprintf( stderr, "signed char BAND(>) test failed\n" ); + } + } + } + + /* unsigned char */ + MTestPrintfMsg( 10, "Reduce of MPI_UNSIGNED_CHAR\n" ); + ucinbuf[0] = 0xff; + ucinbuf[1] = 0; + ucinbuf[2] = (rank > 0) ? 0xff : 0xf0; + + ucoutbuf[0] = 0; + ucoutbuf[1] = 1; + ucoutbuf[2] = 1; + rc = MPI_Reduce( ucinbuf, ucoutbuf, 3, MPI_UNSIGNED_CHAR, MPI_BAND, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_BAND and MPI_UNSIGNED_CHAR", rc ); + errs++; + } + else { + if (rank == 0) { + if (ucoutbuf[0] != 0xff) { + errs++; + fprintf( stderr, "unsigned char BAND(1) test failed\n" ); + } + if (ucoutbuf[1]) { + errs++; + fprintf( stderr, "unsigned char BAND(0) test failed\n" ); + } + if (ucoutbuf[2] != 0xf0 && size > 1) { + errs++; + fprintf( stderr, "unsigned char BAND(>) test failed\n" ); + } + } + } + + /* bytes */ + MTestPrintfMsg( 10, "Reduce of MPI_BYTE\n" ); + cinbuf[0] = 0xff; + cinbuf[1] = 0; + cinbuf[2] = (rank > 0) ? 0xff : 0xf0; + + coutbuf[0] = 0; + coutbuf[1] = 1; + coutbuf[2] = 1; + rc = MPI_Reduce( cinbuf, coutbuf, 3, MPI_BYTE, MPI_BAND, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_BAND and MPI_BYTE", rc ); + errs++; + } + else { + if (rank == 0) { + if (coutbuf[0] != (char)0xff) { + errs++; + fprintf( stderr, "byte BAND(1) test failed\n" ); + } + if (coutbuf[1]) { + errs++; + fprintf( stderr, "byte BAND(0) test failed\n" ); + } + if (coutbuf[2] != (char)0xf0 && size > 1) { + errs++; + fprintf( stderr, "byte BAND(>) test failed\n" ); + } + } + } + + /* short */ + MTestPrintfMsg( 10, "Reduce of MPI_SHORT\n" ); + sinbuf[0] = 0xffff; + sinbuf[1] = 0; + sinbuf[2] = (rank > 0) ? 0xffff : 0xf0f0; + + soutbuf[0] = 0; + soutbuf[1] = 1; + soutbuf[2] = 1; + rc = MPI_Reduce( sinbuf, soutbuf, 3, MPI_SHORT, MPI_BAND, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_BAND and MPI_SHORT", rc ); + errs++; + } + else { + if (rank == 0) { + if (soutbuf[0] != (short)0xffff) { + errs++; + fprintf( stderr, "short BAND(1) test failed\n" ); + } + if (soutbuf[1]) { + errs++; + fprintf( stderr, "short BAND(0) test failed\n" ); + } + if (soutbuf[2] != (short)0xf0f0 && size > 1) { + errs++; + fprintf( stderr, "short BAND(>) test failed\n" ); + } + } + } + + MTestPrintfMsg( 10, "Reduce of MPI_UNSIGNED_SHORT\n" ); + /* unsigned short */ + usinbuf[0] = 0xffff; + usinbuf[1] = 0; + usinbuf[2] = (rank > 0) ? 0xffff : 0xf0f0; + + usoutbuf[0] = 0; + usoutbuf[1] = 1; + usoutbuf[2] = 1; + rc = MPI_Reduce( usinbuf, usoutbuf, 3, MPI_UNSIGNED_SHORT, MPI_BAND, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_BAND and MPI_UNSIGNED_SHORT", rc ); + errs++; + } + else { + if (rank == 0) { + if (usoutbuf[0] != 0xffff) { + errs++; + fprintf( stderr, "short BAND(1) test failed\n" ); + } + if (usoutbuf[1]) { + errs++; + fprintf( stderr, "short BAND(0) test failed\n" ); + } + if (usoutbuf[2] != 0xf0f0 && size > 1) { + errs++; + fprintf( stderr, "short BAND(>) test failed\n" ); + } + } + } + + /* unsigned */ + MTestPrintfMsg( 10, "Reduce of MPI_UNSIGNED\n" ); + uinbuf[0] = 0xffffffff; + uinbuf[1] = 0; + uinbuf[2] = (rank > 0) ? 0xffffffff : 0xf0f0f0f0; + + uoutbuf[0] = 0; + uoutbuf[1] = 1; + uoutbuf[2] = 1; + rc = MPI_Reduce( uinbuf, uoutbuf, 3, MPI_UNSIGNED, MPI_BAND, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_BAND and MPI_UNSIGNED", rc ); + errs++; + } + else { + if (rank == 0) { + if (uoutbuf[0] != 0xffffffff) { + errs++; + fprintf( stderr, "unsigned BAND(1) test failed\n" ); + } + if (uoutbuf[1]) { + errs++; + fprintf( stderr, "unsigned BAND(0) test failed\n" ); + } + if (uoutbuf[2] != 0xf0f0f0f0 && size > 1) { + errs++; + fprintf( stderr, "unsigned BAND(>) test failed\n" ); + } + } + } + + /* long */ + MTestPrintfMsg( 10, "Reduce of MPI_LONG\n" ); + linbuf[0] = 0xffffffff; + linbuf[1] = 0; + linbuf[2] = (rank > 0) ? 0xffffffff : 0xf0f0f0f0; + + loutbuf[0] = 0; + loutbuf[1] = 1; + loutbuf[2] = 1; + rc = MPI_Reduce( linbuf, loutbuf, 3, MPI_LONG, MPI_BAND, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_BAND and MPI_LONG", rc ); + errs++; + } + else { + if (rank == 0) { + if (loutbuf[0] != 0xffffffff) { + errs++; + fprintf( stderr, "long BAND(1) test failed\n" ); + } + if (loutbuf[1]) { + errs++; + fprintf( stderr, "long BAND(0) test failed\n" ); + } + if (loutbuf[2] != 0xf0f0f0f0 && size > 1) { + errs++; + fprintf( stderr, "long BAND(>) test failed\n" ); + } + } + } + + MTestPrintfMsg( 10, "Reduce of MPI_UNSIGNED_LONG\n" ); + /* unsigned long */ + ulinbuf[0] = 0xffffffff; + ulinbuf[1] = 0; + ulinbuf[2] = (rank > 0) ? 0xffffffff : 0xf0f0f0f0; + + uloutbuf[0] = 0; + uloutbuf[1] = 1; + uloutbuf[2] = 1; + rc = MPI_Reduce( ulinbuf, uloutbuf, 3, MPI_UNSIGNED_LONG, MPI_BAND, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_BAND and MPI_UNSIGNED_LONG", rc ); + errs++; + } + else { + if (rank == 0) { + if (uloutbuf[0] != 0xffffffff) { + errs++; + fprintf( stderr, "unsigned long BAND(1) test failed\n" ); + } + if (uloutbuf[1]) { + errs++; + fprintf( stderr, "unsigned long BAND(0) test failed\n" ); + } + if (uloutbuf[2] != 0xf0f0f0f0 && size > 1) { + errs++; + fprintf( stderr, "unsigned long BAND(>) test failed\n" ); + } + } + } + +#ifdef HAVE_LONG_LONG + { + long long llinbuf[3], lloutbuf[3]; + /* long long */ + llinbuf[0] = 0xffffffff; + llinbuf[1] = 0; + llinbuf[2] = (rank > 0) ? 0xffffffff : 0xf0f0f0f0; + + lloutbuf[0] = 0; + lloutbuf[1] = 1; + lloutbuf[2] = 1; + if (MPI_LONG_LONG != MPI_DATATYPE_NULL) { + MTestPrintfMsg( 10, "Reduce of MPI_LONG_LONG\n" ); + rc = MPI_Reduce( llinbuf, lloutbuf, 3, MPI_LONG_LONG, MPI_BAND, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_BAND and MPI_LONG_LONG", rc ); + errs++; + } + else { + if (rank == 0) { + if (lloutbuf[0] != 0xffffffff) { + errs++; + fprintf( stderr, "long long BAND(1) test failed\n" ); + } + if (lloutbuf[1]) { + errs++; + fprintf( stderr, "long long BAND(0) test failed\n" ); + } + if (lloutbuf[2] != 0xf0f0f0f0 && size > 1) { + errs++; + fprintf( stderr, "long long BAND(>) test failed\n" ); + } + } + } + } + } +#endif + + MPI_Errhandler_set( comm, MPI_ERRORS_ARE_FATAL ); + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/coll/opbor.c b/teshsuite/smpi/mpich3-test/coll/opbor.c new file mode 100644 index 0000000000..7c4e5d6541 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/coll/opbor.c @@ -0,0 +1,402 @@ +/* -*- 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 "mpitestconf.h" +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Test MPI_BOR operations on optional datatypes dupported by MPICH"; +*/ + +/* + * This test looks at the handling of logical and for types that are not + * integers or are not required integers (e.g., long long). MPICH allows + * these as well. A strict MPI test should not include this test. + */ +int main( int argc, char *argv[] ) +{ + int errs = 0; + int rc; + int rank, size; + MPI_Comm comm; + char cinbuf[3], coutbuf[3]; + signed char scinbuf[3], scoutbuf[3]; + unsigned char ucinbuf[3], ucoutbuf[3]; + short sinbuf[3], soutbuf[3]; + unsigned short usinbuf[3], usoutbuf[3]; + long linbuf[3], loutbuf[3]; + unsigned long ulinbuf[3], uloutbuf[3]; + unsigned uinbuf[3], uoutbuf[3]; + int iinbuf[3], ioutbuf[3]; + + + MTest_Init( &argc, &argv ); + + comm = MPI_COMM_WORLD; + /* Set errors return so that we can provide better information + should a routine reject one of the operand/datatype pairs */ + MPI_Errhandler_set( comm, MPI_ERRORS_RETURN ); + + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + +#ifndef USE_STRICT_MPI + /* char */ + MTestPrintfMsg( 10, "Reduce of MPI_CHAR\n" ); + cinbuf[0] = 0xff; + cinbuf[1] = 0; + cinbuf[2] = (rank > 0) ? 0x3c : 0xc3; + + coutbuf[0] = 0; + coutbuf[1] = 1; + coutbuf[2] = 1; + rc = MPI_Reduce( cinbuf, coutbuf, 3, MPI_CHAR, MPI_BOR, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_BOR and MPI_CHAR", rc ); + errs++; + } + else { + if (rank == 0) { + if (coutbuf[0] != (char)0xff) { + errs++; + fprintf( stderr, "char BOR(1) test failed\n" ); + } + if (coutbuf[1]) { + errs++; + fprintf( stderr, "char BOR(0) test failed\n" ); + } + if (coutbuf[2] != (char)0xff && size > 1) { + errs++; + fprintf( stderr, "char BOR(>) test failed\n" ); + } + } + } +#endif /* USE_STRICT_MPI */ + + /* signed char */ + MTestPrintfMsg( 10, "Reduce of MPI_SIGNED_CHAR\n" ); + scinbuf[0] = 0xff; + scinbuf[1] = 0; + scinbuf[2] = (rank > 0) ? 0x3c : 0xc3; + + scoutbuf[0] = 0; + scoutbuf[1] = 1; + scoutbuf[2] = 1; + rc = MPI_Reduce( scinbuf, scoutbuf, 3, MPI_SIGNED_CHAR, MPI_BOR, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_BOR and MPI_SIGNED_CHAR", rc ); + errs++; + } + else { + if (rank == 0) { + if (scoutbuf[0] != (signed char)0xff) { + errs++; + fprintf( stderr, "signed char BOR(1) test failed\n" ); + } + if (scoutbuf[1]) { + errs++; + fprintf( stderr, "signed char BOR(0) test failed\n" ); + } + if (scoutbuf[2] != (signed char)0xff && size > 1) { + errs++; + fprintf( stderr, "signed char BOR(>) test failed\n" ); + } + } + } + + /* unsigned char */ + MTestPrintfMsg( 10, "Reduce of MPI_UNSIGNED_CHAR\n" ); + ucinbuf[0] = 0xff; + ucinbuf[1] = 0; + ucinbuf[2] = (rank > 0) ? 0x3c : 0xc3; + + ucoutbuf[0] = 0; + ucoutbuf[1] = 1; + ucoutbuf[2] = 1; + rc = MPI_Reduce( ucinbuf, ucoutbuf, 3, MPI_UNSIGNED_CHAR, MPI_BOR, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_BOR and MPI_UNSIGNED_CHAR", rc ); + errs++; + } + else { + if (rank == 0) { + if (ucoutbuf[0] != 0xff) { + errs++; + fprintf( stderr, "unsigned char BOR(1) test failed\n" ); + } + if (ucoutbuf[1]) { + errs++; + fprintf( stderr, "unsigned char BOR(0) test failed\n" ); + } + if (ucoutbuf[2] != 0xff && size > 1) { + errs++; + fprintf( stderr, "unsigned char BOR(>) test failed\n" ); + } + } + } + + /* bytes */ + MTestPrintfMsg( 10, "Reduce of MPI_BYTE\n" ); + cinbuf[0] = 0xff; + cinbuf[1] = 0; + cinbuf[2] = (rank > 0) ? 0x3c : 0xc3; + + coutbuf[0] = 0; + coutbuf[1] = 1; + coutbuf[2] = 1; + rc = MPI_Reduce( cinbuf, coutbuf, 3, MPI_BYTE, MPI_BOR, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_BOR and MPI_BYTE", rc ); + errs++; + } + else { + if (rank == 0) { + if (coutbuf[0] != (char)0xff) { + errs++; + fprintf( stderr, "byte BOR(1) test failed\n" ); + } + if (coutbuf[1]) { + errs++; + fprintf( stderr, "byte BOR(0) test failed\n" ); + } + if (coutbuf[2] != (char)0xff && size > 1) { + errs++; + fprintf( stderr, "byte BOR(>) test failed\n" ); + } + } + } + + /* short */ + MTestPrintfMsg( 10, "Reduce of MPI_SHORT\n" ); + sinbuf[0] = 0xffff; + sinbuf[1] = 0; + sinbuf[2] = (rank > 0) ? 0x3c3c : 0xc3c3; + + soutbuf[0] = 0; + soutbuf[1] = 1; + soutbuf[2] = 1; + rc = MPI_Reduce( sinbuf, soutbuf, 3, MPI_SHORT, MPI_BOR, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_BOR and MPI_SHORT", rc ); + errs++; + } + else { + if (rank == 0) { + if (soutbuf[0] != (short)0xffff) { + errs++; + fprintf( stderr, "short BOR(1) test failed\n" ); + } + if (soutbuf[1]) { + errs++; + fprintf( stderr, "short BOR(0) test failed\n" ); + } + if (soutbuf[2] != (short)0xffff && size > 1) { + errs++; + fprintf( stderr, "short BOR(>) test failed\n" ); + } + } + } + + /* unsigned short */ + MTestPrintfMsg( 10, "Reduce of MPI_UNSIGNED_SHORT\n" ); + usinbuf[0] = 0xffff; + usinbuf[1] = 0; + usinbuf[2] = (rank > 0) ? 0x3c3c : 0xc3c3; + + usoutbuf[0] = 0; + usoutbuf[1] = 1; + usoutbuf[2] = 1; + rc = MPI_Reduce( usinbuf, usoutbuf, 3, MPI_UNSIGNED_SHORT, MPI_BOR, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_BOR and MPI_UNSIGNED_SHORT", rc ); + errs++; + } + else { + if (rank == 0) { + if (usoutbuf[0] != 0xffff) { + errs++; + fprintf( stderr, "short BOR(1) test failed\n" ); + } + if (usoutbuf[1]) { + errs++; + fprintf( stderr, "short BOR(0) test failed\n" ); + } + if (usoutbuf[2] != 0xffff && size > 1) { + errs++; + fprintf( stderr, "short BOR(>) test failed\n" ); + } + } + } + + /* unsigned */ + MTestPrintfMsg( 10, "Reduce of MPI_UNSIGNED\n" ); + uinbuf[0] = 0xffffffff; + uinbuf[1] = 0; + uinbuf[2] = (rank > 0) ? 0x3c3c3c3c : 0xc3c3c3c3; + + uoutbuf[0] = 0; + uoutbuf[1] = 1; + uoutbuf[2] = 1; + rc = MPI_Reduce( uinbuf, uoutbuf, 3, MPI_UNSIGNED, MPI_BOR, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_BOR and MPI_UNSIGNED", rc ); + errs++; + } + else { + if (rank == 0) { + if (uoutbuf[0] != 0xffffffff) { + errs++; + fprintf( stderr, "unsigned BOR(1) test failed\n" ); + } + if (uoutbuf[1]) { + errs++; + fprintf( stderr, "unsigned BOR(0) test failed\n" ); + } + if (uoutbuf[2] != 0xffffffff && size > 1) { + errs++; + fprintf( stderr, "unsigned BOR(>) test failed\n" ); + } + } + } + + /* int */ + MTestPrintfMsg( 10, "Reduce of MPI_INT\n" ); + iinbuf[0] = 0xffffffff; + iinbuf[1] = 0; + iinbuf[2] = (rank > 0) ? 0x3c3c3c3c : 0xc3c3c3c3; + + ioutbuf[0] = 0; + ioutbuf[1] = 1; + ioutbuf[2] = 1; + rc = MPI_Reduce( iinbuf, ioutbuf, 3, MPI_INT, MPI_BOR, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_BOR and MPI_INT", rc ); + errs++; + } + else { + if (rank == 0) { + if (ioutbuf[0] != 0xffffffff) { + errs++; + fprintf( stderr, "int BOR(1) test failed\n" ); + } + if (ioutbuf[1]) { + errs++; + fprintf( stderr, "int BOR(0) test failed\n" ); + } + if (ioutbuf[2] != 0xffffffff && size > 1) { + errs++; + fprintf( stderr, "int BOR(>) test failed\n" ); + } + } + } + + /* long */ + MTestPrintfMsg( 10, "Reduce of MPI_LONG\n" ); + linbuf[0] = 0xffffffff; + linbuf[1] = 0; + linbuf[2] = (rank > 0) ? 0x3c3c3c3c : 0xc3c3c3c3; + + loutbuf[0] = 0; + loutbuf[1] = 1; + loutbuf[2] = 1; + rc = MPI_Reduce( linbuf, loutbuf, 3, MPI_LONG, MPI_BOR, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_BOR and MPI_LONG", rc ); + errs++; + } + else { + if (rank == 0) { + if (loutbuf[0] != 0xffffffff) { + errs++; + fprintf( stderr, "long BOR(1) test failed\n" ); + } + if (loutbuf[1]) { + errs++; + fprintf( stderr, "long BOR(0) test failed\n" ); + } + if (loutbuf[2] != 0xffffffff && size > 1) { + errs++; + fprintf( stderr, "long BOR(>) test failed\n" ); + } + } + } + + /* unsigned long */ + MTestPrintfMsg( 10, "Reduce of MPI_UNSIGNED_LONG\n" ); + ulinbuf[0] = 0xffffffff; + ulinbuf[1] = 0; + ulinbuf[2] = (rank > 0) ? 0x3c3c3c3c : 0xc3c3c3c3; + + uloutbuf[0] = 0; + uloutbuf[1] = 1; + uloutbuf[2] = 1; + rc = MPI_Reduce( ulinbuf, uloutbuf, 3, MPI_UNSIGNED_LONG, MPI_BOR, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_BOR and MPI_UNSIGNED_LONG", rc ); + errs++; + } + else { + if (rank == 0) { + if (uloutbuf[0] != 0xffffffff) { + errs++; + fprintf( stderr, "unsigned long BOR(1) test failed\n" ); + } + if (uloutbuf[1]) { + errs++; + fprintf( stderr, "unsigned long BOR(0) test failed\n" ); + } + if (uloutbuf[2] != 0xffffffff && size > 1) { + errs++; + fprintf( stderr, "unsigned long BOR(>) test failed\n" ); + } + } + } + +#ifdef HAVE_LONG_LONG + { + long long llinbuf[3], lloutbuf[3]; + /* long long */ + llinbuf[0] = 0xffffffff; + llinbuf[1] = 0; + llinbuf[2] = (rank > 0) ? 0x3c3c3c3c : 0xc3c3c3c3; + + lloutbuf[0] = 0; + lloutbuf[1] = 1; + lloutbuf[2] = 1; + if (MPI_LONG_LONG != MPI_DATATYPE_NULL) { + MTestPrintfMsg( 10, "Reduce of MPI_LONG_LONG\n" ); + rc = MPI_Reduce( llinbuf, lloutbuf, 3, MPI_LONG_LONG, MPI_BOR, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_BOR and MPI_LONG_LONG", rc ); + errs++; + } + else { + if (rank == 0) { + if (lloutbuf[0] != 0xffffffff) { + errs++; + fprintf( stderr, "long long BOR(1) test failed\n" ); + } + if (lloutbuf[1]) { + errs++; + fprintf( stderr, "long long BOR(0) test failed\n" ); + } + if (lloutbuf[2] != 0xffffffff && size > 1) { + errs++; + fprintf( stderr, "long long BOR(>) test failed\n" ); + } + } + } + } + } +#endif + + MPI_Errhandler_set( comm, MPI_ERRORS_ARE_FATAL ); + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/coll/opbxor.c b/teshsuite/smpi/mpich3-test/coll/opbxor.c new file mode 100644 index 0000000000..6673561a48 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/coll/opbxor.c @@ -0,0 +1,402 @@ +/* -*- 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 "mpitestconf.h" +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Test MPI_BXOR operations on optional datatypes dupported by MPICH"; +*/ + +/* + * This test looks at the handling of logical and for types that are not + * integers or are not required integers (e.g., long long). MPICH allows + * these as well. A strict MPI test should not include this test. + */ +int main( int argc, char *argv[] ) +{ + int errs = 0; + int rc; + int rank, size; + MPI_Comm comm; + char cinbuf[3], coutbuf[3]; + signed char scinbuf[3], scoutbuf[3]; + unsigned char ucinbuf[3], ucoutbuf[3]; + short sinbuf[3], soutbuf[3]; + unsigned short usinbuf[3], usoutbuf[3]; + long linbuf[3], loutbuf[3]; + unsigned long ulinbuf[3], uloutbuf[3]; + unsigned uinbuf[3], uoutbuf[3]; + int iinbuf[3], ioutbuf[3]; + + + MTest_Init( &argc, &argv ); + + comm = MPI_COMM_WORLD; + /* Set errors return so that we can provide better information + should a routine reject one of the operand/datatype pairs */ + MPI_Errhandler_set( comm, MPI_ERRORS_RETURN ); + + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + +#ifndef USE_STRICT_MPI + /* char */ + MTestPrintfMsg( 10, "Reduce of MPI_CHAR\n" ); + cinbuf[0] = 0xff; + cinbuf[1] = 0; + cinbuf[2] = (rank > 0) ? 0x3c : 0xc3; + + coutbuf[0] = 0xf; + coutbuf[1] = 1; + coutbuf[2] = 1; + rc = MPI_Reduce( cinbuf, coutbuf, 3, MPI_CHAR, MPI_BXOR, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_BXOR and MPI_CHAR", rc ); + errs++; + } + else { + if (rank == 0) { + if (coutbuf[0] != ((size % 2) ? (char)0xff : (char)0) ) { + errs++; + fprintf( stderr, "char BXOR(1) test failed\n" ); + } + if (coutbuf[1]) { + errs++; + fprintf( stderr, "char BXOR(0) test failed\n" ); + } + if (coutbuf[2] != ((size % 2) ? (char)0xc3 : (char)0xff)) { + errs++; + fprintf( stderr, "char BXOR(>) test failed\n" ); + } + } + } +#endif /* USE_STRICT_MPI */ + + /* signed char */ + MTestPrintfMsg( 10, "Reduce of MPI_SIGNED_CHAR\n" ); + scinbuf[0] = 0xff; + scinbuf[1] = 0; + scinbuf[2] = (rank > 0) ? 0x3c : 0xc3; + + scoutbuf[0] = 0xf; + scoutbuf[1] = 1; + scoutbuf[2] = 1; + rc = MPI_Reduce( scinbuf, scoutbuf, 3, MPI_SIGNED_CHAR, MPI_BXOR, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_BXOR and MPI_SIGNED_CHAR", rc ); + errs++; + } + else { + if (rank == 0) { + if (scoutbuf[0] != ((size % 2) ? (signed char)0xff : (signed char)0) ) { + errs++; + fprintf( stderr, "signed char BXOR(1) test failed\n" ); + } + if (scoutbuf[1]) { + errs++; + fprintf( stderr, "signed char BXOR(0) test failed\n" ); + } + if (scoutbuf[2] != ((size % 2) ? (signed char)0xc3 : (signed char)0xff)) { + errs++; + fprintf( stderr, "signed char BXOR(>) test failed\n" ); + } + } + } + + /* unsigned char */ + MTestPrintfMsg( 10, "Reduce of MPI_UNSIGNED_CHAR\n" ); + ucinbuf[0] = 0xff; + ucinbuf[1] = 0; + ucinbuf[2] = (rank > 0) ? 0x3c : 0xc3; + + ucoutbuf[0] = 0; + ucoutbuf[1] = 1; + ucoutbuf[2] = 1; + rc = MPI_Reduce( ucinbuf, ucoutbuf, 3, MPI_UNSIGNED_CHAR, MPI_BXOR, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_BXOR and MPI_UNSIGNED_CHAR", rc ); + errs++; + } + else { + if (rank == 0) { + if (ucoutbuf[0] != ((size % 2) ? 0xff : 0)) { + errs++; + fprintf( stderr, "unsigned char BXOR(1) test failed\n" ); + } + if (ucoutbuf[1]) { + errs++; + fprintf( stderr, "unsigned char BXOR(0) test failed\n" ); + } + if (ucoutbuf[2] != ((size % 2) ? (unsigned char)0xc3 : (unsigned char)0xff)) { + errs++; + fprintf( stderr, "unsigned char BXOR(>) test failed\n" ); + } + } + } + + /* bytes */ + MTestPrintfMsg( 10, "Reduce of MPI_BYTE\n" ); + cinbuf[0] = 0xff; + cinbuf[1] = 0; + cinbuf[2] = (rank > 0) ? 0x3c : 0xc3; + + coutbuf[0] = 0; + coutbuf[1] = 1; + coutbuf[2] = 1; + rc = MPI_Reduce( cinbuf, coutbuf, 3, MPI_BYTE, MPI_BXOR, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_BXOR and MPI_BYTE", rc ); + errs++; + } + else { + if (rank == 0) { + if (coutbuf[0] != ((size % 2) ? (char)0xff : 0)) { + errs++; + fprintf( stderr, "byte BXOR(1) test failed\n" ); + } + if (coutbuf[1]) { + errs++; + fprintf( stderr, "byte BXOR(0) test failed\n" ); + } + if (coutbuf[2] != ((size % 2) ? (char)0xc3 : (char)0xff)) { + errs++; + fprintf( stderr, "byte BXOR(>) test failed\n" ); + } + } + } + + /* short */ + MTestPrintfMsg( 10, "Reduce of MPI_SHORT\n" ); + sinbuf[0] = 0xffff; + sinbuf[1] = 0; + sinbuf[2] = (rank > 0) ? 0x3c3c : 0xc3c3; + + soutbuf[0] = 0; + soutbuf[1] = 1; + soutbuf[2] = 1; + rc = MPI_Reduce( sinbuf, soutbuf, 3, MPI_SHORT, MPI_BXOR, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_BXOR and MPI_SHORT", rc ); + errs++; + } + else { + if (rank == 0) { + if (soutbuf[0] != ((size % 2) ? (short)0xffff : 0)) { + errs++; + fprintf( stderr, "short BXOR(1) test failed\n" ); + } + if (soutbuf[1]) { + errs++; + fprintf( stderr, "short BXOR(0) test failed\n" ); + } + if (soutbuf[2] != ((size % 2) ? (short)0xc3c3 : (short)0xffff)) { + errs++; + fprintf( stderr, "short BXOR(>) test failed\n" ); + } + } + } + + /* unsigned short */ + MTestPrintfMsg( 10, "Reduce of MPI_UNSIGNED_SHORT\n" ); + usinbuf[0] = 0xffff; + usinbuf[1] = 0; + usinbuf[2] = (rank > 0) ? 0x3c3c : 0xc3c3; + + usoutbuf[0] = 0; + usoutbuf[1] = 1; + usoutbuf[2] = 1; + rc = MPI_Reduce( usinbuf, usoutbuf, 3, MPI_UNSIGNED_SHORT, MPI_BXOR, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_BXOR and MPI_UNSIGNED_SHORT", rc ); + errs++; + } + else { + if (rank == 0) { + if (usoutbuf[0] != ((size % 2) ? 0xffff : 0)) { + errs++; + fprintf( stderr, "short BXOR(1) test failed\n" ); + } + if (usoutbuf[1]) { + errs++; + fprintf( stderr, "short BXOR(0) test failed\n" ); + } + if (usoutbuf[2] != ((size % 2) ? 0xc3c3 : 0xffff)) { + errs++; + fprintf( stderr, "short BXOR(>) test failed\n" ); + } + } + } + + /* unsigned */ + MTestPrintfMsg( 10, "Reduce of MPI_UNSIGNED\n" ); + uinbuf[0] = 0xffffffff; + uinbuf[1] = 0; + uinbuf[2] = (rank > 0) ? 0x3c3c3c3c : 0xc3c3c3c3; + + uoutbuf[0] = 0; + uoutbuf[1] = 1; + uoutbuf[2] = 1; + rc = MPI_Reduce( uinbuf, uoutbuf, 3, MPI_UNSIGNED, MPI_BXOR, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_BXOR and MPI_UNSIGNED", rc ); + errs++; + } + else { + if (rank == 0) { + if (uoutbuf[0] != ((size % 2) ? 0xffffffff : 0)) { + errs++; + fprintf( stderr, "unsigned BXOR(1) test failed\n" ); + } + if (uoutbuf[1]) { + errs++; + fprintf( stderr, "unsigned BXOR(0) test failed\n" ); + } + if (uoutbuf[2] != ((size % 2) ? 0xc3c3c3c3 : 0xffffffff)) { + errs++; + fprintf( stderr, "unsigned BXOR(>) test failed\n" ); + } + } + } + + /* int */ + MTestPrintfMsg( 10, "Reduce of MPI_INT\n" ); + iinbuf[0] = 0xffffffff; + iinbuf[1] = 0; + iinbuf[2] = (rank > 0) ? 0x3c3c3c3c : 0xc3c3c3c3; + + ioutbuf[0] = 0; + ioutbuf[1] = 1; + ioutbuf[2] = 1; + rc = MPI_Reduce( iinbuf, ioutbuf, 3, MPI_INT, MPI_BXOR, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_BXOR and MPI_INT", rc ); + errs++; + } + else { + if (rank == 0) { + if (ioutbuf[0] != ((size % 2) ? 0xffffffff : 0)) { + errs++; + fprintf( stderr, "int BXOR(1) test failed\n" ); + } + if (ioutbuf[1]) { + errs++; + fprintf( stderr, "int BXOR(0) test failed\n" ); + } + if (ioutbuf[2] != ((size % 2) ? 0xc3c3c3c3 : 0xffffffff)) { + errs++; + fprintf( stderr, "int BXOR(>) test failed\n" ); + } + } + } + + /* long */ + MTestPrintfMsg( 10, "Reduce of MPI_LONG\n" ); + linbuf[0] = 0xffffffff; + linbuf[1] = 0; + linbuf[2] = (rank > 0) ? 0x3c3c3c3c : 0xc3c3c3c3; + + loutbuf[0] = 0; + loutbuf[1] = 1; + loutbuf[2] = 1; + rc = MPI_Reduce( linbuf, loutbuf, 3, MPI_LONG, MPI_BXOR, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_BXOR and MPI_LONG", rc ); + errs++; + } + else { + if (rank == 0) { + if (loutbuf[0] != ((size % 2) ? 0xffffffff : 0)) { + errs++; + fprintf( stderr, "long BXOR(1) test failed\n" ); + } + if (loutbuf[1]) { + errs++; + fprintf( stderr, "long BXOR(0) test failed\n" ); + } + if (loutbuf[2] != ((size % 2) ? 0xc3c3c3c3 : 0xffffffff)) { + errs++; + fprintf( stderr, "long BXOR(>) test failed\n" ); + } + } + } + + /* unsigned long */ + MTestPrintfMsg( 10, "Reduce of MPI_UNSIGNED_LONG\n" ); + ulinbuf[0] = 0xffffffff; + ulinbuf[1] = 0; + ulinbuf[2] = (rank > 0) ? 0x3c3c3c3c : 0xc3c3c3c3; + + uloutbuf[0] = 0; + uloutbuf[1] = 1; + uloutbuf[2] = 1; + rc = MPI_Reduce( ulinbuf, uloutbuf, 3, MPI_UNSIGNED_LONG, MPI_BXOR, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_BXOR and MPI_UNSIGNED_LONG", rc ); + errs++; + } + else { + if (rank == 0) { + if (uloutbuf[0] != ((size % 2) ? 0xffffffff : 0)) { + errs++; + fprintf( stderr, "unsigned long BXOR(1) test failed\n" ); + } + if (uloutbuf[1]) { + errs++; + fprintf( stderr, "unsigned long BXOR(0) test failed\n" ); + } + if (uloutbuf[2] != ((size % 2) ? 0xc3c3c3c3 : 0xffffffff)) { + errs++; + fprintf( stderr, "unsigned long BXOR(>) test failed\n" ); + } + } + } + +#ifdef HAVE_LONG_LONG + { + long long llinbuf[3], lloutbuf[3]; + /* long long */ + llinbuf[0] = 0xffffffff; + llinbuf[1] = 0; + llinbuf[2] = (rank > 0) ? 0x3c3c3c3c : 0xc3c3c3c3; + + lloutbuf[0] = 0; + lloutbuf[1] = 1; + lloutbuf[2] = 1; + if (MPI_LONG_LONG != MPI_DATATYPE_NULL) { + MTestPrintfMsg( 10, "Reduce of MPI_LONG_LONG\n" ); + rc = MPI_Reduce( llinbuf, lloutbuf, 3, MPI_LONG_LONG, MPI_BXOR, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_BXOR and MPI_LONG_LONG", rc ); + errs++; + } + else { + if (rank == 0) { + if (lloutbuf[0] != ((size % 2) ? 0xffffffff : 0)) { + errs++; + fprintf( stderr, "long long BXOR(1) test failed\n" ); + } + if (lloutbuf[1]) { + errs++; + fprintf( stderr, "long long BXOR(0) test failed\n" ); + } + if (lloutbuf[2] != ((size % 2) ? 0xc3c3c3c3 : 0xffffffff)) { + errs++; + fprintf( stderr, "long long BXOR(>) test failed\n" ); + } + } + } + } + } +#endif + + MPI_Errhandler_set( comm, MPI_ERRORS_ARE_FATAL ); + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/coll/opland.c b/teshsuite/smpi/mpich3-test/coll/opland.c new file mode 100644 index 0000000000..ad32a75686 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/coll/opland.c @@ -0,0 +1,283 @@ +/* -*- 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 "mpitestconf.h" +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Test MPI_LAND operations on optional datatypes dupported by MPICH"; +*/ + +/* + * This test looks at the handling of logical and for types that are not + * integers or are not required integers (e.g., long long). MPICH allows + * these as well. A strict MPI test should not include this test. + */ +int main( int argc, char *argv[] ) +{ + int errs = 0; + int rc; + int rank, size; + MPI_Comm comm; + char cinbuf[3], coutbuf[3]; + signed char scinbuf[3], scoutbuf[3]; + unsigned char ucinbuf[3], ucoutbuf[3]; + float finbuf[3], foutbuf[3]; + double dinbuf[3], doutbuf[3]; + + MTest_Init( &argc, &argv ); + + comm = MPI_COMM_WORLD; + /* Set errors return so that we can provide better information + should a routine reject one of the operand/datatype pairs */ + MPI_Errhandler_set( comm, MPI_ERRORS_RETURN ); + + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + +#ifndef USE_STRICT_MPI + /* char */ + MTestPrintfMsg( 10, "Reduce of MPI_CHAR\n" ); + cinbuf[0] = 1; + cinbuf[1] = 0; + cinbuf[2] = (rank > 0); + + coutbuf[0] = 0; + coutbuf[1] = 1; + coutbuf[2] = 1; + rc = MPI_Reduce( cinbuf, coutbuf, 3, MPI_CHAR, MPI_LAND, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_LAND and MPI_CHAR", rc ); + errs++; + } + else { + if (rank == 0) { + if (!coutbuf[0]) { + errs++; + fprintf( stderr, "char AND(1) test failed\n" ); + } + if (coutbuf[1]) { + errs++; + fprintf( stderr, "char AND(0) test failed\n" ); + } + if (coutbuf[2] && size > 1) { + errs++; + fprintf( stderr, "char AND(>) test failed\n" ); + } + } + } +#endif /* USE_STRICT_MPI */ + + /* signed char */ + MTestPrintfMsg( 10, "Reduce of MPI_SIGNED_CHAR\n" ); + scinbuf[0] = 1; + scinbuf[1] = 0; + scinbuf[2] = (rank > 0); + + scoutbuf[0] = 0; + scoutbuf[1] = 1; + scoutbuf[2] = 1; + rc = MPI_Reduce( scinbuf, scoutbuf, 3, MPI_SIGNED_CHAR, MPI_LAND, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_LAND and MPI_SIGNED_CHAR", rc ); + errs++; + } + else { + if (rank == 0) { + if (!scoutbuf[0]) { + errs++; + fprintf( stderr, "signed char AND(1) test failed\n" ); + } + if (scoutbuf[1]) { + errs++; + fprintf( stderr, "signed char AND(0) test failed\n" ); + } + if (scoutbuf[2] && size > 1) { + errs++; + fprintf( stderr, "signed char AND(>) test failed\n" ); + } + } + } + + /* unsigned char */ + MTestPrintfMsg( 10, "Reduce of MPI_UNSIGNED_CHAR\n" ); + ucinbuf[0] = 1; + ucinbuf[1] = 0; + ucinbuf[2] = (rank > 0); + + ucoutbuf[0] = 0; + ucoutbuf[1] = 1; + ucoutbuf[2] = 1; + rc = MPI_Reduce( ucinbuf, ucoutbuf, 3, MPI_UNSIGNED_CHAR, MPI_LAND, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_LAND and MPI_UNSIGNED_CHAR", rc ); + errs++; + } + else { + if (rank == 0) { + if (!ucoutbuf[0]) { + errs++; + fprintf( stderr, "unsigned char AND(1) test failed\n" ); + } + if (ucoutbuf[1]) { + errs++; + fprintf( stderr, "unsigned char AND(0) test failed\n" ); + } + if (ucoutbuf[2] && size > 1) { + errs++; + fprintf( stderr, "unsigned char AND(>) test failed\n" ); + } + } + } + +#ifndef USE_STRICT_MPI + /* float */ + MTestPrintfMsg( 10, "Reduce of MPI_FLOAT\n" ); + finbuf[0] = 1; + finbuf[1] = 0; + finbuf[2] = (rank > 0); + + foutbuf[0] = 0; + foutbuf[1] = 1; + foutbuf[2] = 1; + rc = MPI_Reduce( finbuf, foutbuf, 3, MPI_FLOAT, MPI_LAND, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_LAND and MPI_FLOAT", rc ); + errs++; + } + else { + if (rank == 0) { + if (!foutbuf[0]) { + errs++; + fprintf( stderr, "float AND(1) test failed\n" ); + } + if (foutbuf[1]) { + errs++; + fprintf( stderr, "float AND(0) test failed\n" ); + } + if (foutbuf[2] && size > 1) { + errs++; + fprintf( stderr, "float AND(>) test failed\n" ); + } + } + } + + MTestPrintfMsg( 10, "Reduce of MPI_DOUBLE\n" ); + /* double */ + dinbuf[0] = 1; + dinbuf[1] = 0; + dinbuf[2] = (rank > 0); + + doutbuf[0] = 0; + doutbuf[1] = 1; + doutbuf[2] = 1; + rc = MPI_Reduce( dinbuf, doutbuf, 3, MPI_DOUBLE, MPI_LAND, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_LAND and MPI_DOUBLE", rc ); + errs++; + } + else { + if (rank == 0) { + if (!doutbuf[0]) { + errs++; + fprintf( stderr, "double AND(1) test failed\n" ); + } + if (doutbuf[1]) { + errs++; + fprintf( stderr, "double AND(0) test failed\n" ); + } + if (doutbuf[2] && size > 1) { + errs++; + fprintf( stderr, "double AND(>) test failed\n" ); + } + } + } + +#ifdef HAVE_LONG_DOUBLE + { long double ldinbuf[3], ldoutbuf[3]; + /* long double */ + ldinbuf[0] = 1; + ldinbuf[1] = 0; + ldinbuf[2] = (rank > 0); + + ldoutbuf[0] = 0; + ldoutbuf[1] = 1; + ldoutbuf[2] = 1; + if (MPI_LONG_DOUBLE != MPI_DATATYPE_NULL) { + MTestPrintfMsg( 10, "Reduce of MPI_LONG_DOUBLE\n" ); + rc = MPI_Reduce( ldinbuf, ldoutbuf, 3, MPI_LONG_DOUBLE, MPI_LAND, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_LAND and MPI_LONG_DOUBLE", rc ); + errs++; + } + else { + if (rank == 0) { + if (!ldoutbuf[0]) { + errs++; + fprintf( stderr, "long double AND(1) test failed\n" ); + } + if (ldoutbuf[1]) { + errs++; + fprintf( stderr, "long double AND(0) test failed\n" ); + } + if (ldoutbuf[2] && size > 1) { + errs++; + fprintf( stderr, "long double AND(>) test failed\n" ); + } + } + } + } + } +#endif /* HAVE_LONG_DOUBLE */ +#endif /* USE_STRICT_MPI */ + + +#ifdef HAVE_LONG_LONG + { + long long llinbuf[3], lloutbuf[3]; + /* long long */ + llinbuf[0] = 1; + llinbuf[1] = 0; + llinbuf[2] = (rank > 0); + + lloutbuf[0] = 0; + lloutbuf[1] = 1; + lloutbuf[2] = 1; + if (MPI_LONG_LONG != MPI_DATATYPE_NULL) { + MTestPrintfMsg( 10, "Reduce of MPI_LONG_LONG\n" ); + rc = MPI_Reduce( llinbuf, lloutbuf, 3, MPI_LONG_LONG, MPI_LAND, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_LAND and MPI_LONG_LONG", rc ); + errs++; + } + else { + if (rank == 0) { + if (!lloutbuf[0]) { + errs++; + fprintf( stderr, "long long AND(1) test failed\n" ); + } + if (lloutbuf[1]) { + errs++; + fprintf( stderr, "long long AND(0) test failed\n" ); + } + if (lloutbuf[2] && size > 1) { + errs++; + fprintf( stderr, "long long AND(>) test failed\n" ); + } + } + } + } + } +#endif + + MPI_Errhandler_set( comm, MPI_ERRORS_ARE_FATAL ); + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} + diff --git a/teshsuite/smpi/mpich3-test/coll/oplor.c b/teshsuite/smpi/mpich3-test/coll/oplor.c new file mode 100644 index 0000000000..a168d35abb --- /dev/null +++ b/teshsuite/smpi/mpich3-test/coll/oplor.c @@ -0,0 +1,284 @@ +/* -*- 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 "mpitestconf.h" +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Test MPI_LOR operations on optional datatypes dupported by MPICH"; +*/ + +/* + * This test looks at the handling of logical and for types that are not + * integers or are not required integers (e.g., long long). MPICH allows + * these as well. A strict MPI test should not include this test. + */ +int main( int argc, char *argv[] ) +{ + int errs = 0, err; + int rank, size; + MPI_Comm comm; + char cinbuf[3], coutbuf[3]; + signed char scinbuf[3], scoutbuf[3]; + unsigned char ucinbuf[3], ucoutbuf[3]; + float finbuf[3], foutbuf[3]; + double dinbuf[3], doutbuf[3]; + + MTest_Init( &argc, &argv ); + + comm = MPI_COMM_WORLD; + + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + + /* Some MPI implementations do not implement all of the required + (datatype,operations) combinations, and further, they do not + always provide clear and specific error messages. By catching + the error, we can provide a higher quality, more specific message. + */ + MPI_Comm_set_errhandler( comm, MPI_ERRORS_RETURN ); + +#ifndef USE_STRICT_MPI + /* char */ + MTestPrintfMsg( 10, "Reduce of MPI_CHAR\n" ); + cinbuf[0] = 1; + cinbuf[1] = 0; + cinbuf[2] = (rank > 0); + + coutbuf[0] = 0; + coutbuf[1] = 1; + coutbuf[2] = 1; + err = MPI_Reduce( cinbuf, coutbuf, 3, MPI_CHAR, MPI_LOR, 0, comm ); + if (err) { + errs++; + MTestPrintErrorMsg( "MPI_LOR and MPI_CHAR", err ); + } + else { + if (rank == 0) { + if (!coutbuf[0]) { + errs++; + fprintf( stderr, "char OR(1) test failed\n" ); + } + if (coutbuf[1]) { + errs++; + fprintf( stderr, "char OR(0) test failed\n" ); + } + if (!coutbuf[2] && size > 1) { + errs++; + fprintf( stderr, "char OR(>) test failed\n" ); + } + } + } +#endif /* USE_STRICT_MPI */ + + /* signed char */ + MTestPrintfMsg( 10, "Reduce of MPI_SIGNED_CHAR\n" ); + scinbuf[0] = 1; + scinbuf[1] = 0; + scinbuf[2] = (rank > 0); + + scoutbuf[0] = 0; + scoutbuf[1] = 1; + scoutbuf[2] = 1; + err = MPI_Reduce( scinbuf, scoutbuf, 3, MPI_SIGNED_CHAR, MPI_LOR, 0, comm ); + if (err) { + errs++; + MTestPrintErrorMsg( "MPI_LOR and MPI_SIGNED_CHAR", err ); + } + else { + if (rank == 0) { + if (!scoutbuf[0]) { + errs++; + fprintf( stderr, "signed char OR(1) test failed\n" ); + } + if (scoutbuf[1]) { + errs++; + fprintf( stderr, "signed char OR(0) test failed\n" ); + } + if (!scoutbuf[2] && size > 1) { + errs++; + fprintf( stderr, "signed char OR(>) test failed\n" ); + } + } + } + + /* unsigned char */ + MTestPrintfMsg( 10, "Reduce of MPI_UNSIGNED_CHAR\n" ); + ucinbuf[0] = 1; + ucinbuf[1] = 0; + ucinbuf[2] = (rank > 0); + + ucoutbuf[0] = 0; + ucoutbuf[1] = 1; + ucoutbuf[2] = 1; + err = MPI_Reduce( ucinbuf, ucoutbuf, 3, MPI_UNSIGNED_CHAR, MPI_LOR, 0, comm ); + if (err) { + errs++; + MTestPrintErrorMsg( "MPI_LOR and MPI_UNSIGNED_CHAR", err ); + } + else { + if (rank == 0) { + if (!ucoutbuf[0]) { + errs++; + fprintf( stderr, "unsigned char OR(1) test failed\n" ); + } + if (ucoutbuf[1]) { + errs++; + fprintf( stderr, "unsigned char OR(0) test failed\n" ); + } + if (!ucoutbuf[2] && size > 1) { + errs++; + fprintf( stderr, "unsigned char OR(>) test failed\n" ); + } + } + } + +#ifndef USE_STRICT_MPI + /* float */ + MTestPrintfMsg( 10, "Reduce of MPI_FLOAT\n" ); + finbuf[0] = 1; + finbuf[1] = 0; + finbuf[2] = (rank > 0); + + foutbuf[0] = 0; + foutbuf[1] = 1; + foutbuf[2] = 1; + err = MPI_Reduce( finbuf, foutbuf, 3, MPI_FLOAT, MPI_LOR, 0, comm ); + if (err) { + errs++; + MTestPrintErrorMsg( "MPI_LOR and MPI_FLOAT", err ); + } + else { + if (rank == 0) { + if (!foutbuf[0]) { + errs++; + fprintf( stderr, "float OR(1) test failed\n" ); + } + if (foutbuf[1]) { + errs++; + fprintf( stderr, "float OR(0) test failed\n" ); + } + if (!foutbuf[2] && size > 1) { + errs++; + fprintf( stderr, "float OR(>) test failed\n" ); + } + } + } + + /* double */ + MTestPrintfMsg( 10, "Reduce of MPI_DOUBLE\n" ); + dinbuf[0] = 1; + dinbuf[1] = 0; + dinbuf[2] = (rank > 0); + + doutbuf[0] = 0; + doutbuf[1] = 1; + doutbuf[2] = 1; + err = MPI_Reduce( dinbuf, doutbuf, 3, MPI_DOUBLE, MPI_LOR, 0, comm ); + if (err) { + errs++; + MTestPrintErrorMsg( "MPI_LOR and MPI_DOUBLE", err ); + } + else { + if (rank == 0) { + if (!doutbuf[0]) { + errs++; + fprintf( stderr, "double OR(1) test failed\n" ); + } + if (doutbuf[1]) { + errs++; + fprintf( stderr, "double OR(0) test failed\n" ); + } + if (!doutbuf[2] && size > 1) { + errs++; + fprintf( stderr, "double OR(>) test failed\n" ); + } + } + } + +#ifdef HAVE_LONG_DOUBLE + { long double ldinbuf[3], ldoutbuf[3]; + /* long double */ + ldinbuf[0] = 1; + ldinbuf[1] = 0; + ldinbuf[2] = (rank > 0); + + ldoutbuf[0] = 0; + ldoutbuf[1] = 1; + ldoutbuf[2] = 1; + if (MPI_LONG_DOUBLE != MPI_DATATYPE_NULL) { + MTestPrintfMsg( 10, "Reduce of MPI_LONG_DOUBLE\n" ); + err = MPI_Reduce( ldinbuf, ldoutbuf, 3, MPI_LONG_DOUBLE, MPI_LOR, 0, comm ); + if (err) { + errs++; + MTestPrintErrorMsg( "MPI_LOR and MPI_LONG_DOUBLE", err ); + } + else { + if (rank == 0) { + if (!ldoutbuf[0]) { + errs++; + fprintf( stderr, "long double OR(1) test failed\n" ); + } + if (ldoutbuf[1]) { + errs++; + fprintf( stderr, "long double OR(0) test failed\n" ); + } + if (!ldoutbuf[2] && size > 1) { + errs++; + fprintf( stderr, "long double OR(>) test failed\n" ); + } + } + } + } + } +#endif /* HAVE_LONG_DOUBLE */ +#endif /* USE_STRICT_MPI */ + +#ifdef HAVE_LONG_LONG + { + long long llinbuf[3], lloutbuf[3]; + /* long long */ + llinbuf[0] = 1; + llinbuf[1] = 0; + llinbuf[2] = (rank > 0); + + lloutbuf[0] = 0; + lloutbuf[1] = 1; + lloutbuf[2] = 1; + if (MPI_LONG_LONG != MPI_DATATYPE_NULL) { + MTestPrintfMsg( 10, "Reduce of MPI_LONG_LONG\n" ); + err = MPI_Reduce( llinbuf, lloutbuf, 3, MPI_LONG_LONG, MPI_LOR, 0, comm ); + if (err) { + errs++; + MTestPrintErrorMsg( "MPI_LOR and MPI_LONG_LONG", err ); + } + else { + if (rank == 0) { + if (!lloutbuf[0]) { + errs++; + fprintf( stderr, "long long OR(1) test failed\n" ); + } + if (lloutbuf[1]) { + errs++; + fprintf( stderr, "long long OR(0) test failed\n" ); + } + if (!lloutbuf[2] && size > 1) { + errs++; + fprintf( stderr, "long long OR(>) test failed\n" ); + } + } + } + } + } +#endif + + MPI_Errhandler_set( comm, MPI_ERRORS_ARE_FATAL ); + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/coll/oplxor.c b/teshsuite/smpi/mpich3-test/coll/oplxor.c new file mode 100644 index 0000000000..e55970d797 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/coll/oplxor.c @@ -0,0 +1,281 @@ +/* -*- 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 "mpitestconf.h" +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Test MPI_LXOR operations on optional datatypes dupported by MPICH"; +*/ + +/* + * This test looks at the handling of logical and for types that are not + * integers or are not required integers (e.g., long long). MPICH allows + * these as well. A strict MPI test should not include this test. + */ +int main( int argc, char *argv[] ) +{ + int errs = 0; + int rc; + int rank, size; + MPI_Comm comm; + char cinbuf[3], coutbuf[3]; + signed char scinbuf[3], scoutbuf[3]; + unsigned char ucinbuf[3], ucoutbuf[3]; + float finbuf[3], foutbuf[3]; + double dinbuf[3], doutbuf[3]; + + MTest_Init( &argc, &argv ); + + comm = MPI_COMM_WORLD; + /* Set errors return so that we can provide better information + should a routine reject one of the operand/datatype pairs */ + MPI_Errhandler_set( comm, MPI_ERRORS_RETURN ); + + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + +#ifndef USE_STRICT_MPI + /* char */ + MTestPrintfMsg( 10, "Reduce of MPI_CHAR\n" ); + cinbuf[0] = 1; + cinbuf[1] = 0; + cinbuf[2] = (rank > 0); + + coutbuf[0] = 0; + coutbuf[1] = 1; + coutbuf[2] = 1; + rc = MPI_Reduce( cinbuf, coutbuf, 3, MPI_CHAR, MPI_LXOR, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_LXOR and MPI_CHAR", rc ); + errs++; + } + else { + if (rank == 0) { + if (coutbuf[0] != (size % 2)) { + errs++; + fprintf( stderr, "char XOR(1) test failed\n" ); + } + if (coutbuf[1]) { + errs++; + fprintf( stderr, "char XOR(0) test failed\n" ); + } + if (coutbuf[2] == (size % 2) && size > 1) { + errs++; + fprintf( stderr, "char XOR(>) test failed\n" ); + } + } + } +#endif /* USE_STRICT_MPI */ + + /* signed char */ + MTestPrintfMsg( 10, "Reduce of MPI_SIGNED_CHAR\n" ); + scinbuf[0] = 1; + scinbuf[1] = 0; + scinbuf[2] = (rank > 0); + + scoutbuf[0] = 0; + scoutbuf[1] = 1; + scoutbuf[2] = 1; + rc = MPI_Reduce( scinbuf, scoutbuf, 3, MPI_SIGNED_CHAR, MPI_LXOR, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_LXOR and MPI_SIGNED_CHAR", rc ); + errs++; + } + else { + if (rank == 0) { + if (scoutbuf[0] != (size % 2)) { + errs++; + fprintf( stderr, "signed char XOR(1) test failed\n" ); + } + if (scoutbuf[1]) { + errs++; + fprintf( stderr, "signed char XOR(0) test failed\n" ); + } + if (scoutbuf[2] == (size % 2) && size > 1) { + errs++; + fprintf( stderr, "signed char XOR(>) test failed\n" ); + } + } + } + + /* unsigned char */ + MTestPrintfMsg( 10, "Reduce of MPI_UNSIGNED_CHAR\n" ); + ucinbuf[0] = 1; + ucinbuf[1] = 0; + ucinbuf[2] = (rank > 0); + + ucoutbuf[0] = 0; + ucoutbuf[1] = 1; + ucoutbuf[2] = 1; + rc = MPI_Reduce( ucinbuf, ucoutbuf, 3, MPI_UNSIGNED_CHAR, MPI_LXOR, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_LXOR and MPI_UNSIGNED_CHAR", rc ); + errs++; + } + else { + if (rank == 0) { + if (ucoutbuf[0] != (size % 2)) { + errs++; + fprintf( stderr, "unsigned char XOR(1) test failed\n" ); + } + if (ucoutbuf[1]) { + errs++; + fprintf( stderr, "unsigned char XOR(0) test failed\n" ); + } + if (ucoutbuf[2] == (size % 2) && size > 1) { + errs++; + fprintf( stderr, "unsigned char XOR(>) test failed\n" ); + } + } + } + +#ifndef USE_STRICT_MPI + /* float */ + MTestPrintfMsg( 10, "Reduce of MPI_FLOAT\n" ); + finbuf[0] = 1; + finbuf[1] = 0; + finbuf[2] = (rank > 0); + + foutbuf[0] = 0; + foutbuf[1] = 1; + foutbuf[2] = 1; + rc = MPI_Reduce( finbuf, foutbuf, 3, MPI_FLOAT, MPI_LXOR, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_LXOR and MPI_FLOAT", rc ); + errs++; + } + else { + if (rank == 0) { + if (foutbuf[0] != (size % 2)) { + errs++; + fprintf( stderr, "float XOR(1) test failed\n" ); + } + if (foutbuf[1]) { + errs++; + fprintf( stderr, "float XOR(0) test failed\n" ); + } + if (foutbuf[2] == (size % 2) && size > 1) { + errs++; + fprintf( stderr, "float XOR(>) test failed\n" ); + } + } + } + + /* double */ + MTestPrintfMsg( 10, "Reduce of MPI_DOUBLE\n" ); + dinbuf[0] = 1; + dinbuf[1] = 0; + dinbuf[2] = (rank > 0); + + doutbuf[0] = 0; + doutbuf[1] = 1; + doutbuf[2] = 1; + rc = MPI_Reduce( dinbuf, doutbuf, 3, MPI_DOUBLE, MPI_LXOR, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_LXOR and MPI_DOUBLE", rc ); + errs++; + } + else { + if (rank == 0) { + if (doutbuf[0] != (size % 2)) { + errs++; + fprintf( stderr, "double XOR(1) test failed\n" ); + } + if (doutbuf[1]) { + errs++; + fprintf( stderr, "double XOR(0) test failed\n" ); + } + if (doutbuf[2] == (size % 2) && size > 1) { + errs++; + fprintf( stderr, "double XOR(>) test failed\n" ); + } + } + } + +#ifdef HAVE_LONG_DOUBLE + { long double ldinbuf[3], ldoutbuf[3]; + /* long double */ + ldinbuf[0] = 1; + ldinbuf[1] = 0; + ldinbuf[2] = (rank > 0); + + ldoutbuf[0] = 0; + ldoutbuf[1] = 1; + ldoutbuf[2] = 1; + if (MPI_LONG_DOUBLE != MPI_DATATYPE_NULL) { + MTestPrintfMsg( 10, "Reduce of MPI_LONG_DOUBLE\n" ); + rc = MPI_Reduce( ldinbuf, ldoutbuf, 3, MPI_LONG_DOUBLE, MPI_LXOR, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_LXOR and MPI_LONG_DOUBLE", rc ); + errs++; + } + else { + if (rank == 0) { + if (ldoutbuf[0] != (size % 2)) { + errs++; + fprintf( stderr, "long double XOR(1) test failed\n" ); + } + if (ldoutbuf[1]) { + errs++; + fprintf( stderr, "long double XOR(0) test failed\n" ); + } + if (ldoutbuf[2] == (size % 2) && size > 1) { + errs++; + fprintf( stderr, "long double XOR(>) test failed\n" ); + } + } + } + } + } +#endif /* HAVE_LONG_DOUBLE */ +#endif /* USE_STRICT_MPI */ + +#ifdef HAVE_LONG_LONG + { + long long llinbuf[3], lloutbuf[3]; + /* long long */ + llinbuf[0] = 1; + llinbuf[1] = 0; + llinbuf[2] = (rank > 0); + + lloutbuf[0] = 0; + lloutbuf[1] = 1; + lloutbuf[2] = 1; + if (MPI_LONG_LONG != MPI_DATATYPE_NULL) { + MTestPrintfMsg( 10, "Reduce of MPI_LONG_LONG\n" ); + rc = MPI_Reduce( llinbuf, lloutbuf, 3, MPI_LONG_LONG, MPI_LXOR, 0, comm ); + if (rc) { + MTestPrintErrorMsg( "MPI_LXOR and MPI_LONG_LONG", rc ); + errs++; + } + else { + if (rank == 0) { + if (lloutbuf[0] != (size % 2)) { + errs++; + fprintf( stderr, "long long XOR(1) test failed\n" ); + } + if (lloutbuf[1]) { + errs++; + fprintf( stderr, "long long XOR(0) test failed\n" ); + } + if (lloutbuf[2] == (size % 2) && size > 1) { + errs++; + fprintf( stderr, "long long XOR(>) test failed\n" ); + } + } + } + } + } +#endif + + MPI_Errhandler_set( comm, MPI_ERRORS_ARE_FATAL ); + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/coll/opmax.c b/teshsuite/smpi/mpich3-test/coll/opmax.c new file mode 100644 index 0000000000..1c9c1ffaf5 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/coll/opmax.c @@ -0,0 +1,180 @@ +/* -*- 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 "mpitestconf.h" +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Test MPI_MAX operations on optional datatypes dupported by MPICH"; +*/ + +/* + * This test looks at the handling of char and types that are not required + * integers (e.g., long long). MPICH allows + * these as well. A strict MPI test should not include this test. + */ +int main( int argc, char *argv[] ) +{ + int errs = 0; + int rank, size; + MPI_Comm comm; + char cinbuf[3], coutbuf[3]; + signed char scinbuf[3], scoutbuf[3]; + unsigned char ucinbuf[3], ucoutbuf[3]; + + MTest_Init( &argc, &argv ); + + comm = MPI_COMM_WORLD; + + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + +#ifndef USE_STRICT_MPI + /* char */ + MTestPrintfMsg( 10, "Reduce of MPI_CHAR\n" ); + cinbuf[0] = 1; + cinbuf[1] = 0; + cinbuf[2] = rank; + + coutbuf[0] = 0; + coutbuf[1] = 1; + coutbuf[2] = 1; + MPI_Reduce( cinbuf, coutbuf, 3, MPI_CHAR, MPI_MAX, 0, comm ); + if (rank == 0) { + if (coutbuf[0] != 1) { + errs++; + fprintf( stderr, "char MAX(1) test failed\n" ); + } + if (coutbuf[1] != 0) { + errs++; + fprintf( stderr, "char MAX(0) test failed\n" ); + } + if (size < 128 && coutbuf[2] != size - 1) { + errs++; + fprintf( stderr, "char MAX(>) test failed\n" ); + } + } +#endif /* USE_STRICT_MPI */ + + /* signed char */ + MTestPrintfMsg( 10, "Reduce of MPI_SIGNED_CHAR\n" ); + scinbuf[0] = 1; + scinbuf[1] = 0; + scinbuf[2] = rank; + + scoutbuf[0] = 0; + scoutbuf[1] = 1; + scoutbuf[2] = 1; + MPI_Reduce( scinbuf, scoutbuf, 3, MPI_SIGNED_CHAR, MPI_MAX, 0, comm ); + if (rank == 0) { + if (scoutbuf[0] != 1) { + errs++; + fprintf( stderr, "signed char MAX(1) test failed\n" ); + } + if (scoutbuf[1] != 0) { + errs++; + fprintf( stderr, "signed char MAX(0) test failed\n" ); + } + if (size < 128 && scoutbuf[2] != size - 1) { + errs++; + fprintf( stderr, "signed char MAX(>) test failed\n" ); + } + } + + /* unsigned char */ + MTestPrintfMsg( 10, "Reduce of MPI_UNSIGNED_CHAR\n" ); + ucinbuf[0] = 1; + ucinbuf[1] = 0; + ucinbuf[2] = rank; + + ucoutbuf[0] = 0; + ucoutbuf[1] = 1; + ucoutbuf[2] = 1; + MPI_Reduce( ucinbuf, ucoutbuf, 3, MPI_UNSIGNED_CHAR, MPI_MAX, 0, comm ); + if (rank == 0) { + if (ucoutbuf[0] != 1) { + errs++; + fprintf( stderr, "unsigned char MAX(1) test failed\n" ); + } + if (ucoutbuf[1]) { + errs++; + fprintf( stderr, "unsigned char MAX(0) test failed\n" ); + } + if (size < 256 && ucoutbuf[2] != size - 1) { + errs++; + fprintf( stderr, "unsigned char MAX(>) test failed\n" ); + } + } + +#ifdef HAVE_LONG_DOUBLE + { long double ldinbuf[3], ldoutbuf[3]; + /* long double */ + ldinbuf[0] = 1; + ldinbuf[1] = 0; + ldinbuf[2] = rank; + + ldoutbuf[0] = 0; + ldoutbuf[1] = 1; + ldoutbuf[2] = 1; + if (MPI_LONG_DOUBLE != MPI_DATATYPE_NULL) { + MTestPrintfMsg( 10, "Reduce of MPI_LONG_DOUBLE\n" ); + MPI_Reduce( ldinbuf, ldoutbuf, 3, MPI_LONG_DOUBLE, MPI_MAX, 0, comm ); + if (rank == 0) { + if (ldoutbuf[0] != 1) { + errs++; + fprintf( stderr, "long double MAX(1) test failed\n" ); + } + if (ldoutbuf[1] != 0.0) { + errs++; + fprintf( stderr, "long double MAX(0) test failed\n" ); + } + if (ldoutbuf[2] != size - 1) { + errs++; + fprintf( stderr, "long double MAX(>) test failed\n" ); + } + } + } + } +#endif /* HAVE_LONG_DOUBLE */ + +#ifdef HAVE_LONG_LONG + { + long long llinbuf[3], lloutbuf[3]; + /* long long */ + llinbuf[0] = 1; + llinbuf[1] = 0; + llinbuf[2] = rank; + + lloutbuf[0] = 0; + lloutbuf[1] = 1; + lloutbuf[2] = 1; + if (MPI_LONG_LONG != MPI_DATATYPE_NULL) { + MTestPrintfMsg( 10, "Reduce of MPI_LONG_LONG\n" ); + MPI_Reduce( llinbuf, lloutbuf, 3, MPI_LONG_LONG, MPI_MAX, 0, comm ); + if (rank == 0) { + if (lloutbuf[0] != 1) { + errs++; + fprintf( stderr, "long long MAX(1) test failed\n" ); + } + if (lloutbuf[1] != 0) { + errs++; + fprintf( stderr, "long long MAX(0) test failed\n" ); + } + if (lloutbuf[2] != size - 1) { + errs++; + fprintf( stderr, "long long MAX(>) test failed\n" ); + } + } + } + } +#endif /* HAVE_LONG_LONG */ + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/coll/opmaxloc.c b/teshsuite/smpi/mpich3-test/coll/opmaxloc.c new file mode 100644 index 0000000000..0c64ee0fd4 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/coll/opmaxloc.c @@ -0,0 +1,286 @@ +/* -*- 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 "mpitestconf.h" +#include +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Test MPI_MAXLOC operations on datatypes dupported by MPICH"; +*/ + +/* + * This test looks at the handling of char and types that are not required + * integers (e.g., long long). MPICH allows + * these as well. A strict MPI test should not include this test. + * + * The rule on max loc is that if there is a tie in the value, the minimum + * rank is used (see 4.9.3 in the MPI-1 standard) + */ +int main( int argc, char *argv[] ) +{ + int errs = 0; + int rank, size; + MPI_Comm comm; + + MTest_Init( &argc, &argv ); + + comm = MPI_COMM_WORLD; + + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + + /* 2 int */ + { + struct twoint { int val; int loc; } cinbuf[3], coutbuf[3]; + + cinbuf[0].val = 1; + cinbuf[0].loc = rank; + cinbuf[1].val = 0; + cinbuf[1].loc = rank; + cinbuf[2].val = rank; + cinbuf[2].loc = rank; + + coutbuf[0].val = 0; + coutbuf[0].loc = -1; + coutbuf[1].val = 1; + coutbuf[1].loc = -1; + coutbuf[2].val = 1; + coutbuf[2].loc = -1; + MPI_Reduce( cinbuf, coutbuf, 3, MPI_2INT, MPI_MAXLOC, 0, comm ); + if (rank == 0) { + if (coutbuf[0].val != 1 || coutbuf[0].loc != 0) { + errs++; + fprintf( stderr, "2int MAXLOC(1) test failed\n" ); + } + if (coutbuf[1].val != 0) { + errs++; + fprintf( stderr, "2int MAXLOC(0) test failed, value = %d, should be zero\n", coutbuf[1].val ); + } + if (coutbuf[1].loc != 0) { + errs++; + fprintf( stderr, "2int MAXLOC(0) test failed, location of max = %d, should be zero\n", coutbuf[1].loc ); + } + if (coutbuf[2].val != size-1 || coutbuf[2].loc != size-1) { + errs++; + fprintf( stderr, "2int MAXLOC(>) test failed\n" ); + } + } + } + + /* float int */ + { + struct floatint { float val; int loc; } cinbuf[3], coutbuf[3]; + + cinbuf[0].val = 1; + cinbuf[0].loc = rank; + cinbuf[1].val = 0; + cinbuf[1].loc = rank; + cinbuf[2].val = (float)rank; + cinbuf[2].loc = rank; + + coutbuf[0].val = 0; + coutbuf[0].loc = -1; + coutbuf[1].val = 1; + coutbuf[1].loc = -1; + coutbuf[2].val = 1; + coutbuf[2].loc = -1; + MPI_Reduce( cinbuf, coutbuf, 3, MPI_FLOAT_INT, MPI_MAXLOC, 0, comm ); + if (rank == 0) { + if (coutbuf[0].val != 1 || coutbuf[0].loc != 0) { + errs++; + fprintf( stderr, "float-int MAXLOC(1) test failed\n" ); + } + if (coutbuf[1].val != 0) { + errs++; + fprintf( stderr, "float-int MAXLOC(0) test failed, value = %f, should be zero\n", coutbuf[1].val ); + } + if (coutbuf[1].loc != 0) { + errs++; + fprintf( stderr, "float-int MAXLOC(0) test failed, location of max = %d, should be zero\n", coutbuf[1].loc ); + } + if (coutbuf[2].val != size-1 || coutbuf[2].loc != size-1) { + errs++; + fprintf( stderr, "float-int MAXLOC(>) test failed\n" ); + } + } + } + + /* long int */ + { + struct longint { long val; int loc; } cinbuf[3], coutbuf[3]; + + cinbuf[0].val = 1; + cinbuf[0].loc = rank; + cinbuf[1].val = 0; + cinbuf[1].loc = rank; + cinbuf[2].val = rank; + cinbuf[2].loc = rank; + + coutbuf[0].val = 0; + coutbuf[0].loc = -1; + coutbuf[1].val = 1; + coutbuf[1].loc = -1; + coutbuf[2].val = 1; + coutbuf[2].loc = -1; + MPI_Reduce( cinbuf, coutbuf, 3, MPI_LONG_INT, MPI_MAXLOC, 0, comm ); + if (rank == 0) { + if (coutbuf[0].val != 1 || coutbuf[0].loc != 0) { + errs++; + fprintf( stderr, "long-int MAXLOC(1) test failed\n" ); + } + if (coutbuf[1].val != 0) { + errs++; + fprintf( stderr, "long-int MAXLOC(0) test failed, value = %ld, should be zero\n", coutbuf[1].val ); + } + if (coutbuf[1].loc != 0) { + errs++; + fprintf( stderr, "long-int MAXLOC(0) test failed, location of max = %d, should be zero\n", coutbuf[1].loc ); + } + if (coutbuf[2].val != size-1 || coutbuf[2].loc != size-1) { + errs++; + fprintf( stderr, "long-int MAXLOC(>) test failed\n" ); + } + } + } + + /* short int */ + { + struct shortint { short val; int loc; } cinbuf[3], coutbuf[3]; + + cinbuf[0].val = 1; + cinbuf[0].loc = rank; + cinbuf[1].val = 0; + cinbuf[1].loc = rank; + cinbuf[2].val = rank; + cinbuf[2].loc = rank; + + coutbuf[0].val = 0; + coutbuf[0].loc = -1; + coutbuf[1].val = 1; + coutbuf[1].loc = -1; + coutbuf[2].val = 1; + coutbuf[2].loc = -1; + MPI_Reduce( cinbuf, coutbuf, 3, MPI_SHORT_INT, MPI_MAXLOC, 0, comm ); + if (rank == 0) { + if (coutbuf[0].val != 1 || coutbuf[0].loc != 0) { + errs++; + fprintf( stderr, "short-int MAXLOC(1) test failed\n" ); + } + if (coutbuf[1].val != 0) { + errs++; + fprintf( stderr, "short-int MAXLOC(0) test failed, value = %d, should be zero\n", coutbuf[1].val ); + } + if (coutbuf[1].loc != 0) { + errs++; + fprintf( stderr, "short-int MAXLOC(0) test failed, location of max = %d, should be zero\n", coutbuf[1].loc ); + } + if (coutbuf[2].val != size-1) { + errs++; + fprintf( stderr, "short-int MAXLOC(>) test failed, value = %d, should be %d\n", coutbuf[2].val, size-1 ); + } + if (coutbuf[2].loc != size -1) { + errs++; + fprintf( stderr, "short-int MAXLOC(>) test failed, location of max = %d, should be %d\n", coutbuf[2].loc, size-1 ); + } + } + } + + /* double int */ + { + struct doubleint { double val; int loc; } cinbuf[3], coutbuf[3]; + + cinbuf[0].val = 1; + cinbuf[0].loc = rank; + cinbuf[1].val = 0; + cinbuf[1].loc = rank; + cinbuf[2].val = rank; + cinbuf[2].loc = rank; + + coutbuf[0].val = 0; + coutbuf[0].loc = -1; + coutbuf[1].val = 1; + coutbuf[1].loc = -1; + coutbuf[2].val = 1; + coutbuf[2].loc = -1; + MPI_Reduce( cinbuf, coutbuf, 3, MPI_DOUBLE_INT, MPI_MAXLOC, 0, comm ); + if (rank == 0) { + if (coutbuf[0].val != 1 || coutbuf[0].loc != 0) { + errs++; + fprintf( stderr, "double-int MAXLOC(1) test failed\n" ); + } + if (coutbuf[1].val != 0) { + errs++; + fprintf( stderr, "double-int MAXLOC(0) test failed, value = %lf, should be zero\n", coutbuf[1].val ); + } + if (coutbuf[1].loc != 0) { + errs++; + fprintf( stderr, "double-int MAXLOC(0) test failed, location of max = %d, should be zero\n", coutbuf[1].loc ); + } + if (coutbuf[2].val != size-1 || coutbuf[2].loc != size-1) { + errs++; + fprintf( stderr, "double-int MAXLOC(>) test failed\n" ); + } + } + } + +#ifdef HAVE_LONG_DOUBLE + /* long double int */ + { + struct longdoubleint { long double val; int loc; } cinbuf[3], coutbuf[3]; + + /* avoid valgrind warnings about padding bytes in the long double */ + memset(&cinbuf[0], 0, sizeof(cinbuf)); + memset(&coutbuf[0], 0, sizeof(coutbuf)); + + cinbuf[0].val = 1; + cinbuf[0].loc = rank; + cinbuf[1].val = 0; + cinbuf[1].loc = rank; + cinbuf[2].val = rank; + cinbuf[2].loc = rank; + + coutbuf[0].val = 0; + coutbuf[0].loc = -1; + coutbuf[1].val = 1; + coutbuf[1].loc = -1; + coutbuf[2].val = 1; + coutbuf[2].loc = -1; + if (MPI_LONG_DOUBLE != MPI_DATATYPE_NULL) { + MPI_Reduce( cinbuf, coutbuf, 3, MPI_LONG_DOUBLE_INT, MPI_MAXLOC, + 0, comm ); + if (rank == 0) { + if (coutbuf[0].val != 1 || coutbuf[0].loc != 0) { + errs++; + fprintf( stderr, "long double-int MAXLOC(1) test failed\n" ); + } + if (coutbuf[1].val != 0) { + errs++; + fprintf( stderr, "long double-int MAXLOC(0) test failed, value = %lf, should be zero\n", (double)coutbuf[1].val ); + } + if (coutbuf[1].loc != 0) { + errs++; + fprintf( stderr, "long double-int MAXLOC(0) test failed, location of max = %d, should be zero\n", coutbuf[1].loc ); + } + if (coutbuf[2].val != size-1) { + errs++; + fprintf( stderr, "long double-int MAXLOC(>) test failed, value = %lf, should be %d\n", (double)coutbuf[2].val, size-1 ); + } + if (coutbuf[2].loc != size-1) { + errs++; + fprintf( stderr, "long double-int MAXLOC(>) test failed, location of max = %d, should be %d\n", coutbuf[2].loc, size-1 ); + } + } + } + } +#endif + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/coll/opmin.c b/teshsuite/smpi/mpich3-test/coll/opmin.c new file mode 100644 index 0000000000..59202da903 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/coll/opmin.c @@ -0,0 +1,180 @@ +/* -*- 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 "mpitestconf.h" +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Test MPI_MIN operations on optional datatypes dupported by MPICH"; +*/ + +/* + * This test looks at the handling of char and types that are not required + * integers (e.g., long long). MPICH allows + * these as well. A strict MPI test should not include this test. + */ +int main( int argc, char *argv[] ) +{ + int errs = 0; + int rank, size; + MPI_Comm comm; + char cinbuf[3], coutbuf[3]; + signed char scinbuf[3], scoutbuf[3]; + unsigned char ucinbuf[3], ucoutbuf[3]; + + MTest_Init( &argc, &argv ); + + comm = MPI_COMM_WORLD; + + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + +#ifndef USE_STRICT_MPI + /* char */ + MTestPrintfMsg( 10, "Reduce of MPI_CHAR\n" ); + cinbuf[0] = 1; + cinbuf[1] = 0; + cinbuf[2] = (rank & 0x7f); + + coutbuf[0] = 0; + coutbuf[1] = 1; + coutbuf[2] = 1; + MPI_Reduce( cinbuf, coutbuf, 3, MPI_CHAR, MPI_MIN, 0, comm ); + if (rank == 0) { + if (coutbuf[0] != 1) { + errs++; + fprintf( stderr, "char MIN(1) test failed\n" ); + } + if (coutbuf[1] != 0) { + errs++; + fprintf( stderr, "char MIN(0) test failed\n" ); + } + if (coutbuf[2] != 0) { + errs++; + fprintf( stderr, "char MIN(>) test failed\n" ); + } + } +#endif /* USE_STRICT_MPI */ + + /* signed char */ + MTestPrintfMsg( 10, "Reduce of MPI_SIGNED_CHAR\n" ); + scinbuf[0] = 1; + scinbuf[1] = 0; + scinbuf[2] = (rank & 0x7f); + + scoutbuf[0] = 0; + scoutbuf[1] = 1; + scoutbuf[2] = 1; + MPI_Reduce( scinbuf, scoutbuf, 3, MPI_SIGNED_CHAR, MPI_MIN, 0, comm ); + if (rank == 0) { + if (scoutbuf[0] != 1) { + errs++; + fprintf( stderr, "signed char MIN(1) test failed\n" ); + } + if (scoutbuf[1] != 0) { + errs++; + fprintf( stderr, "signed char MIN(0) test failed\n" ); + } + if (scoutbuf[2] != 0) { + errs++; + fprintf( stderr, "signed char MIN(>) test failed\n" ); + } + } + + /* unsigned char */ + MTestPrintfMsg( 10, "Reduce of MPI_UNSIGNED_CHAR\n" ); + ucinbuf[0] = 1; + ucinbuf[1] = 0; + ucinbuf[2] = (rank & 0x7f); + + ucoutbuf[0] = 0; + ucoutbuf[1] = 1; + ucoutbuf[2] = 1; + MPI_Reduce( ucinbuf, ucoutbuf, 3, MPI_UNSIGNED_CHAR, MPI_MIN, 0, comm ); + if (rank == 0) { + if (ucoutbuf[0] != 1) { + errs++; + fprintf( stderr, "unsigned char MIN(1) test failed\n" ); + } + if (ucoutbuf[1]) { + errs++; + fprintf( stderr, "unsigned char MIN(0) test failed\n" ); + } + if (ucoutbuf[2] != 0) { + errs++; + fprintf( stderr, "unsigned char MIN(>) test failed\n" ); + } + } + +#ifdef HAVE_LONG_DOUBLE + { long double ldinbuf[3], ldoutbuf[3]; + /* long double */ + ldinbuf[0] = 1; + ldinbuf[1] = 0; + ldinbuf[2] = rank; + + ldoutbuf[0] = 0; + ldoutbuf[1] = 1; + ldoutbuf[2] = 1; + if (MPI_LONG_DOUBLE != MPI_DATATYPE_NULL) { + MTestPrintfMsg( 10, "Reduce of MPI_LONG_DOUBLE\n" ); + MPI_Reduce( ldinbuf, ldoutbuf, 3, MPI_LONG_DOUBLE, MPI_MIN, 0, comm ); + if (rank == 0) { + if (ldoutbuf[0] != 1) { + errs++; + fprintf( stderr, "long double MIN(1) test failed\n" ); + } + if (ldoutbuf[1] != 0.0) { + errs++; + fprintf( stderr, "long double MIN(0) test failed\n" ); + } + if (ldoutbuf[2] != 0.0) { + errs++; + fprintf( stderr, "long double MIN(>) test failed\n" ); + } + } + } + } +#endif /* HAVE_LONG_DOUBLE */ + +#ifdef HAVE_LONG_LONG + { + long long llinbuf[3], lloutbuf[3]; + /* long long */ + llinbuf[0] = 1; + llinbuf[1] = 0; + llinbuf[2] = rank; + + lloutbuf[0] = 0; + lloutbuf[1] = 1; + lloutbuf[2] = 1; + if (MPI_LONG_LONG != MPI_DATATYPE_NULL) { + MTestPrintfMsg( 10, "Reduce of MPI_LONG_LONG\n" ); + MPI_Reduce( llinbuf, lloutbuf, 3, MPI_LONG_LONG, MPI_MIN, 0, comm ); + if (rank == 0) { + if (lloutbuf[0] != 1) { + errs++; + fprintf( stderr, "long long MIN(1) test failed\n" ); + } + if (lloutbuf[1] != 0) { + errs++; + fprintf( stderr, "long long MIN(0) test failed\n" ); + } + if (lloutbuf[2] != 0) { + errs++; + fprintf( stderr, "long long MIN(>) test failed\n" ); + } + } + } + } +#endif /* HAVE_LONG_LONG */ + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/coll/opminloc.c b/teshsuite/smpi/mpich3-test/coll/opminloc.c new file mode 100644 index 0000000000..9eb84ee7c6 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/coll/opminloc.c @@ -0,0 +1,249 @@ +/* -*- 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 "mpitestconf.h" +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Test MPI_MINLOC operations on datatypes dupported by MPICH"; +*/ + +/* + * This test looks at the handling of char and types that are not required + * integers (e.g., long long). MPICH allows + * these as well. A strict MPI test should not include this test. + * + * The rule on min loc is that if there is a tie in the value, the minimum + * rank is used (see 4.9.3 in the MPI-1 standard) + */ +int main( int argc, char *argv[] ) +{ + int errs = 0; + int rank, size; + MPI_Comm comm; + + MTest_Init( &argc, &argv ); + + comm = MPI_COMM_WORLD; + + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + + /* 2 int */ + { + struct twoint { int val; int loc; } cinbuf[3], coutbuf[3]; + + cinbuf[0].val = 1; + cinbuf[0].loc = rank; + cinbuf[1].val = 0; + cinbuf[1].loc = rank; + cinbuf[2].val = (rank & 0x7f); + cinbuf[2].loc = rank; + + coutbuf[0].val = 0; + coutbuf[0].loc = -1; + coutbuf[1].val = 1; + coutbuf[1].loc = -1; + coutbuf[2].val = 1; + coutbuf[2].loc = -1; + MPI_Reduce( cinbuf, coutbuf, 3, MPI_2INT, MPI_MINLOC, 0, comm ); + if (rank == 0) { + if (coutbuf[0].val != 1 && coutbuf[0].loc != -1) { + errs++; + fprintf( stderr, "2int MINLOC(1) test failed\n" ); + } + if (coutbuf[1].val != 0 && coutbuf[1].loc != -1) { + errs++; + fprintf( stderr, "2int MINLOC(0) test failed\n" ); + } + if (coutbuf[2].val != 0 && coutbuf[2].loc != 0) { + errs++; + fprintf( stderr, "2int MINLOC(>) test failed\n" ); + } + } + } + + /* float int */ + { + struct floatint { float val; int loc; } cinbuf[3], coutbuf[3]; + + cinbuf[0].val = 1; + cinbuf[0].loc = rank; + cinbuf[1].val = 0; + cinbuf[1].loc = rank; + cinbuf[2].val = (float)rank; + cinbuf[2].loc = rank; + + coutbuf[0].val = 0; + coutbuf[0].loc = -1; + coutbuf[1].val = 1; + coutbuf[1].loc = -1; + coutbuf[2].val = 1; + coutbuf[2].loc = -1; + MPI_Reduce( cinbuf, coutbuf, 3, MPI_FLOAT_INT, MPI_MINLOC, 0, comm ); + if (rank == 0) { + if (coutbuf[0].val != 1 && coutbuf[0].loc != -1) { + errs++; + fprintf( stderr, "float-int MINLOC(1) test failed\n" ); + } + if (coutbuf[1].val != 0 && coutbuf[1].loc != -1) { + errs++; + fprintf( stderr, "float-int MINLOC(0) test failed\n" ); + } + if (coutbuf[2].val != 0 && coutbuf[2].loc != 0) { + errs++; + fprintf( stderr, "float-int MINLOC(>) test failed\n" ); + } + } + } + + /* long int */ + { + struct longint { long val; int loc; } cinbuf[3], coutbuf[3]; + + cinbuf[0].val = 1; + cinbuf[0].loc = rank; + cinbuf[1].val = 0; + cinbuf[1].loc = rank; + cinbuf[2].val = rank; + cinbuf[2].loc = rank; + + coutbuf[0].val = 0; + coutbuf[0].loc = -1; + coutbuf[1].val = 1; + coutbuf[1].loc = -1; + coutbuf[2].val = 1; + coutbuf[2].loc = -1; + MPI_Reduce( cinbuf, coutbuf, 3, MPI_LONG_INT, MPI_MINLOC, 0, comm ); + if (rank == 0) { + if (coutbuf[0].val != 1 || coutbuf[0].loc != 0) { + errs++; + fprintf( stderr, "long-int MINLOC(1) test failed\n" ); + } + if (coutbuf[1].val != 0 || coutbuf[1].loc != 0) { + errs++; + fprintf( stderr, "long-int MINLOC(0) test failed\n" ); + } + if (coutbuf[2].val != 0 || coutbuf[2].loc != 0) { + errs++; + fprintf( stderr, "long-int MINLOC(>) test failed\n" ); + } + } + } + + /* short int */ + { + struct shortint { short val; int loc; } cinbuf[3], coutbuf[3]; + + cinbuf[0].val = 1; + cinbuf[0].loc = rank; + cinbuf[1].val = 0; + cinbuf[1].loc = rank; + cinbuf[2].val = rank; + cinbuf[2].loc = rank; + + coutbuf[0].val = 0; + coutbuf[0].loc = -1; + coutbuf[1].val = 1; + coutbuf[1].loc = -1; + coutbuf[2].val = 1; + coutbuf[2].loc = -1; + MPI_Reduce( cinbuf, coutbuf, 3, MPI_SHORT_INT, MPI_MINLOC, 0, comm ); + if (rank == 0) { + if (coutbuf[0].val != 1 || coutbuf[0].loc != 0) { + errs++; + fprintf( stderr, "short-int MINLOC(1) test failed\n" ); + } + if (coutbuf[1].val != 0 || coutbuf[1].loc != 0) { + errs++; + fprintf( stderr, "short-int MINLOC(0) test failed\n" ); + } + if (coutbuf[2].val != 0 || coutbuf[2].loc != 0) { + errs++; + fprintf( stderr, "short-int MINLOC(>) test failed\n" ); + } + } + } + + /* double int */ + { + struct doubleint { double val; int loc; } cinbuf[3], coutbuf[3]; + + cinbuf[0].val = 1; + cinbuf[0].loc = rank; + cinbuf[1].val = 0; + cinbuf[1].loc = rank; + cinbuf[2].val = rank; + cinbuf[2].loc = rank; + + coutbuf[0].val = 0; + coutbuf[0].loc = -1; + coutbuf[1].val = 1; + coutbuf[1].loc = -1; + coutbuf[2].val = 1; + coutbuf[2].loc = -1; + MPI_Reduce( cinbuf, coutbuf, 3, MPI_DOUBLE_INT, MPI_MINLOC, 0, comm ); + if (rank == 0) { + if (coutbuf[0].val != 1 || coutbuf[0].loc != 0) { + errs++; + fprintf( stderr, "double-int MINLOC(1) test failed\n" ); + } + if (coutbuf[1].val != 0 || coutbuf[1].loc != 0) { + errs++; + fprintf( stderr, "double-int MINLOC(0) test failed\n" ); + } + if (coutbuf[2].val != 0 || coutbuf[2].loc != 0) { + errs++; + fprintf( stderr, "double-int MINLOC(>) test failed\n" ); + } + } + } + +#ifdef HAVE_LONG_DOUBLE + /* long double int */ + { + struct longdoubleint { long double val; int loc; } cinbuf[3], coutbuf[3]; + + cinbuf[0].val = 1; + cinbuf[0].loc = rank; + cinbuf[1].val = 0; + cinbuf[1].loc = rank; + cinbuf[2].val = rank; + cinbuf[2].loc = rank; + + coutbuf[0].val = 0; + coutbuf[0].loc = -1; + coutbuf[1].val = 1; + coutbuf[1].loc = -1; + coutbuf[2].val = 1; + coutbuf[2].loc = -1; + if (MPI_LONG_DOUBLE != MPI_DATATYPE_NULL) { + MPI_Reduce( cinbuf, coutbuf, 3, MPI_LONG_DOUBLE_INT, MPI_MINLOC, + 0, comm ); + if (rank == 0) { + if (coutbuf[0].val != 1 || coutbuf[0].loc != 0) { + errs++; + fprintf( stderr, "long double-int MINLOC(1) test failed\n" ); + } + if (coutbuf[1].val != 0 || coutbuf[1].loc != 0) { + errs++; + fprintf( stderr, "long double-int MINLOC(0) test failed\n" ); + } + if (coutbuf[2].val != 0 || coutbuf[2].loc != 0) { + errs++; + fprintf( stderr, "long double-int MINLOC(>) test failed\n" ); + } + } + } + } +#endif + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/coll/opprod.c b/teshsuite/smpi/mpich3-test/coll/opprod.c new file mode 100644 index 0000000000..e96aae21b2 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/coll/opprod.c @@ -0,0 +1,289 @@ +/* -*- 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 "mpitestconf.h" +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Test MPI_PROD operations on optional datatypes dupported by MPICH"; +*/ + +typedef struct { double r, i; } d_complex; +#ifdef HAVE_LONG_DOUBLE +typedef struct { long double r, i; } ld_complex; +#endif + +/* + * This test looks at the handling of logical and for types that are not + * integers or are not required integers (e.g., long long). MPICH allows + * these as well. A strict MPI test should not include this test. + */ +int main( int argc, char *argv[] ) +{ + int errs = 0; + int rank, size, maxsize, result[6] = { 1, 1, 2, 6, 24, 120 }; + MPI_Comm comm; + char cinbuf[3], coutbuf[3]; + signed char scinbuf[3], scoutbuf[3]; + unsigned char ucinbuf[3], ucoutbuf[3]; + d_complex dinbuf[3], doutbuf[3]; + + MTest_Init( &argc, &argv ); + + comm = MPI_COMM_WORLD; + + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + if (size > 5) maxsize = 5; + else maxsize = size; + + /* General forumula: If we multiple the values from 1 to n, the + product is n!. This grows very fast, so we'll only use the first + five (1! = 1, 2! = 2, 3! = 6, 4! = 24, 5! = 120), with n! + stored in the array result[n] */ + +#ifndef USE_STRICT_MPI + /* char */ + MTestPrintfMsg( 10, "Reduce of MPI_CHAR\n" ); + cinbuf[0] = (rank < maxsize && rank > 0) ? rank : 1; + cinbuf[1] = 0; + cinbuf[2] = (rank > 1); + + coutbuf[0] = 0; + coutbuf[1] = 1; + coutbuf[2] = 1; + MPI_Reduce( cinbuf, coutbuf, 3, MPI_CHAR, MPI_PROD, 0, comm ); + if (rank == 0) { + if (coutbuf[0] != (char)result[maxsize-1]) { + errs++; + fprintf( stderr, "char PROD(rank) test failed (%d!=%d)\n", + (int)coutbuf[0], (int)result[maxsize]); + } + if (coutbuf[1]) { + errs++; + fprintf( stderr, "char PROD(0) test failed\n" ); + } + if (size > 1 && coutbuf[2]) { + errs++; + fprintf( stderr, "char PROD(>) test failed\n" ); + } + } +#endif /* USE_STRICT_MPI */ + + /* signed char */ + MTestPrintfMsg( 10, "Reduce of MPI_SIGNED_CHAR\n" ); + scinbuf[0] = (rank < maxsize && rank > 0) ? rank : 1; + scinbuf[1] = 0; + scinbuf[2] = (rank > 1); + + scoutbuf[0] = 0; + scoutbuf[1] = 1; + scoutbuf[2] = 1; + MPI_Reduce( scinbuf, scoutbuf, 3, MPI_SIGNED_CHAR, MPI_PROD, 0, comm ); + if (rank == 0) { + if (scoutbuf[0] != (signed char)result[maxsize-1]) { + errs++; + fprintf( stderr, "signed char PROD(rank) test failed (%d!=%d)\n", + (int)scoutbuf[0], (int)result[maxsize]); + } + if (scoutbuf[1]) { + errs++; + fprintf( stderr, "signed char PROD(0) test failed\n" ); + } + if (size > 1 && scoutbuf[2]) { + errs++; + fprintf( stderr, "signed char PROD(>) test failed\n" ); + } + } + + /* unsigned char */ + MTestPrintfMsg( 10, "Reduce of MPI_UNSIGNED_CHAR\n" ); + ucinbuf[0] = (rank < maxsize && rank > 0) ? rank : 1; + ucinbuf[1] = 0; + ucinbuf[2] = (rank > 0); + + ucoutbuf[0] = 0; + ucoutbuf[1] = 1; + ucoutbuf[2] = 1; + MPI_Reduce( ucinbuf, ucoutbuf, 3, MPI_UNSIGNED_CHAR, MPI_PROD, 0, comm ); + if (rank == 0) { + if (ucoutbuf[0] != (unsigned char)result[maxsize-1]) { + errs++; + fprintf( stderr, "unsigned char PROD(rank) test failed\n" ); + } + if (ucoutbuf[1]) { + errs++; + fprintf( stderr, "unsigned char PROD(0) test failed\n" ); + } + if (size > 1 && ucoutbuf[2]) { + errs++; + fprintf( stderr, "unsigned char PROD(>) test failed\n" ); + } + } + +#ifndef USE_STRICT_MPI + /* For some reason, complex is not allowed for sum and prod */ + if (MPI_DOUBLE_COMPLEX != MPI_DATATYPE_NULL) { + int dc; +#ifdef HAVE_LONG_DOUBLE + ld_complex ldinbuf[3], ldoutbuf[3]; +#endif + /* Must determine which C type matches this Fortran type */ + MPI_Type_size( MPI_DOUBLE_COMPLEX, &dc ); + if (dc == sizeof(d_complex)) { + /* double complex; may be null if we do not have Fortran support */ + dinbuf[0].r = (rank < maxsize && rank > 0) ? rank : 1; + dinbuf[1].r = 0; + dinbuf[2].r = (rank > 0); + dinbuf[0].i = 0; + dinbuf[1].i = 1; + dinbuf[2].i = -(rank > 0); + + doutbuf[0].r = 0; + doutbuf[1].r = 1; + doutbuf[2].r = 1; + doutbuf[0].i = 0; + doutbuf[1].i = 1; + doutbuf[2].i = 1; + MPI_Reduce( dinbuf, doutbuf, 3, MPI_DOUBLE_COMPLEX, MPI_PROD, 0, comm ); + if (rank == 0) { + double imag, real; + if (doutbuf[0].r != (double)result[maxsize-1] || doutbuf[0].i != 0) { + errs++; + fprintf( stderr, "double complex PROD(rank) test failed\n" ); + } + /* Multiplying the imaginary part depends on size mod 4 */ + imag = 1.0; real = 0.0; /* Make compiler happy */ + switch (size % 4) { + case 1: imag = 1.0; real = 0.0; break; + case 2: imag = 0.0; real = -1.0; break; + case 3: imag =-1.0; real = 0.0; break; + case 0: imag = 0.0; real = 1.0; break; + } + if (doutbuf[1].r != real || doutbuf[1].i != imag) { + errs++; + fprintf( stderr, "double complex PROD(i) test failed (%f,%f)!=(%f,%f)\n", + doutbuf[1].r,doutbuf[1].i,real,imag); + } + if (doutbuf[2].r != 0 || doutbuf[2].i != 0) { + errs++; + fprintf( stderr, "double complex PROD(>) test failed\n" ); + } + } + } +#ifdef HAVE_LONG_DOUBLE + else if (dc == sizeof(ld_complex)) { + /* double complex; may be null if we do not have Fortran support */ + ldinbuf[0].r = (rank < maxsize && rank > 0) ? rank : 1; + ldinbuf[1].r = 0; + ldinbuf[2].r = (rank > 0); + ldinbuf[0].i = 0; + ldinbuf[1].i = 1; + ldinbuf[2].i = -(rank > 0); + + ldoutbuf[0].r = 0; + ldoutbuf[1].r = 1; + ldoutbuf[2].r = 1; + ldoutbuf[0].i = 0; + ldoutbuf[1].i = 1; + ldoutbuf[2].i = 1; + MPI_Reduce( ldinbuf, ldoutbuf, 3, MPI_DOUBLE_COMPLEX, MPI_PROD, 0, comm ); + if (rank == 0) { + long double imag, real; + if (ldoutbuf[0].r != (double)result[maxsize-1] || ldoutbuf[0].i != 0) { + errs++; + fprintf( stderr, "double complex PROD(rank) test failed\n" ); + } + /* Multiplying the imaginary part depends on size mod 4 */ + imag = 1.0; real = 0.0; /* Make compiler happy */ + switch (size % 4) { + case 1: imag = 1.0; real = 0.0; break; + case 2: imag = 0.0; real = -1.0; break; + case 3: imag =-1.0; real = 0.0; break; + case 0: imag = 0.0; real = 1.0; break; + } + if (ldoutbuf[1].r != real || ldoutbuf[1].i != imag) { + errs++; + fprintf( stderr, "double complex PROD(i) test failed (%Lf,%Lf)!=(%Lf,%Lf)\n", + ldoutbuf[1].r,ldoutbuf[1].i,real,imag); + } + if (ldoutbuf[2].r != 0 || ldoutbuf[2].i != 0) { + errs++; + fprintf( stderr, "double complex PROD(>) test failed\n" ); + } + } + } +#endif /* HAVE_LONG_DOUBLE */ + } +#endif /* USE_STRICT_MPI */ + +#ifdef HAVE_LONG_DOUBLE + { long double ldinbuf[3], ldoutbuf[3]; + /* long double */ + ldinbuf[0] = (rank < maxsize && rank > 0) ? rank : 1; + ldinbuf[1] = 0; + ldinbuf[2] = (rank > 0); + + ldoutbuf[0] = 0; + ldoutbuf[1] = 1; + ldoutbuf[2] = 1; + if (MPI_LONG_DOUBLE != MPI_DATATYPE_NULL) { + MPI_Reduce( ldinbuf, ldoutbuf, 3, MPI_LONG_DOUBLE, MPI_PROD, 0, comm ); + if (rank == 0) { + if (ldoutbuf[0] != (long double)result[maxsize-1]) { + errs++; + fprintf( stderr, "long double PROD(rank) test failed\n" ); + } + if (ldoutbuf[1]) { + errs++; + fprintf( stderr, "long double PROD(0) test failed\n" ); + } + if (size > 1 && ldoutbuf[2] != 0) { + errs++; + fprintf( stderr, "long double PROD(>) test failed\n" ); + } + } + } + } +#endif /* HAVE_LONG_DOUBLE */ + +#ifdef HAVE_LONG_LONG + { + long long llinbuf[3], lloutbuf[3]; + /* long long */ + llinbuf[0] = (rank < maxsize && rank > 0) ? rank : 1; + llinbuf[1] = 0; + llinbuf[2] = (rank > 0); + + lloutbuf[0] = 0; + lloutbuf[1] = 1; + lloutbuf[2] = 1; + if (MPI_LONG_LONG != MPI_DATATYPE_NULL) { + MPI_Reduce( llinbuf, lloutbuf, 3, MPI_LONG_LONG, MPI_PROD, 0, comm ); + if (rank == 0) { + if (lloutbuf[0] != (long long)result[maxsize-1]) { + errs++; + fprintf( stderr, "long long PROD(rank) test failed\n" ); + } + if (lloutbuf[1]) { + errs++; + fprintf( stderr, "long long PROD(0) test failed\n" ); + } + if (size > 1 && lloutbuf[2]) { + errs++; + fprintf( stderr, "long long PROD(>) test failed\n" ); + } + } + } + } +#endif /* HAVE_LONG_LONG */ + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/coll/opsum.c b/teshsuite/smpi/mpich3-test/coll/opsum.c new file mode 100644 index 0000000000..c9bd5f8b2f --- /dev/null +++ b/teshsuite/smpi/mpich3-test/coll/opsum.c @@ -0,0 +1,266 @@ +/* -*- 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 "mpitestconf.h" +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Test MPI_SUM operations on optional datatypes dupported by MPICH"; +*/ + +typedef struct { double r, i; } d_complex; +#ifdef HAVE_LONG_DOUBLE +typedef struct { long double r, i; } ld_complex; +#endif + +/* + * This test looks at the handling of logical and for types that are not + * integers or are not required integers (e.g., long long). MPICH allows + * these as well. A strict MPI test should not include this test. + */ +int main( int argc, char *argv[] ) +{ + int errs = 0; + int rank, size; + MPI_Comm comm; + char cinbuf[3], coutbuf[3]; + signed char scinbuf[3], scoutbuf[3]; + unsigned char ucinbuf[3], ucoutbuf[3]; + d_complex dinbuf[3], doutbuf[3]; + + MTest_Init( &argc, &argv ); + + comm = MPI_COMM_WORLD; + + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + +#ifndef USE_STRICT_MPI + /* char */ + MTestPrintfMsg( 10, "Reduce of MPI_CHAR\n" ); + cinbuf[0] = 1; + cinbuf[1] = 0; + cinbuf[2] = (rank > 0); + + coutbuf[0] = 0; + coutbuf[1] = 1; + coutbuf[2] = 1; + MPI_Reduce( cinbuf, coutbuf, 3, MPI_CHAR, MPI_SUM, 0, comm ); + if (rank == 0) { + if (size < 128 && coutbuf[0] != size) { + errs++; + fprintf( stderr, "char SUM(1) test failed\n" ); + } + if (size < 128 && coutbuf[1] != 0) { + errs++; + fprintf( stderr, "char SUM(0) test failed\n" ); + } + if (size < 128 && coutbuf[2] != size - 1) { + errs++; + fprintf( stderr, "char SUM(>) test failed\n" ); + } + } +#endif /* USE_MPI_STRICT */ + + /* signed char */ + MTestPrintfMsg( 10, "Reduce of MPI_SIGNED_CHAR\n" ); + scinbuf[0] = 1; + scinbuf[1] = 0; + scinbuf[2] = (rank > 0); + + scoutbuf[0] = 0; + scoutbuf[1] = 1; + scoutbuf[2] = 1; + MPI_Reduce( scinbuf, scoutbuf, 3, MPI_SIGNED_CHAR, MPI_SUM, 0, comm ); + if (rank == 0) { + if (size < 128 && scoutbuf[0] != size) { + errs++; + fprintf( stderr, "signed char SUM(1) test failed\n" ); + } + if (size < 128 && scoutbuf[1] != 0) { + errs++; + fprintf( stderr, "signed char SUM(0) test failed\n" ); + } + if (size < 128 && scoutbuf[2] != size - 1) { + errs++; + fprintf( stderr, "signed char SUM(>) test failed\n" ); + } + } + + /* unsigned char */ + MTestPrintfMsg( 10, "Reduce of MPI_UNSIGNED_CHAR\n" ); + ucinbuf[0] = 1; + ucinbuf[1] = 0; + ucinbuf[2] = (rank > 0); + + ucoutbuf[0] = 0; + ucoutbuf[1] = 1; + ucoutbuf[2] = 1; + MPI_Reduce( ucinbuf, ucoutbuf, 3, MPI_UNSIGNED_CHAR, MPI_SUM, 0, comm ); + if (rank == 0) { + if (size < 128 && ucoutbuf[0] != size) { + errs++; + fprintf( stderr, "unsigned char SUM(1) test failed\n" ); + } + if (size < 128 && ucoutbuf[1]) { + errs++; + fprintf( stderr, "unsigned char SUM(0) test failed\n" ); + } + if (size < 128 && ucoutbuf[2] != size - 1) { + errs++; + fprintf( stderr, "unsigned char SUM(>) test failed\n" ); + } + } + +#ifndef USE_STRICT_MPI + /* For some reason, complex is not allowed for sum and prod */ + if (MPI_DOUBLE_COMPLEX != MPI_DATATYPE_NULL) { + int dc; +#ifdef HAVE_LONG_DOUBLE + ld_complex ldinbuf[3], ldoutbuf[3]; +#endif + /* Must determine which C type matches this Fortran type */ + MPI_Type_size( MPI_DOUBLE_COMPLEX, &dc ); + if (dc == sizeof(d_complex)) { + MTestPrintfMsg( 10, "Reduce of MPI_DOUBLE_COMPLEX\n" ); + /* double complex; may be null if we do not have Fortran support */ + dinbuf[0].r = 1; + dinbuf[1].r = 0; + dinbuf[2].r = (rank > 0); + dinbuf[0].i = -1; + dinbuf[1].i = 0; + dinbuf[2].i = -(rank > 0); + + doutbuf[0].r = 0; + doutbuf[1].r = 1; + doutbuf[2].r = 1; + doutbuf[0].i = 0; + doutbuf[1].i = 1; + doutbuf[2].i = 1; + MPI_Reduce( dinbuf, doutbuf, 3, MPI_DOUBLE_COMPLEX, MPI_SUM, 0, comm ); + if (rank == 0) { + if (doutbuf[0].r != size || doutbuf[0].i != -size) { + errs++; + fprintf( stderr, "double complex SUM(1) test failed\n" ); + } + if (doutbuf[1].r != 0 || doutbuf[1].i != 0) { + errs++; + fprintf( stderr, "double complex SUM(0) test failed\n" ); + } + if (doutbuf[2].r != size - 1 || doutbuf[2].i != 1 - size) { + errs++; + fprintf( stderr, "double complex SUM(>) test failed\n" ); + } + } + } +#ifdef HAVE_LONG_DOUBLE + else if (dc == sizeof(ld_complex)) { + MTestPrintfMsg( 10, "Reduce of MPI_DOUBLE_COMPLEX\n" ); + /* double complex; may be null if we do not have Fortran support */ + ldinbuf[0].r = 1; + ldinbuf[1].r = 0; + ldinbuf[2].r = (rank > 0); + ldinbuf[0].i = -1; + ldinbuf[1].i = 0; + ldinbuf[2].i = -(rank > 0); + + ldoutbuf[0].r = 0; + ldoutbuf[1].r = 1; + ldoutbuf[2].r = 1; + ldoutbuf[0].i = 0; + ldoutbuf[1].i = 1; + ldoutbuf[2].i = 1; + MPI_Reduce( ldinbuf, ldoutbuf, 3, MPI_DOUBLE_COMPLEX, + MPI_SUM, 0, comm ); + if (rank == 0) { + if (ldoutbuf[0].r != size || ldoutbuf[0].i != -size) { + errs++; + fprintf( stderr, "double complex SUM(1) test failed\n" ); + } + if (ldoutbuf[1].r != 0 || ldoutbuf[1].i != 0) { + errs++; + fprintf( stderr, "double complex SUM(0) test failed\n" ); + } + if (ldoutbuf[2].r != size - 1 || ldoutbuf[2].i != 1 - size) { + errs++; + fprintf( stderr, "double complex SUM(>) test failed\n" ); + } + } + } +#endif + /* Implicitly ignore if there is no matching C type */ + } +#endif /* USE_STRICT_MPI */ + +#ifdef HAVE_LONG_DOUBLE + { long double ldinbuf[3], ldoutbuf[3]; + /* long double */ + ldinbuf[0] = 1; + ldinbuf[1] = 0; + ldinbuf[2] = (rank > 0); + + ldoutbuf[0] = 0; + ldoutbuf[1] = 1; + ldoutbuf[2] = 1; + if (MPI_LONG_DOUBLE != MPI_DATATYPE_NULL) { + MTestPrintfMsg( 10, "Reduce of MPI_LONG_DOUBLE\n" ); + MPI_Reduce( ldinbuf, ldoutbuf, 3, MPI_LONG_DOUBLE, MPI_SUM, 0, comm ); + if (rank == 0) { + if (ldoutbuf[0] != size) { + errs++; + fprintf( stderr, "long double SUM(1) test failed\n" ); + } + if (ldoutbuf[1] != 0.0) { + errs++; + fprintf( stderr, "long double SUM(0) test failed\n" ); + } + if (ldoutbuf[2] != size - 1) { + errs++; + fprintf( stderr, "long double SUM(>) test failed\n" ); + } + } + } + } +#endif + +#ifdef HAVE_LONG_LONG + { + long long llinbuf[3], lloutbuf[3]; + /* long long */ + llinbuf[0] = 1; + llinbuf[1] = 0; + llinbuf[2] = (rank > 0); + + lloutbuf[0] = 0; + lloutbuf[1] = 1; + lloutbuf[2] = 1; + if (MPI_LONG_LONG != MPI_DATATYPE_NULL) { + MTestPrintfMsg( 10, "Reduce of MPI_LONG_LONG\n" ); + MPI_Reduce( llinbuf, lloutbuf, 3, MPI_LONG_LONG, MPI_SUM, 0, comm ); + if (rank == 0) { + if (lloutbuf[0] != size) { + errs++; + fprintf( stderr, "long long SUM(1) test failed\n" ); + } + if (lloutbuf[1] != 0) { + errs++; + fprintf( stderr, "long long SUM(0) test failed\n" ); + } + if (lloutbuf[2] != size - 1) { + errs++; + fprintf( stderr, "long long SUM(>) test failed\n" ); + } + } + } + } +#endif + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/coll/red3.c b/teshsuite/smpi/mpich3-test/coll/red3.c new file mode 100644 index 0000000000..32358d992d --- /dev/null +++ b/teshsuite/smpi/mpich3-test/coll/red3.c @@ -0,0 +1,200 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2003 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include "mpi.h" +#include +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Test MPI_Reduce with non-commutative user-define operations"; +*/ +/* + * This tests that the reduce operation respects the noncommutative flag. + * See red4.c for a version that can distinguish between P_{root} P_{root+1} + * ... P_{root-1} and P_0 ... P_{size-1} . The MPI standard clearly + * specifies that the result is P_0 ... P_{size-1}, independent of the root + * (see 4.9.4 in MPI-1) + */ + +/* This implements a simple matrix-matrix multiply. This is an associative + but not commutative operation. The matrix size is set in matSize; + the number of matrices is the count argument. The matrix is stored + in C order, so that + c(i,j) is cin[j+i*matSize] + */ +#define MAXCOL 256 +static int matSize = 0; /* Must be < MAXCOL */ +void uop( void *cinPtr, void *coutPtr, int *count, MPI_Datatype *dtype ); +void uop( void *cinPtr, void *coutPtr, int *count, MPI_Datatype *dtype ) +{ + const int *cin = (const int *)cinPtr; + int *cout = (int *)coutPtr; + int i, j, k, nmat; + int tempCol[MAXCOL]; + + for (nmat = 0; nmat < *count; nmat++) { + for (j=0; j +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Test MPI_Reduce with non-commutative user-define operations and arbitrary root"; +*/ + +/* + * This tests that the reduce operation respects the noncommutative flag. + * and that can distinguish between P_{root} P_{root+1} + * ... P_{root-1} and P_0 ... P_{size-1} . The MPI standard clearly + * specifies that the result is P_0 ... P_{size-1}, independent of the root + * (see 4.9.4 in MPI-1) + */ + +/* This implements a simple matrix-matrix multiply. This is an associative + but not commutative operation. The matrix size is set in matSize; + the number of matrices is the count argument. The matrix is stored + in C order, so that + c(i,j) is cin[j+i*matSize] + */ +#define MAXCOL 256 +static int matSize = 0; /* Must be < MAXCOL */ + +void uop( void *cinPtr, void *coutPtr, int *count, MPI_Datatype *dtype ); +void uop( void *cinPtr, void *coutPtr, int *count, MPI_Datatype *dtype ) +{ + const int *cin; + int *cout; + int i, j, k, nmat; + int tempCol[MAXCOL]; + + if (*count != 1) printf( "Panic!\n" ); + for (nmat = 0; nmat < *count; nmat++) { + cin = (const int *)cinPtr; + cout = (int *)coutPtr; + for (j=0; j MAXCOL) { + /* Skip because there are too many processes */ + MTestFreeComm( &comm ); + continue; + } + + /* Only one matrix for now */ + count = 1; + + /* A single matrix, the size of the communicator */ + MPI_Type_contiguous( size*size, MPI_INT, &mattype ); + MPI_Type_commit( &mattype ); + + buf = (int *)malloc( count * size * size * sizeof(int) ); + if (!buf) MPI_Abort( MPI_COMM_WORLD, 1 ); + bufout = (int *)malloc( count * size * size * sizeof(int) ); + if (!bufout) MPI_Abort( MPI_COMM_WORLD, 1 ); + + for (root = 0; root < size; root ++) { + initMat( comm, buf ); + MPI_Reduce( buf, bufout, count, mattype, op, root, comm ); + if (rank == root) { + errs += isPermutedIdentity( comm, bufout ); + } + + /* Try the same test, but using MPI_IN_PLACE */ + initMat( comm, bufout ); + if (rank == root) { + MPI_Reduce( MPI_IN_PLACE, bufout, count, mattype, op, root, comm ); + } + else { + MPI_Reduce( bufout, NULL, count, mattype, op, root, comm ); + } + if (rank == root) { + errs += isPermutedIdentity( comm, bufout ); + } + } + MPI_Type_free( &mattype ); + + free( buf ); + free( bufout ); + + MTestFreeComm( &comm ); + } + + MPI_Op_free( &op ); + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/coll/red_scat_block.c b/teshsuite/smpi/mpich3-test/coll/red_scat_block.c new file mode 100644 index 0000000000..3092c8d5a2 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/coll/red_scat_block.c @@ -0,0 +1,79 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2009 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +/* + * Test of reduce scatter block. + * + * Each process contributes its rank + the index to the reduction, + * then receives the ith sum + * + * Can be called with any number of processes. + */ + +#include "mpi.h" +#include "mpitest.h" +#include +#include + +int main(int argc, char **argv) +{ + int err = 0; + int toterr, size, rank, i, sumval; + int *sendbuf; + int *recvbuf; + MPI_Comm comm; + + MPI_Init(&argc, &argv); + comm = MPI_COMM_WORLD; + + MPI_Comm_size(comm, &size); + MPI_Comm_rank(comm, &rank); + +#if MTEST_HAVE_MIN_MPI_VERSION(2,2) + /* MPI_Reduce_scatter block was added in MPI-2.2 */ + sendbuf = (int *) malloc(size * sizeof(int)); + recvbuf = (int *) malloc(size * sizeof(int)); + if (!sendbuf || !recvbuf) { + err++; + fprintf(stderr, "unable to allocate send/recv buffers, aborting"); + MPI_Abort(MPI_COMM_WORLD, 1); + } + for (i=0; i +#include +#include "mpitest.h" + +int err = 0; + +/* left(x,y) ==> x */ +void left(void *a, void *b, int *count, MPI_Datatype *type); +void left(void *a, void *b, int *count, MPI_Datatype *type) +{ + int *in = a; + int *inout = b; + int i; + + for (i = 0; i < *count; ++i) + { + if (in[i] > inout[i]) + ++err; + inout[i] = in[i]; + } +} + +/* right(x,y) ==> y */ +void right(void *a, void *b, int *count, MPI_Datatype *type); +void right(void *a, void *b, int *count, MPI_Datatype *type) +{ + int *in = a; + int *inout = b; + int i; + + for (i = 0; i < *count; ++i) + { + if (in[i] > inout[i]) + ++err; + inout[i] = inout[i]; + } +} + +/* Just performs a simple sum but can be marked as non-commutative to + potentially tigger different logic in the implementation. */ +void nc_sum(void *a, void *b, int *count, MPI_Datatype *type); +void nc_sum(void *a, void *b, int *count, MPI_Datatype *type) +{ + int *in = a; + int *inout = b; + int i; + + for (i = 0; i < *count; ++i) + { + inout[i] = in[i] + inout[i]; + } +} + +#define MAX_BLOCK_SIZE 256 + +int main( int argc, char **argv ) +{ + int *sendbuf; + int block_size; + int *recvbuf; + int size, rank, i; + MPI_Comm comm; + MPI_Op left_op, right_op, nc_sum_op; + + MTest_Init( &argc, &argv ); + comm = MPI_COMM_WORLD; + + MPI_Comm_size( comm, &size ); + MPI_Comm_rank( comm, &rank ); + +#if MTEST_HAVE_MIN_MPI_VERSION(2,2) + /* MPI_Reduce_scatter block was added in MPI-2.2 */ + + MPI_Op_create(&left, 0/*non-commutative*/, &left_op); + MPI_Op_create(&right, 0/*non-commutative*/, &right_op); + MPI_Op_create(&nc_sum, 0/*non-commutative*/, &nc_sum_op); + + for (block_size = 1; block_size < MAX_BLOCK_SIZE; block_size *= 2) { + sendbuf = (int *) malloc( block_size * size * sizeof(int) ); + recvbuf = malloc( block_size * sizeof(int) ); + + for (i=0; i<(size*block_size); i++) + sendbuf[i] = rank + i; + for (i=0; i +#include + +int main( int argc, char **argv ) +{ + int err = 0, toterr; + int *sendbuf, recvbuf, *recvcounts; + int size, rank, i, sumval; + MPI_Comm comm; + + + MPI_Init( &argc, &argv ); + comm = MPI_COMM_WORLD; + + MPI_Comm_size( comm, &size ); + MPI_Comm_rank( comm, &rank ); + sendbuf = (int *) malloc( size * sizeof(int) ); + for (i=0; i +#include +#include "mpitest.h" + +int err = 0; + +/* left(x,y) ==> x */ +void left(void *a, void *b, int *count, MPI_Datatype *type); +void left(void *a, void *b, int *count, MPI_Datatype *type) +{ + int *in = a; + int *inout = b; + int i; + + for (i = 0; i < *count; ++i) + { + if (in[i] > inout[i]) + ++err; + inout[i] = in[i]; + } +} + +/* right(x,y) ==> y */ +void right(void *a, void *b, int *count, MPI_Datatype *type); +void right(void *a, void *b, int *count, MPI_Datatype *type) +{ + int *in = a; + int *inout = b; + int i; + + for (i = 0; i < *count; ++i) + { + if (in[i] > inout[i]) + ++err; + inout[i] = inout[i]; + } +} + +/* Just performs a simple sum but can be marked as non-commutative to + potentially tigger different logic in the implementation. */ +void nc_sum(void *a, void *b, int *count, MPI_Datatype *type); +void nc_sum(void *a, void *b, int *count, MPI_Datatype *type) +{ + int *in = a; + int *inout = b; + int i; + + for (i = 0; i < *count; ++i) + { + inout[i] = in[i] + inout[i]; + } +} + +#define MAX_BLOCK_SIZE 256 + +int main( int argc, char **argv ) +{ + int *sendbuf, *recvcounts; + int block_size; + int *recvbuf; + int size, rank, i; + MPI_Comm comm; + MPI_Op left_op, right_op, nc_sum_op; + + MTest_Init( &argc, &argv ); + comm = MPI_COMM_WORLD; + + MPI_Comm_size( comm, &size ); + MPI_Comm_rank( comm, &rank ); + + MPI_Op_create(&left, 0/*non-commutative*/, &left_op); + MPI_Op_create(&right, 0/*non-commutative*/, &right_op); + MPI_Op_create(&nc_sum, 0/*non-commutative*/, &nc_sum_op); + + for (block_size = 1; block_size < MAX_BLOCK_SIZE; block_size *= 2) { + sendbuf = (int *) malloc( block_size * size * sizeof(int) ); + recvbuf = malloc( block_size * sizeof(int) ); + + for (i=0; i<(size*block_size); i++) + sendbuf[i] = rank + i; + for (i=0; i +#include +#include "mpitest.h" + +/* Limit the number of error reports */ +#define MAX_ERRORS 10 + +int main( int argc, char **argv ) +{ + int err = 0; + int *sendbuf, *recvbuf, *recvcounts; + int size, rank, i, j, idx, mycount, sumval; + MPI_Comm comm; + + + MTest_Init( &argc, &argv ); + comm = MPI_COMM_WORLD; + + MPI_Comm_size( comm, &size ); + MPI_Comm_rank( comm, &rank ); + recvcounts = (int *)malloc( size * sizeof(int) ); + if (!recvcounts) { + fprintf( stderr, "Could not allocate %d ints for recvcounts\n", + size ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + mycount = (1024 * 1024) / size; + for (i=0; i +#include +#include "mpitest.h" + +int main( int argc, char **argv ) +{ + int err = 0; + int size, rsize, rank, i; + int recvcount, /* Each process receives this much data */ + sendcount, /* Each process contributes this much data */ + basecount; /* Unit of elements - basecount *rsize is recvcount, + etc. */ + int isLeftGroup; + long long *sendbuf, *recvbuf; + long long sumval; + MPI_Comm comm; + + + MTest_Init( &argc, &argv ); + comm = MPI_COMM_WORLD; + + basecount = 1024; + + while (MTestGetIntercomm( &comm, &isLeftGroup, 2 )) { + if (comm == MPI_COMM_NULL) continue; + + MPI_Comm_remote_size( comm, &rsize ); + MPI_Comm_size( comm, &size ); + MPI_Comm_rank( comm, &rank ); + + if (0) { + printf( "[%d] %s (%d,%d) remote %d\n", rank, + isLeftGroup ? "L" : "R", + rank, size, rsize ); + } + + recvcount = basecount * rsize; + sendcount = basecount * rsize * size; + + sendbuf = (long long *) malloc( sendcount * sizeof(long long) ); + if (!sendbuf) { + fprintf( stderr, "Could not allocate %d ints for sendbuf\n", + sendcount ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + + for (i=0; i +#include +#include "mpitest.h" + +int main( int argc, char **argv ) +{ + int err = 0; + int *sendbuf, *recvbuf; + int size, rank, i, j, idx, mycount, sumval; + MPI_Comm comm; + + + MTest_Init( &argc, &argv ); + comm = MPI_COMM_WORLD; + + MPI_Comm_size( comm, &size ); + MPI_Comm_rank( comm, &rank ); + mycount = (1024 * 1024) / size; + + sendbuf = (int *) malloc( mycount * size * sizeof(int) ); + if (!sendbuf) { + fprintf( stderr, "Could not allocate %d ints for sendbuf\n", + mycount * size ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + idx = 0; + for (i=0; i +#include +#include "mpitest.h" + +int main( int argc, char **argv ) +{ + int err = 0; + int *recvcounts; + int size, rsize, rank, i; + int recvcount, /* Each process receives this much data */ + sendcount, /* Each process contributes this much data */ + basecount; /* Unit of elements - basecount *rsize is recvcount, + etc. */ + int isLeftGroup; + long long *sendbuf, *recvbuf; + long long sumval; + MPI_Comm comm; + + + MTest_Init( &argc, &argv ); + comm = MPI_COMM_WORLD; + + basecount = 1024; + + while (MTestGetIntercomm( &comm, &isLeftGroup, 2 )) { + if (comm == MPI_COMM_NULL) continue; + + MPI_Comm_remote_size( comm, &rsize ); + MPI_Comm_size( comm, &size ); + MPI_Comm_rank( comm, &rank ); + + if (0) { + printf( "[%d] %s (%d,%d) remote %d\n", rank, + isLeftGroup ? "L" : "R", + rank, size, rsize ); + } + + recvcount = basecount * rsize; + sendcount = basecount * rsize * size; + + recvcounts = (int *)malloc( size * sizeof(int) ); + if (!recvcounts) { + fprintf( stderr, "Could not allocate %d int for recvcounts\n", + size ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + for (i=0; i +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "A simple test of Reduce with all choices of root process"; +*/ + +int main( int argc, char *argv[] ) +{ + int errs = 0; + int rank, size, root; + int *sendbuf, *recvbuf, i; + int minsize = 2, count; + MPI_Comm comm; + + MTest_Init( &argc, &argv ); + + while (MTestGetIntracommGeneral( &comm, minsize, 1 )) { + if (comm == MPI_COMM_NULL) continue; + /* Determine the sender and receiver */ + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + + for (count = 1; count < 130000; count = count * 2) { + sendbuf = (int *)malloc( count * sizeof(int) ); + recvbuf = (int *)malloc( count * sizeof(int) ); + for (root = 0; root < size; root ++) { + for (i=0; i +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "A simple test of MPI_Reduce_local"; +*/ + +#define MAX_BUF_ELEMENTS (65000) + +static int uop_errs = 0; + +/* prototype to keep the compiler happy */ +static void user_op(void *invec, void *inoutvec, int *len, MPI_Datatype *datatype); + +static void user_op(void *invec, void *inoutvec, int *len, MPI_Datatype *datatype) +{ + int i; + int *invec_int = (int *)invec; + int *inoutvec_int = (int *)inoutvec; + + if (*datatype != MPI_INT) { + ++uop_errs; + printf("invalid datatype passed to user_op"); + return; + } + + for (i = 0; i < *len; ++i) { + inoutvec_int[i] = invec_int[i] * 2 + inoutvec_int[i]; + } +} + +int main( int argc, char *argv[] ) +{ + int errs = 0; + int i; + int *inbuf = NULL; + int *inoutbuf = NULL; + int count = -1; + MPI_Op uop = MPI_OP_NULL; + + MTest_Init(&argc, &argv); +#if MTEST_HAVE_MIN_MPI_VERSION(2,2) + /* this function was added in MPI-2.2 */ + + inbuf = malloc(sizeof(int) * MAX_BUF_ELEMENTS); + inoutbuf = malloc(sizeof(int) * MAX_BUF_ELEMENTS); + + for (count = 0; count < MAX_BUF_ELEMENTS; count > 0 ? count*=2 : count++) { + for (i = 0; i < count; ++i) { + inbuf[i] = i; + inoutbuf[i] = i; + } + MPI_Reduce_local(inbuf, inoutbuf, count, MPI_INT, MPI_SUM); + for (i = 0; i < count; ++i) + if (inbuf[i] != i) { + ++errs; + if (inoutbuf[i] != (2*i)) + ++errs; + } + } + + /* make sure that user-define ops work too */ + MPI_Op_create(&user_op, 0/*!commute*/, &uop); + for (count = 0; count < MAX_BUF_ELEMENTS; count > 0 ? count*=2 : count++) { + for (i = 0; i < count; ++i) { + inbuf[i] = i; + inoutbuf[i] = i; + } + MPI_Reduce_local(inbuf, inoutbuf, count, MPI_INT, uop); + errs += uop_errs; + for (i = 0; i < count; ++i) + if (inbuf[i] != i) { + ++errs; + if (inoutbuf[i] != (3*i)) + ++errs; + } + } + MPI_Op_free(&uop); + + free(inbuf); + free(inoutbuf); +#endif + + MTest_Finalize(errs); + MPI_Finalize(); + return 0; +} + diff --git a/teshsuite/smpi/mpich3-test/coll/scantst.c b/teshsuite/smpi/mpich3-test/coll/scantst.c new file mode 100644 index 0000000000..2690644223 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/coll/scantst.c @@ -0,0 +1,117 @@ +/* -*- 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 + +void addem ( int *, int *, int *, MPI_Datatype * ); +void assoc ( int *, int *, int *, MPI_Datatype * ); + +void addem( int *invec, int *inoutvec, int *len, MPI_Datatype *dtype) +{ + int i; + for ( i=0; i<*len; i++ ) + inoutvec[i] += invec[i]; +} + +#define BAD_ANSWER 100000 + +/* + The operation is inoutvec[i] = invec[i] op inoutvec[i] + (see 4.9.4). The order is important. + + Note that the computation is in process rank (in the communicator) + order, independant of the root. + */ +void assoc( int *invec, int *inoutvec, int *len, MPI_Datatype *dtype) +{ + int i; + for ( i=0; i<*len; i++ ) { + if (inoutvec[i] <= invec[i] ) { + int rank; + MPI_Comm_rank( MPI_COMM_WORLD, &rank ); + fprintf( stderr, "[%d] inout[0] = %d, in[0] = %d\n", + rank, inoutvec[0], invec[0] ); + inoutvec[i] = BAD_ANSWER; + } + else + inoutvec[i] = invec[i]; + } +} + +int main( int argc, char **argv ) +{ + int rank, size, i; + int data; + int errors=0; + int result = -100; + int correct_result; + MPI_Op op_assoc, op_addem; + MPI_Comm comm=MPI_COMM_WORLD; + + MPI_Init( &argc, &argv ); + MPI_Op_create( (MPI_User_function *)assoc, 0, &op_assoc ); + MPI_Op_create( (MPI_User_function *)addem, 1, &op_addem ); + + /* Run this for a variety of communicator sizes */ + + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + + data = rank; + + correct_result = 0; + for (i=0;i<=rank;i++) + correct_result += i; + + MPI_Scan ( &data, &result, 1, MPI_INT, MPI_SUM, comm ); + if (result != correct_result) { + fprintf( stderr, "[%d] Error suming ints with scan\n", rank ); + errors++; + } + + MPI_Scan ( &data, &result, 1, MPI_INT, MPI_SUM, comm ); + if (result != correct_result) { + fprintf( stderr, "[%d] Error summing ints with scan (2)\n", rank ); + errors++; + } + + data = rank; + result = -100; + MPI_Scan ( &data, &result, 1, MPI_INT, op_addem, comm ); + if (result != correct_result) { + fprintf( stderr, "[%d] Error summing ints with scan (userop)\n", + rank ); + errors++; + } + + MPI_Scan ( &data, &result, 1, MPI_INT, op_addem, comm ); + if (result != correct_result) { + fprintf( stderr, "[%d] Error summing ints with scan (userop2)\n", + rank ); + errors++; + } + result = -100; + data = rank; + MPI_Scan ( &data, &result, 1, MPI_INT, op_assoc, comm ); + if (result == BAD_ANSWER) { + fprintf( stderr, "[%d] Error scanning with non-commutative op\n", + rank ); + errors++; + } + + MPI_Op_free( &op_assoc ); + MPI_Op_free( &op_addem ); + + MPI_Finalize(); + if (errors) + printf( "[%d] done with ERRORS(%d)!\n", rank, errors ); + else { + if (rank == 0) + printf(" No Errors\n"); + } + + return errors; +} diff --git a/teshsuite/smpi/mpich3-test/coll/scatter2.c b/teshsuite/smpi/mpich3-test/coll/scatter2.c new file mode 100644 index 0000000000..5535a30956 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/coll/scatter2.c @@ -0,0 +1,73 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2003 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ + +#include "mpi.h" +#include "mpitest.h" +#include +#include + +/* This example sends a vector and receives individual elements, but the + root process does not receive any data */ + +int main( int argc, char **argv ) +{ + MPI_Datatype vec; + double *vecin, *vecout, ivalue; + int root, i, n, stride, err = 0; + int rank, size; + MPI_Aint vextent; + + MTest_Init( &argc, &argv ); + + MPI_Comm_size( MPI_COMM_WORLD, &size ); + MPI_Comm_rank( MPI_COMM_WORLD, &rank ); + + n = 12; + stride = 10; + vecin = (double *)malloc( n * stride * size * sizeof(double) ); + vecout = (double *)malloc( n * sizeof(double) ); + + MPI_Type_vector( n, 1, stride, MPI_DOUBLE, &vec ); + MPI_Type_commit( &vec ); + MPI_Type_extent( vec, &vextent ); + if (vextent != ((n-1)*(MPI_Aint)stride + 1) * sizeof(double) ) { + err++; + printf( "Vector extent is %ld, should be %ld\n", + (long) vextent, (long)(((n-1)*stride+1)*sizeof(double)) ); + } + /* Note that the exted of type vector is from the first to the + last element, not n*stride. + E.g., with n=1, the extent is a single double */ + + for (i=0; i +#include + +/* This example sends contiguous data and receives a vector on some nodes + and contiguous data on others. There is some evidence that some + MPI implementations do not check recvcount on the root process; this + test checks for that case +*/ + +int main( int argc, char **argv ) +{ + MPI_Datatype vec; + double *vecin, *vecout, ivalue; + int root, i, n, stride, errs = 0; + int rank, size; + MPI_Aint vextent; + + MTest_Init( &argc, &argv ); + + MPI_Comm_size( MPI_COMM_WORLD, &size ); + MPI_Comm_rank( MPI_COMM_WORLD, &rank ); + + n = 12; + stride = 10; + /* Note that vecout really needs to be only (n-1)*stride+1 doubles, but + this is easier and allows a little extra room if there is a bug */ + vecout = (double *)malloc( n * stride * sizeof(double) ); + vecin = (double *)malloc( n * size * sizeof(double) ); + + MPI_Type_vector( n, 1, stride, MPI_DOUBLE, &vec ); + MPI_Type_commit( &vec ); + MPI_Type_extent( vec, &vextent ); + if (vextent != ((n-1)*(MPI_Aint)stride + 1) * sizeof(double) ) { + errs++; + printf( "Vector extent is %ld, should be %ld\n", + (long) vextent, (long)(((n-1)*stride+1)*sizeof(double)) ); + } + /* Note that the exted of type vector is from the first to the + last element, not n*stride. + E.g., with n=1, the extent is a single double */ + + for (i=0; i +#include + +/* This example sends a vector and receives individual elements */ + +int main( int argc, char **argv ) +{ + MPI_Datatype vec; + double *vecin, *vecout, ivalue; + int root, i, n, stride, err = 0; + int rank, size; + + MPI_Init( &argc, &argv ); + + MPI_Comm_size( MPI_COMM_WORLD, &size ); + MPI_Comm_rank( MPI_COMM_WORLD, &rank ); + + n = 12; + stride = 10; + vecin = (double *)malloc( n * stride * size * sizeof(double) ); + vecout = (double *)malloc( n * sizeof(double) ); + + MPI_Type_vector( n, 1, stride, MPI_DOUBLE, &vec ); + MPI_Type_commit( &vec ); + + for (i=0; i 0) printf( "Found %d errors!\n", err ); + else printf( " No Errors\n" ); + } + MPI_Type_free( &vec ); + MPI_Finalize(); + return 0; + +} + diff --git a/teshsuite/smpi/mpich3-test/coll/scatterv.c b/teshsuite/smpi/mpich3-test/coll/scatterv.c new file mode 100644 index 0000000000..6d8aa9454b --- /dev/null +++ b/teshsuite/smpi/mpich3-test/coll/scatterv.c @@ -0,0 +1,190 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2001 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include "mpi.h" +#include +#include + +/* Prototypes for picky compilers */ +void SetData ( double *, double *, int, int, int, int, int, int ); +int CheckData ( double *, int, int, int, int, int, int ); +/* + This is an example of using scatterv to send a matrix from one + process to all others, with the matrix stored in Fortran order. + Note the use of an explicit UB to enable the sources to overlap. + + This tests scatterv to make sure that it uses the datatype size + and extent correctly. It requires number of processors that + can be split with MPI_Dims_create. + + */ + +void SetData( double *sendbuf, double *recvbuf, int nx, int ny, + int myrow, int mycol, int nrow, int ncol ) +{ + int coldim, i, j, m, k; + double *p; + + if (myrow == 0 && mycol == 0) { + coldim = nx * nrow; + for (j=0; j +#include + +/* + * Test user-defined operations with a large number of elements. + * Added because a talk at EuroMPI'12 claimed that these failed with + * more than 64k elements + */ + +#define MAX_ERRS 10 +#define MAX_COUNT 1200000 + +void myop( void *cinPtr, void *coutPtr, int *count, MPI_Datatype *dtype ); + +/* + * myop takes a datatype that is a triple of doubles, and computes + * the sum, max, min of the respective elements of the triple. + */ +void myop( void *cinPtr, void *coutPtr, int *count, MPI_Datatype *dtype ) +{ + int i, n = *count; + double const *cin = (double *)cinPtr; + double *cout = (double *)coutPtr; + + for (i=0; i cin[1]) ? cout[1] : cin[1]; + cout[2] = (cout[2] < cin[2]) ? cout[2] : cin[2]; + cin += 3; + cout += 3; + } +} + +int main( int argc, char *argv[] ) +{ + int errs = 0; + int wsize, wrank, i, count; + MPI_Datatype tripleType; + double *inVal, *outVal; + double maxval, sumval; + MPI_Op op; + + MTest_Init( &argc, &argv ); + MPI_Op_create( myop, 0, &op ); + MPI_Type_contiguous( 3, MPI_DOUBLE, &tripleType ); + MPI_Type_commit( &tripleType ); + + MPI_Comm_size( MPI_COMM_WORLD, &wsize ); + MPI_Comm_rank( MPI_COMM_WORLD, &wrank ); + + for (count=1; count +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Test that communicators have reference count semantics"; +*/ + +#define NELM 128 +#define NCOMM 1020 + +int main( int argc, char *argv[] ) +{ + int errs = 0; + int rank, size, source, dest, i; + MPI_Comm comm; + MPI_Comm tmpComm[NCOMM]; + MPI_Status status; + MPI_Request req; + int *buf=0; + + MTest_Init( &argc, &argv ); + + MPI_Comm_dup( MPI_COMM_WORLD, &comm ); + + /* This is similar to the datatype test, except that we post + an irecv on a simple data buffer but use a rank-reordered communicator. + In this case, an error in handling the reference count will most + likely cause the program to hang, so this should be run only + if (a) you are confident that the code is correct or (b) + a timeout is set for mpiexec + */ + + 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; + + if (rank == dest) { + buf = (int *)malloc( NELM * sizeof(int) ); + for (i=0; i +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Test comm split"; +*/ + +int main( int argc, char *argv[] ) +{ + int errs = 0; + int rank, size, color, srank; + MPI_Comm comm, scomm; + + MTest_Init( &argc, &argv ); + + MPI_Comm_dup( MPI_COMM_WORLD, &comm ); + + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + + if (size < 4) { + fprintf( stderr, "This test requires at least four processes." ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + + color = MPI_UNDEFINED; + if (rank < 2) color = 1; + MPI_Comm_split( comm, color, size - rank, &scomm ); + + if (rank < 2) { + /* Check that the ranks are ordered correctly */ + MPI_Comm_rank( scomm, &srank ); + if (srank != 1 - rank) { + errs++; + } + MPI_Comm_free( &scomm ); + } + else { + if (scomm != MPI_COMM_NULL) { + errs++; + } + } + MPI_Comm_free( &comm ); + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/comm/cmsplit2.c b/teshsuite/smpi/mpich3-test/comm/cmsplit2.c new file mode 100644 index 0000000000..e711d293a7 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/comm/cmsplit2.c @@ -0,0 +1,137 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2011 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ + +/* This test ensures that MPI_Comm_split breaks ties in key values by using the + * original rank in the input communicator. This typically corresponds to + * the difference between using a stable sort or using an unstable sort. + * + * It checks all sizes from 1..comm_size(world)-1, so this test does not need to + * be run multiple times at process counts from a higher-level test driver. */ + +#include +#include +#include "mpi.h" + +#define ERRLIMIT (10) + +#define my_assert(cond_) \ + do { \ + if (!(cond_)) { \ + if (errs < ERRLIMIT) \ + printf("assertion \"%s\" failed\n", #cond_); \ + ++errs; \ + } \ + } while (0) + +int main(int argc, char **argv) +{ + int i, j, pos, modulus, cs, rank, size; + int wrank, wsize; + int newrank, newsize; + int errs = 0; + int key; + int *oldranks = NULL; + int *identity = NULL; + int verbose = 0; + MPI_Comm comm, splitcomm; + MPI_Group wgroup, newgroup; + + MPI_Init(&argc, &argv); + + if (getenv("MPITEST_VERBOSE")) + verbose = 1; + + MPI_Comm_rank(MPI_COMM_WORLD, &wrank); + MPI_Comm_size(MPI_COMM_WORLD, &wsize); + + oldranks = malloc(wsize * sizeof(int)); + identity = malloc(wsize * sizeof(int)); + for (i = 0; i < wsize; ++i) { + identity[i] = i; + } + + for (cs = 1; cs <= wsize; ++cs) { + /* yes, we are using comm_split to test comm_split, but this test is + * mainly about ensuring that the stable sort behavior is correct, not + * about whether the partitioning by color behavior is correct */ + MPI_Comm_split(MPI_COMM_WORLD, (wrank < cs ? 0 : MPI_UNDEFINED), wrank, &comm); + if (comm != MPI_COMM_NULL) { + MPI_Comm_rank(comm, &rank); + MPI_Comm_size(comm, &size); + + for (modulus = 1; modulus <= size; ++modulus) { + /* Divide all ranks into one of "modulus" equivalence classes. Ranks in + * output comm will be ordered first by class, then within the class by + * rank in comm world. */ + key = rank % modulus; + + /* all pass same color, variable keys */ + MPI_Comm_split(comm, 5, key, &splitcomm); + MPI_Comm_rank(splitcomm, &newrank); + MPI_Comm_size(splitcomm, &newsize); + my_assert(newsize == size); + + MPI_Comm_group(MPI_COMM_WORLD, &wgroup); + MPI_Comm_group(splitcomm, &newgroup); + int gsize; + MPI_Group_size(newgroup, &gsize); + MPI_Group_translate_ranks(newgroup, size, identity, wgroup, oldranks); + MPI_Group_free(&wgroup); + MPI_Group_free(&newgroup); + + if (splitcomm != MPI_COMM_NULL) + MPI_Comm_free(&splitcomm); + + /* now check that comm_split broke any ties correctly */ + if (rank == 0) { + if (verbose) { + /* debugging code that is useful when the test fails */ + printf("modulus=%d oldranks={", modulus); + for (i = 0; i < size - 1; ++i) { + printf("%d,", oldranks[i]); + } + printf("%d} keys={", oldranks[i]); + for (i = 0; i < size - 1; ++i) { + printf("%d,", i % modulus); + } + printf("%d}\n", i % modulus); + } + + pos = 0; + for (i = 0; i < modulus; ++i) { + /* there's probably a better way to write these loop bounds and + * indices, but this is the first (correct) way that occurred to me */ + for (j = 0; j < (size / modulus + (i < size % modulus ? 1 : 0)); ++j) { + if (errs < ERRLIMIT && oldranks[pos] != i+modulus*j) { + printf("size=%d i=%d j=%d modulus=%d pos=%d i+modulus*j=%d oldranks[pos]=%d\n", + size, i, j, modulus, pos, i+modulus*j, oldranks[pos]); + } + my_assert(oldranks[pos] == i+modulus*j); + ++pos; + } + } + } + } + MPI_Comm_free(&comm); + } + } + + if (oldranks != NULL) + free(oldranks); + if (identity != NULL) + free(identity); + + if (rank == 0) { + if (errs) + printf("found %d errors\n", errs); + else + printf(" No errors\n"); + } + + MPI_Finalize(); + return 0; +} + diff --git a/teshsuite/smpi/mpich3-test/comm/cmsplit_type.c b/teshsuite/smpi/mpich3-test/comm/cmsplit_type.c new file mode 100644 index 0000000000..75d3e4bbec --- /dev/null +++ b/teshsuite/smpi/mpich3-test/comm/cmsplit_type.c @@ -0,0 +1,67 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2011 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include "mpi.h" +/* USE_STRICT_MPI may be defined in mpitestconf.h */ +#include "mpitestconf.h" +#include +#include + +/* FIXME: This test only checks that the MPI_Comm_split_type routine + doesn't fail. It does not check for correct behavior */ + +int main(int argc, char *argv[]) +{ + int rank, size, verbose=0; + int wrank; + MPI_Comm comm; + + MPI_Init(&argc, &argv); + + if (getenv("MPITEST_VERBOSE")) + verbose = 1; + + MPI_Comm_rank( MPI_COMM_WORLD, &wrank ); + + /* Check to see if MPI_COMM_TYPE_SHARED works correctly */ + MPI_Comm_split_type(MPI_COMM_WORLD, MPI_COMM_TYPE_SHARED, 0, MPI_INFO_NULL, &comm); + if (comm == MPI_COMM_NULL) + printf("Expected a non-null communicator, but got MPI_COMM_NULL\n"); + else { + MPI_Comm_rank(comm, &rank); + MPI_Comm_size(comm, &size); + if (rank == 0 && verbose) + printf("Created subcommunicator of size %d\n", size); + MPI_Comm_free(&comm); + } + + /* Check to see if MPI_UNDEFINED is respected */ + MPI_Comm_split_type(MPI_COMM_WORLD, (wrank % 2 == 0) ? MPI_COMM_TYPE_SHARED : MPI_UNDEFINED, + 0, MPI_INFO_NULL, &comm); + if ((wrank % 2) && (comm != MPI_COMM_NULL)) + printf("Expected MPI_COMM_NULL, but did not get one\n"); + if (wrank % 2 == 0) { + if (comm == MPI_COMM_NULL) + printf("Expected a non-null communicator, but got MPI_COMM_NULL\n"); + else { + MPI_Comm_rank(comm, &rank); + MPI_Comm_size(comm, &size); + if (rank == 0 && verbose) + printf("Created subcommunicator of size %d\n", size); + MPI_Comm_free(&comm); + } + } + + /* Use wrank because Comm_split_type may return more than one communicator + across the job, and if so, each will have a rank 0 entry. Test + output rules are for a single process to write the successful + test (No Errors) output. */ + if (wrank == 0) + printf(" No errors\n"); + + MPI_Finalize(); + + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/comm/comm_create_group.c b/teshsuite/smpi/mpich3-test/comm/comm_create_group.c new file mode 100644 index 0000000000..edce6bb5a3 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/comm/comm_create_group.c @@ -0,0 +1,59 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2011 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include "mpi.h" +/* USE_STRICT_MPI may be defined in mpitestconf.h */ +#include "mpitestconf.h" +#include +#include +#include +#include + +int main(int argc, char *argv[]) +{ + int size, rank, i, *excl; + MPI_Group world_group, even_group; + MPI_Comm __attribute__((unused)) even_comm; + + MPI_Init(&argc, &argv); + + MPI_Comm_size(MPI_COMM_WORLD, &size); + MPI_Comm_rank(MPI_COMM_WORLD, &rank); + + if (size % 2) { + fprintf(stderr, "this program requires a multiple of 2 number of processes\n"); + MPI_Abort(MPI_COMM_WORLD, 1); + } + + excl = malloc((size / 2) * sizeof(int)); + assert(excl); + + /* exclude the odd ranks */ + for (i = 0; i < size / 2; i++) + excl[i] = (2 * i) + 1; + + /* Create some groups */ + MPI_Comm_group(MPI_COMM_WORLD, &world_group); + MPI_Group_excl(world_group, size / 2, excl, &even_group); + MPI_Group_free(&world_group); + +#if !defined(USE_STRICT_MPI) && defined(MPICH) + if (rank % 2 == 0) { + /* Even processes create a group for themselves */ + MPI_Comm_create_group(MPI_COMM_WORLD, even_group, 0, &even_comm); + MPI_Barrier(even_comm); + MPI_Comm_free(&even_comm); + } +#endif /* USE_STRICT_MPI */ + + MPI_Group_free(&even_group); + MPI_Barrier(MPI_COMM_WORLD); + + if (rank == 0) + printf(" No errors\n"); + + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/comm/comm_group_half.c b/teshsuite/smpi/mpich3-test/comm/comm_group_half.c new file mode 100644 index 0000000000..8302b58df7 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/comm/comm_group_half.c @@ -0,0 +1,46 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2003 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ + +#include +#include +/* USE_STRICT_MPI may be defined in mpitestconf.h */ +#include "mpitestconf.h" + +int main(int argc, char **argv) +{ + int rank, size; + MPI_Group full_group, half_group; + int range[1][3]; + MPI_Comm __attribute__((unused)) comm; + + MPI_Init(NULL, NULL); + MPI_Comm_rank(MPI_COMM_WORLD, &rank); + MPI_Comm_size(MPI_COMM_WORLD, &size); + + MPI_Comm_group(MPI_COMM_WORLD, &full_group); + range[0][0] = 0; + range[0][1] = size / 2; + range[0][2] = 1; + MPI_Group_range_incl(full_group, 1, range, &half_group); + +#if !defined(USE_STRICT_MPI) && defined(MPICH) + if (rank <= size / 2) { + MPI_Comm_create_group(MPI_COMM_WORLD, half_group, 0, &comm); + MPI_Barrier(comm); + MPI_Comm_free(&comm); + } +#endif /* USE_STRICT_MPI */ + + MPI_Group_free(&half_group); + MPI_Group_free(&full_group); + + if (rank == 0) + printf(" No Errors\n"); + + MPI_Finalize(); + + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/comm/comm_group_rand.c b/teshsuite/smpi/mpich3-test/comm/comm_group_rand.c new file mode 100644 index 0000000000..22b7fdc8ca --- /dev/null +++ b/teshsuite/smpi/mpich3-test/comm/comm_group_rand.c @@ -0,0 +1,64 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2003 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ + +#include +#include +#include +/* USE_STRICT_MPI may be defined in mpitestconf.h */ +#include "mpitestconf.h" + +#define LOOPS 100 + +int main(int argc, char **argv) +{ + int rank, size, i, j, count; + MPI_Group full_group, sub_group; + int *included, *ranks; + MPI_Comm __attribute__((unused)) comm; + + MPI_Init(NULL, NULL); + MPI_Comm_rank(MPI_COMM_WORLD, &rank); + MPI_Comm_size(MPI_COMM_WORLD, &size); + + ranks = malloc(size * sizeof(int)); + included = malloc(size * sizeof(int)); + MPI_Comm_group(MPI_COMM_WORLD, &full_group); + + for (j = 0; j < LOOPS; j++) { + srand(j); /* Deterministic seed */ + + count = 0; + for (i = 0; i < size; i++) { + if (rand() % 2) { /* randomly include a rank */ + included[i] = 1; + ranks[count++] = i; + } + else + included[i] = 0; + } + + MPI_Group_incl(full_group, count, ranks, &sub_group); + +#if !defined(USE_STRICT_MPI) && defined(MPICH) + if (included[rank]) { + MPI_Comm_create_group(MPI_COMM_WORLD, sub_group, 0, &comm); + MPI_Barrier(comm); + MPI_Comm_free(&comm); + } +#endif /* USE_STRICT_MPI */ + + MPI_Group_free(&sub_group); + } + + MPI_Group_free(&full_group); + + if (rank == 0) + printf(" No Errors\n"); + + MPI_Finalize(); + + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/comm/comm_idup.c b/teshsuite/smpi/mpich3-test/comm/comm_idup.c new file mode 100644 index 0000000000..0823943794 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/comm/comm_idup.c @@ -0,0 +1,149 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2012 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ + +#include +#include +#include +#include "mpi.h" +#include "mpitest.h" + +/* This is a temporary #ifdef to control whether we test this functionality. A + * configure-test or similar would be better. Eventually the MPI-3 standard + * will be released and this can be gated on a MPI_VERSION check */ +#if !defined(USE_STRICT_MPI) && defined(MPICH) +#define TEST_IDUP 1 +#endif + +/* 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 i; + int rank, size, lrank, lsize, rsize; + int buf[2]; + MPI_Comm newcomm, ic, localcomm, stagger_comm; + MPI_Request rreq; + + MPI_Init(&argc, &argv); + + MPI_Comm_rank(MPI_COMM_WORLD, &rank); + MPI_Comm_size(MPI_COMM_WORLD, &size); + + if (size < 2) { + printf("this test requires at least 2 processes\n"); + MPI_Abort(MPI_COMM_WORLD, 1); + } + +#ifdef TEST_IDUP + + /* test plan: make rank 0 wait in a blocking recv until all other processes + * have posted their MPI_Comm_idup ops, then post last. Should ensure that + * idup doesn't block on the non-zero ranks, otherwise we'll get a deadlock. + */ + + if (rank == 0) { + for (i = 1; i < size; ++i) { + buf[0] = 0x01234567; + buf[1] = 0x89abcdef; + MPI_Recv(buf, 2, MPI_INT, i, 0, MPI_COMM_WORLD, MPI_STATUS_IGNORE); + } + MPI_Comm_idup(MPI_COMM_WORLD, &newcomm, &rreq); + MPI_Wait(&rreq, MPI_STATUS_IGNORE); + } + else { + MPI_Comm_idup(MPI_COMM_WORLD, &newcomm, &rreq); + buf[0] = rank; + buf[1] = size + rank; + MPI_Ssend(buf, 2, MPI_INT, 0, 0, MPI_COMM_WORLD); + MPI_Wait(&rreq, MPI_STATUS_IGNORE); + } + + /* do some communication to make sure that newcomm works */ + buf[0] = rank; + buf[1] = 0xfeedface; + MPI_Allreduce(&buf[0], &buf[1], 1, MPI_INT, MPI_SUM, newcomm); + check(buf[1] == (size * (size-1) / 2)); + + MPI_Comm_free(&newcomm); + + /* now construct an intercomm and make sure we can dup that too */ + MPI_Comm_split(MPI_COMM_WORLD, rank % 2, rank, &localcomm); + MPI_Intercomm_create(localcomm, 0, MPI_COMM_WORLD, (rank == 0 ? 1 : 0), 1234, &ic); + + /* Create a communicator on just the "right hand group" of the intercomm in + * order to make it more likely to catch bugs related to incorrectly + * swapping the context_id and recvcontext_id in the idup code. */ + stagger_comm = MPI_COMM_NULL; + if (rank % 2) { + MPI_Comm_dup(localcomm, &stagger_comm); + } + + MPI_Comm_rank(ic, &lrank); + MPI_Comm_size(ic, &lsize); + MPI_Comm_remote_size(ic, &rsize); + + /* Similar to above pattern, but all non-local-rank-0 processes send to + * remote rank 0. Both sides participate in this way. */ + if (lrank == 0) { + for (i = 1; i < rsize; ++i) { + buf[0] = 0x01234567; + buf[1] = 0x89abcdef; + MPI_Recv(buf, 2, MPI_INT, i, 0, ic, MPI_STATUS_IGNORE); + } + MPI_Comm_idup(ic, &newcomm, &rreq); + MPI_Wait(&rreq, MPI_STATUS_IGNORE); + } + else { + MPI_Comm_idup(ic, &newcomm, &rreq); + buf[0] = lrank; + buf[1] = lsize + lrank; + MPI_Ssend(buf, 2, MPI_INT, 0, 0, ic); + MPI_Wait(&rreq, MPI_STATUS_IGNORE); + } + + /* do some communication to make sure that newcomm works */ + buf[0] = lrank; + buf[1] = 0xfeedface; + MPI_Allreduce(&buf[0], &buf[1], 1, MPI_INT, MPI_SUM, newcomm); + check(buf[1] == (rsize * (rsize-1) / 2)); + + /* free this down here, not before idup, otherwise it will undo our + * stagger_comm work */ + MPI_Comm_free(&localcomm); + + if (stagger_comm != MPI_COMM_NULL) { + MPI_Comm_free(&stagger_comm); + } + MPI_Comm_free(&newcomm); + MPI_Comm_free(&ic); + +#endif /* TEST_IDUP */ + + MPI_Reduce((rank == 0 ? MPI_IN_PLACE : &errs), &errs, 1, MPI_INT, MPI_SUM, 0, MPI_COMM_WORLD); + if (rank == 0) { + if (errs) { + printf("found %d errors\n", errs); + } + else { + printf(" No errors\n"); + } + } + + MPI_Finalize(); + + return 0; +} + diff --git a/teshsuite/smpi/mpich3-test/comm/comm_info.c b/teshsuite/smpi/mpich3-test/comm/comm_info.c new file mode 100644 index 0000000000..d2044d4a97 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/comm/comm_info.c @@ -0,0 +1,59 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2012 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ + +#include +#include +#include "mpitest.h" + +#define VERBOSE 0 + +int main(int argc, char **argv) +{ + int rank; + MPI_Info info_in, info_out; + int errors = 0, all_errors = 0; + MPI_Comm comm; + char __attribute__((unused)) invalid_key[] = "invalid_test_key"; + char buf[MPI_MAX_INFO_VAL]; + int flag; + + MPI_Init(&argc, &argv); + + MPI_Comm_rank(MPI_COMM_WORLD, &rank); + + MPI_Info_create(&info_in); + MPI_Info_set(info_in, invalid_key, (char *) "true"); + + MPI_Comm_dup(MPI_COMM_WORLD, &comm); + + MPI_Comm_set_info(comm, info_in); + MPI_Comm_get_info(comm, &info_out); + + MPI_Info_get(info_out, invalid_key, MPI_MAX_INFO_VAL, buf, &flag); +#ifndef USE_STRICT_MPI + /* Check if our invalid key was ignored. Note, this check's MPICH's + * behavior, but this behavior may not be required for a standard + * conforming MPI implementation. */ + if (flag) { + printf("%d: %s was not ignored\n", rank, invalid_key); + errors++; + } +#endif + + MPI_Info_free(&info_in); + MPI_Info_free(&info_out); + MPI_Comm_free(&comm); + + MPI_Reduce(&errors, &all_errors, 1, MPI_INT, MPI_SUM, 0, MPI_COMM_WORLD); + + if (rank == 0 && all_errors == 0) + printf(" No Errors\n"); + + MPI_Finalize(); + + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/comm/commcreate1.c b/teshsuite/smpi/mpich3-test/comm/commcreate1.c new file mode 100644 index 0000000000..edb60fdda2 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/comm/commcreate1.c @@ -0,0 +1,139 @@ +/* -*- 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 +#include +#include "mpitest.h" + +/* Check that Communicators can be created from various subsets of the + processes in the communicator. +*/ + +void abortMsg( const char *, int ); +int BuildComm( MPI_Comm, MPI_Group, const char [] ); + +void abortMsg( const char *str, int code ) +{ + char msg[MPI_MAX_ERROR_STRING]; + int class, resultLen; + + MPI_Error_class( code, &class ); + MPI_Error_string( code, msg, &resultLen ); + fprintf( stderr, "%s: errcode = %d, class = %d, msg = %s\n", + str, code, class, msg ); + MPI_Abort( MPI_COMM_WORLD, code ); +} + +int main( int argc, char *argv[] ) +{ + MPI_Comm dupWorld; + int wrank, wsize, gsize, err, errs = 0; + int ranges[1][3]; + MPI_Group wGroup, godd, ghigh, geven; + + MTest_Init( &argc, &argv ); + + MPI_Comm_size( MPI_COMM_WORLD, &wsize ); + MPI_Comm_rank( MPI_COMM_WORLD, &wrank ); + + /* Create some groups */ + MPI_Comm_group( MPI_COMM_WORLD, &wGroup ); + + MTestPrintfMsg( 2, "Creating groups\n" ); + ranges[0][0] = 2*(wsize/2)-1; + ranges[0][1] = 1; + ranges[0][2] = -2; + err = MPI_Group_range_incl( wGroup, 1, ranges, &godd ); + if (err) abortMsg( "Failed to create odd group: ", err ); + err = MPI_Group_size( godd, &gsize ); + if (err) abortMsg( "Failed to get size of odd group: ", err ); + if (gsize != wsize/2) { + fprintf( stderr, "Group godd size is %d should be %d\n", gsize, + wsize/2 ); + errs++; + } + + ranges[0][0] = wsize/2+1; + ranges[0][1] = wsize-1; + ranges[0][2] = 1; + err = MPI_Group_range_incl( wGroup, 1, ranges, &ghigh ); + if (err) abortMsg( "Failed to create high group\n", err ); + ranges[0][0] = 0; + ranges[0][1] = wsize-1; + ranges[0][2] = 2; + err = MPI_Group_range_incl( wGroup, 1, ranges, &geven ); + if (err) abortMsg( "Failed to create even group:", err ); + + MPI_Comm_dup( MPI_COMM_WORLD, &dupWorld ); + MPI_Comm_set_name( dupWorld, (char*)"Dup of world" ); + /* First, use the groups to create communicators from world and a dup + of world */ + errs += BuildComm( MPI_COMM_WORLD, ghigh, "ghigh" ); + errs += BuildComm( MPI_COMM_WORLD, godd, "godd" ); + errs += BuildComm( MPI_COMM_WORLD, geven, "geven" ); + errs += BuildComm( dupWorld, ghigh, "ghigh" ); + errs += BuildComm( dupWorld, godd, "godd" ); + errs += BuildComm( dupWorld, geven, "geven" ); + +#if MTEST_HAVE_MIN_MPI_VERSION(2,2) + /* check that we can create multiple communicators from a single collective + * call to MPI_Comm_create as long as the groups are all disjoint */ + errs += BuildComm( MPI_COMM_WORLD, (wrank % 2 ? godd : geven), "godd+geven" ); + errs += BuildComm( dupWorld, (wrank % 2 ? godd : geven), "godd+geven" ); + errs += BuildComm( MPI_COMM_WORLD, MPI_GROUP_EMPTY, "MPI_GROUP_EMPTY" ); + errs += BuildComm( dupWorld, MPI_GROUP_EMPTY, "MPI_GROUP_EMPTY" ); +#endif + + MPI_Comm_free( &dupWorld ); + MPI_Group_free( &ghigh ); + MPI_Group_free( &godd ); + MPI_Group_free( &geven ); + MPI_Group_free( &wGroup ); + + MTest_Finalize( errs ); + + MPI_Finalize(); + return 0; +} + +int BuildComm( MPI_Comm oldcomm, MPI_Group group, const char gname[] ) +{ + MPI_Comm newcomm; + int grank, gsize, rank, size, errs = 0; + char cname[MPI_MAX_OBJECT_NAME+1]; + int cnamelen; + + MPI_Group_rank( group, &grank ); + MPI_Group_size( group, &gsize ); + MPI_Comm_get_name( oldcomm, cname, &cnamelen ); + MTestPrintfMsg( 2, "Testing comm %s from %s\n", cname, gname ); + MPI_Comm_create( oldcomm, group, &newcomm ); + if (newcomm == MPI_COMM_NULL && grank != MPI_UNDEFINED) { + errs ++; + fprintf( stderr, "newcomm is null but process is in group\n" ); + } + if (newcomm != MPI_COMM_NULL && grank == MPI_UNDEFINED) { + errs ++; + fprintf( stderr, "newcomm is not null but process is not in group\n" ); + } + if (newcomm != MPI_COMM_NULL && grank != MPI_UNDEFINED) { + MPI_Comm_rank( newcomm, &rank ); + if (rank != grank) { + errs ++; + fprintf( stderr, "Rank is %d should be %d in comm from %s\n", + rank, grank, gname ); + } + MPI_Comm_size( newcomm, &size ); + if (size != gsize) { + errs++; + fprintf( stderr, "Size is %d should be %d in comm from %s\n", + size, gsize, gname ); + } + MPI_Comm_free( &newcomm ); + MTestPrintfMsg( 2, "Done testing comm %s from %s\n", cname, gname ); + } + return errs; +} diff --git a/teshsuite/smpi/mpich3-test/comm/commname.c b/teshsuite/smpi/mpich3-test/comm/commname.c new file mode 100644 index 0000000000..6a7a736d71 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/comm/commname.c @@ -0,0 +1,64 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2001 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ + +#include "mpi.h" +#include +#include +#include "mpitest.h" +#include "mpitestconf.h" +#ifdef HAVE_STRING_H +#include +#endif + +int main( int argc, char *argv[] ) +{ + int errs = 0; + MPI_Comm comm; + int cnt, rlen; + char name[MPI_MAX_OBJECT_NAME], nameout[MPI_MAX_OBJECT_NAME]; + MTest_Init( &argc, &argv ); + + /* Check world and self firt */ + nameout[0] = 0; + MPI_Comm_get_name( MPI_COMM_WORLD, nameout, &rlen ); + if (strcmp(nameout,"MPI_COMM_WORLD")) { + errs++; + printf( "Name of comm world is %s, should be MPI_COMM_WORLD\n", + nameout ); + } + + nameout[0] = 0; + MPI_Comm_get_name( MPI_COMM_SELF, nameout, &rlen ); + if (strcmp(nameout,"MPI_COMM_SELF")) { + errs++; + printf( "Name of comm self is %s, should be MPI_COMM_SELF\n", + nameout ); + } + + /* Now, handle other communicators, including world/self */ + cnt = 0; + while (MTestGetComm( &comm, 1 )) { + if (comm == MPI_COMM_NULL) continue; + + sprintf( name, "comm-%d", cnt ); + cnt++; + MPI_Comm_set_name( comm, name ); + nameout[0] = 0; + MPI_Comm_get_name( comm, nameout, &rlen ); + if (strcmp( name, nameout )) { + errs++; + printf( "Unexpected name, was %s but should be %s\n", + nameout, name ); + } + + MTestFreeComm( &comm ); + } + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/comm/ctxalloc.c b/teshsuite/smpi/mpich3-test/comm/ctxalloc.c new file mode 100644 index 0000000000..ef66be3bf9 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/comm/ctxalloc.c @@ -0,0 +1,62 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2003 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include "mpi.h" +#include +#include "mpitest.h" + +/* + * This program tests the allocation (and deallocation) of contexts. + * + */ +int main( int argc, char **argv ) +{ + int errs = 0; + int i, j, err; + MPI_Comm newcomm1, newcomm2[200]; + + MTest_Init( &argc, &argv ); + + /* Get a separate communicator to duplicate */ + MPI_Comm_dup( MPI_COMM_WORLD, &newcomm1 ); + + MPI_Errhandler_set( newcomm1, MPI_ERRORS_RETURN ); + /* Allocate many communicators in batches, then free them */ + for (i=0; i<1000; i++) { + for (j=0; j<200; j++) { + err = MPI_Comm_dup( newcomm1, &newcomm2[j] ); + if (err) { + errs++; + if (errs < 10) { + fprintf( stderr, "Failed to duplicate communicator for (%d,%d)\n", i, j ); + MTestPrintError( err ); + } + } + } + for (j=0; j<200; j++) { + err = MPI_Comm_free( &newcomm2[j] ); + if (err) { + errs++; + if (errs < 10) { + fprintf( stderr, "Failed to free %d,%d\n", i, j ); + MTestPrintError( err ); + } + } + } + } + err = MPI_Comm_free( &newcomm1 ); + if (err) { + errs++; + fprintf( stderr, "Failed to free newcomm1\n" ); + MTestPrintError( err ); + } + + MTest_Finalize( errs ); + + MPI_Finalize(); + + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/comm/ctxsplit.c b/teshsuite/smpi/mpich3-test/comm/ctxsplit.c new file mode 100644 index 0000000000..4e73dc5ca1 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/comm/ctxsplit.c @@ -0,0 +1,80 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2003 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include "mpi.h" +#include +#include +#include +#include "mpitest.h" + +/* + * This check is intended to fail if there is a leak of context ids. + * Because this is trying to exhaust the number of context ids, it needs + * to run for a longer time than many tests. The for loop uses 100,000 + * iterations, which is adequate for MPICH (with only about 1k context ids + * available). + */ + +int main(int argc, char** argv) { + + int i=0; + int randval; + int rank; + int errs = 0; + MPI_Comm newcomm; + double startTime; + int nLoop = 100000; + + MTest_Init(&argc,&argv); + + for (i=1; i 0) { + rate = i / rate; + MTestPrintfMsg( 10, "After %d (%f)\n", i, rate ); + } + else { + MTestPrintfMsg( 10, "After %d\n", i ); + } + } + + /* FIXME: Explain the rationale behind rand in this test */ + randval=rand(); + + if (randval%(rank+2) == 0) { + MPI_Comm_split(MPI_COMM_WORLD,1,rank,&newcomm); + MPI_Comm_free( &newcomm ); + } + else { + MPI_Comm_split(MPI_COMM_WORLD,MPI_UNDEFINED,rank,&newcomm); + if (newcomm != MPI_COMM_NULL) { + errs++; + printf( "Created a non-null communicator with MPI_UNDEFINED\n" ); + } + } + + } + + MTest_Finalize( errs ); + MPI_Finalize(); + + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/comm/dup.c b/teshsuite/smpi/mpich3-test/comm/dup.c new file mode 100644 index 0000000000..a30975fb40 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/comm/dup.c @@ -0,0 +1,81 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2003 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include "mpi.h" +#include +#include "mpitest.h" + +int main( int argc, char **argv ) +{ + int errs = 0; + int rank, size, wrank, wsize, dest, a, b; + MPI_Comm newcomm; + MPI_Status status; + + MTest_Init( &argc, &argv ); + + /* Can we run comm dup at all? */ + MPI_Comm_dup( MPI_COMM_WORLD, &newcomm ); + + /* Check basic properties */ + MPI_Comm_size( MPI_COMM_WORLD, &wsize ); + MPI_Comm_rank( MPI_COMM_WORLD, &wrank ); + MPI_Comm_size( newcomm, &size ); + MPI_Comm_rank( newcomm, &rank ); + + if (size != wsize || rank != wrank) { + errs++; + fprintf( stderr, "Size (%d) or rank (%d) wrong\n", size, rank ); + fflush( stderr ); + } + + /* Can we communicate with this new communicator? */ + dest = MPI_PROC_NULL; + if (rank == 0) { + dest = size - 1; + a = rank; + b = -1; + MPI_Sendrecv( &a, 1, MPI_INT, dest, 0, + &b, 1, MPI_INT, dest, 0, newcomm, &status ); + if (b != dest) { + errs++; + fprintf( stderr, "Received %d expected %d on %d\n", b, dest, rank ); + fflush( stderr ); + } + if (status.MPI_SOURCE != dest) { + errs++; + fprintf( stderr, "Source not set correctly in status on %d\n", + rank ); + fflush( stderr ); + } + } + else if (rank == size-1) { + dest = 0; + a = rank; + b = -1; + MPI_Sendrecv( &a, 1, MPI_INT, dest, 0, + &b, 1, MPI_INT, dest, 0, newcomm, &status ); + if (b != dest) { + errs++; + fprintf( stderr, "Received %d expected %d on %d\n", b, dest, rank ); + fflush( stderr ); + } + if (status.MPI_SOURCE != dest) { + errs++; + fprintf( stderr, "Source not set correctly in status on %d\n", + rank ); + fflush( stderr ); + } + } + + MPI_Comm_free( &newcomm ); + + MTest_Finalize( errs ); + + MPI_Finalize(); + + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/comm/dup_with_info.c b/teshsuite/smpi/mpich3-test/comm/dup_with_info.c new file mode 100644 index 0000000000..e63acaaa94 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/comm/dup_with_info.c @@ -0,0 +1,108 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2012 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include "mpi.h" +#include +#include "mpitest.h" +int run_tests(MPI_Comm comm); +int run_tests(MPI_Comm comm) +{ + int rank, size, wrank, wsize, dest, a, b, errs = 0; + MPI_Status status; + + /* Check basic properties */ + MPI_Comm_size(MPI_COMM_WORLD, &wsize); + MPI_Comm_rank(MPI_COMM_WORLD, &wrank); + MPI_Comm_size(comm, &size); + MPI_Comm_rank(comm, &rank); + + if (size != wsize || rank != wrank) { + errs++; + fprintf(stderr, "Size (%d) or rank (%d) wrong\n", size, rank); + fflush(stderr); + } + + MPI_Barrier(comm); + + /* Can we communicate with this new communicator? */ + dest = MPI_PROC_NULL; + if (rank == 0) { + dest = size - 1; + a = rank; + b = -1; + MPI_Sendrecv(&a, 1, MPI_INT, dest, 0, &b, 1, MPI_INT, dest, 0, comm, &status); + if (b != dest) { + errs++; + fprintf(stderr, "Received %d expected %d on %d\n", b, dest, rank); + fflush(stderr); + } + if (status.MPI_SOURCE != dest) { + errs++; + fprintf(stderr, "Source not set correctly in status on %d\n", rank); + fflush(stderr); + } + } + else if (rank == size - 1) { + dest = 0; + a = rank; + b = -1; + MPI_Sendrecv(&a, 1, MPI_INT, dest, 0, &b, 1, MPI_INT, dest, 0, comm, &status); + if (b != dest) { + errs++; + fprintf(stderr, "Received %d expected %d on %d\n", b, dest, rank); + fflush(stderr); + } + if (status.MPI_SOURCE != dest) { + errs++; + fprintf(stderr, "Source not set correctly in status on %d\n", rank); + fflush(stderr); + } + } + + MPI_Barrier(comm); + + return errs; +} + +int main(int argc, char **argv) +{ + int total_errs = 0; + MPI_Comm newcomm; + MPI_Info info; + + MTest_Init(&argc, &argv); + + /* Dup with no info */ + MPI_Comm_dup_with_info(MPI_COMM_WORLD, MPI_INFO_NULL, &newcomm); + total_errs += run_tests(newcomm); + MPI_Comm_free(&newcomm); + + /* Dup with info keys */ + MPI_Info_create(&info); + MPI_Info_set(info, (char *) "host", (char *) "myhost.myorg.org"); + MPI_Info_set(info, (char *) "file", (char *) "runfile.txt"); + MPI_Info_set(info, (char *) "soft", (char *) "2:1000:4,3:1000:7"); + MPI_Comm_dup_with_info(MPI_COMM_WORLD, info, &newcomm); + total_errs += run_tests(newcomm); + MPI_Info_free(&info); + MPI_Comm_free(&newcomm); + + /* Dup with deleted info keys */ + MPI_Info_create(&info); + MPI_Info_set(info, (char *) "host", (char *) "myhost.myorg.org"); + MPI_Info_set(info, (char *) "file", (char *) "runfile.txt"); + MPI_Info_set(info, (char *) "soft", (char *) "2:1000:4,3:1000:7"); + MPI_Comm_dup_with_info(MPI_COMM_WORLD, info, &newcomm); + MPI_Info_free(&info); + total_errs += run_tests(newcomm); + MPI_Comm_free(&newcomm); + + MTest_Finalize(total_errs); + + MPI_Finalize(); + + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/comm/dupic.c b/teshsuite/smpi/mpich3-test/comm/dupic.c new file mode 100644 index 0000000000..8a79fb5e9e --- /dev/null +++ b/teshsuite/smpi/mpich3-test/comm/dupic.c @@ -0,0 +1,95 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2003 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include "mpi.h" +#include +#include "mpitest.h" + +int main( int argc, char *argv[] ) +{ + int errs = 0; + MPI_Comm comm, dupcomm, dupcomm2; + MPI_Request rreq[2]; + int count; + int indicies[2]; + int r1buf, r2buf, s1buf, s2buf; + int rank, isLeft; + + MTest_Init( &argc, &argv ); + + while (MTestGetIntercomm( &comm, &isLeft, 2 )) { + if (comm == MPI_COMM_NULL) continue; + + MPI_Comm_dup( comm, &dupcomm ); + + /* Check that there are separate contexts. We do this by setting + up nonblocking received on both communicators, and then + sending to them. If the contexts are different, tests on the + unsatisfied communicator should indicate no available message */ + MPI_Comm_rank( comm, &rank ); + if (rank == 0) { + s1buf = 456; + s2buf = 17; + r1buf = r2buf = -1; + /* These are send/receives to the process with rank zero + in the other group (these are intercommunicators) */ + MPI_Irecv( &r1buf, 1, MPI_INT, 0, 0, dupcomm, &rreq[0] ); + MPI_Irecv( &r2buf, 1, MPI_INT, 0, 0, comm, &rreq[1] ); + MPI_Send( &s2buf, 1, MPI_INT, 0, 0, comm ); + MPI_Waitsome(2, rreq, &count, indicies, MPI_STATUSES_IGNORE); + if (count != 1 || indicies[0] != 1) { + /* The only valid return is that exactly one message + has been received */ + errs++; + if (count == 1 && indicies[0] != 1) { + printf( "Error in context values for intercomm\n" ); + } + else if (count == 2) { + printf( "Error: two messages received!\n" ); + } + else { + int i; + printf( "Error: count = %d", count ); + for (i=0; i +#include "mpitest.h" + +int main( int argc, char *argv[] ) +{ + MPI_Comm intercomm; + int remote_rank, rank, size, errs = 0; + + MTest_Init( &argc, &argv ); + + + + MPI_Comm_size( MPI_COMM_WORLD, &size ); + if (size < 2) { + printf( "Size must be at least 2\n" ); + MPI_Abort( MPI_COMM_WORLD, 0 ); + } + + MPI_Comm_rank( MPI_COMM_WORLD, &rank ); + + /* Make an intercomm of the first two elements of comm_world */ + if (rank < 2) { + int lrank = rank, rrank = -1; + MPI_Status status; + + remote_rank = 1 - rank; + MPI_Intercomm_create( MPI_COMM_SELF, 0, + MPI_COMM_WORLD, remote_rank, 27, + &intercomm ); + + /* Now, communicate between them */ + MPI_Sendrecv( &lrank, 1, MPI_INT, 0, 13, + &rrank, 1, MPI_INT, 0, 13, intercomm, &status ); + + if (rrank != remote_rank) { + errs++; + printf( "%d Expected %d but received %d\n", + rank, remote_rank, rrank ); + } + + MPI_Comm_free( &intercomm ); + } + + /* The next test should create an intercomm with groups of different + sizes FIXME */ + + MTest_Finalize( errs ); + MPI_Finalize(); + + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/comm/ic2.c b/teshsuite/smpi/mpich3-test/comm/ic2.c new file mode 100644 index 0000000000..8385648a29 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/comm/ic2.c @@ -0,0 +1,96 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2012 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ + +/* regression test for ticket #1574 + * + * Based on test code from N. Radclif @ Cray. */ + +#include +#include +#include + +int main(int argc, char **argv) +{ + MPI_Comm c0, c1, ic; + MPI_Group g0, g1, gworld; + int a, b, c, d; + int rank, size, remote_leader, tag; + int ranks[2]; + int errs = 0; + + tag = 5; + c0 = c1 = ic = MPI_COMM_NULL; + g0 = g1 = gworld = MPI_GROUP_NULL; + + MPI_Init(&argc, &argv); + + MPI_Comm_rank(MPI_COMM_WORLD, &rank); + MPI_Comm_size(MPI_COMM_WORLD, &size); + + if (size < 33) { + printf("ERROR: this test requires at least 33 processes\n"); + MPI_Abort(MPI_COMM_WORLD, 1); + return 1; + } + + /* group of c0 + * NOTE: a>=32 is essential for exercising the loop bounds bug from tt#1574 */ + a = 32; + b = 24; + + /* group of c1 */ + c = 25; + d = 26; + + MPI_Comm_group(MPI_COMM_WORLD, &gworld); + + ranks[0] = a; + ranks[1] = b; + MPI_Group_incl(gworld, 2, ranks, &g0); + MPI_Comm_create(MPI_COMM_WORLD, g0, &c0); + + ranks[0] = c; + ranks[1] = d; + MPI_Group_incl(gworld, 2, ranks, &g1); + MPI_Comm_create(MPI_COMM_WORLD, g1, &c1); + + if (rank == a || rank == b) { + remote_leader = c; + MPI_Intercomm_create(c0, 0, MPI_COMM_WORLD, remote_leader, tag, &ic); + } + else if (rank == c || rank == d) { + remote_leader = a; + MPI_Intercomm_create(c1, 0, MPI_COMM_WORLD, remote_leader, tag, &ic); + } + + MPI_Group_free(&g0); + MPI_Group_free(&g1); + MPI_Group_free(&gworld); + + if (c0 != MPI_COMM_NULL) + MPI_Comm_free(&c0); + if (c1 != MPI_COMM_NULL) + MPI_Comm_free(&c1); + if (ic != MPI_COMM_NULL) + MPI_Comm_free(&ic); + + + MPI_Reduce((rank == 0 ? MPI_IN_PLACE : &errs), &errs, + 1, MPI_INT, MPI_SUM, 0, MPI_COMM_WORLD); + if (rank == 0) { + if (errs) { + printf("found %d errors\n", errs); + } + else { + printf(" No errors\n"); + } + } + MPI_Finalize(); + + return 0; +} + diff --git a/teshsuite/smpi/mpich3-test/comm/iccreate.c b/teshsuite/smpi/mpich3-test/comm/iccreate.c new file mode 100644 index 0000000000..4b3cedd92d --- /dev/null +++ b/teshsuite/smpi/mpich3-test/comm/iccreate.c @@ -0,0 +1,216 @@ +/* -*- 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 +#include +#include "mpitest.h" + +/* + * This program tests that MPI_Comm_create applies to intercommunicators; + * this is an extension added in MPI-2 + */ + +int TestIntercomm( MPI_Comm ); + +int main( int argc, char *argv[] ) +{ + int errs = 0; + int size, isLeft, wrank; + MPI_Comm intercomm, newcomm; + MPI_Group oldgroup, newgroup; + + MTest_Init( &argc, &argv ); + + MPI_Comm_size( MPI_COMM_WORLD, &size ); + if (size < 4) { + printf( "This test requires at least 4 processes\n" ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + MPI_Comm_rank( MPI_COMM_WORLD, &wrank ); + + while (MTestGetIntercomm( &intercomm, &isLeft, 2 )) { + int ranks[10], nranks, result; + + if (intercomm == MPI_COMM_NULL) continue; + + MPI_Comm_group( intercomm, &oldgroup ); + ranks[0] = 0; + nranks = 1; + MTestPrintfMsg( 1, "Creating a new intercomm 0-0\n" ); + MPI_Group_incl( oldgroup, nranks, ranks, &newgroup ); + MPI_Comm_create( intercomm, newgroup, &newcomm ); + + /* Make sure that the new communicator has the appropriate pieces */ + if (newcomm != MPI_COMM_NULL) { + int new_rsize, new_size, flag, commok = 1; + + MPI_Comm_set_name( newcomm, (char*)"Single rank in each group" ); + MPI_Comm_test_inter( intercomm, &flag ); + if (!flag) { + errs++; + printf( "[%d] Output communicator is not an intercomm\n", + wrank ); + commok = 0; + } + + MPI_Comm_remote_size( newcomm, &new_rsize ); + MPI_Comm_size( newcomm, &new_size ); + /* The new communicator has 1 process in each group */ + if (new_rsize != 1) { + errs++; + printf( "[%d] Remote size is %d, should be one\n", + wrank, new_rsize ); + commok = 0; + } + if (new_size != 1) { + errs++; + printf( "[%d] Local size is %d, should be one\n", + wrank, new_size ); + commok = 0; + } + /* ... more to do */ + if (commok) { + errs += TestIntercomm( newcomm ); + } + } + MPI_Group_free( &newgroup ); + if (newcomm != MPI_COMM_NULL) { + MPI_Comm_free( &newcomm ); + } + + /* Now, do a sort of dup, using the original group */ + MTestPrintfMsg( 1, "Creating a new intercomm (manual dup)\n" ); + MPI_Comm_create( intercomm, oldgroup, &newcomm ); + MPI_Comm_set_name( newcomm, (char*)"Dup of original" ); + MTestPrintfMsg( 1, "Creating a new intercomm (manual dup (done))\n" ); + + MPI_Comm_compare( intercomm, newcomm, &result ); + MTestPrintfMsg( 1, "Result of comm/intercomm compare is %d\n", result ); + if (result != MPI_CONGRUENT) { + const char *rname=0; + errs++; + switch (result) { + case MPI_IDENT: rname = "IDENT"; break; + case MPI_CONGRUENT: rname = "CONGRUENT"; break; + case MPI_SIMILAR: rname = "SIMILAR"; break; + case MPI_UNEQUAL: rname = "UNEQUAL"; break; + printf( "[%d] Expected MPI_CONGRUENT but saw %d (%s)", + wrank, result, rname ); fflush(stdout); + } + } + else { + /* Try to communication between each member of intercomm */ + errs += TestIntercomm( newcomm ); + } + + if (newcomm != MPI_COMM_NULL) { + MPI_Comm_free(&newcomm); + } + /* test that an empty group in either side of the intercomm results in + * MPI_COMM_NULL for all members of the comm */ + if (isLeft) { + /* left side reuses oldgroup, our local group in intercomm */ + MPI_Comm_create(intercomm, oldgroup, &newcomm); + } + else { + /* right side passes MPI_GROUP_EMPTY */ + MPI_Comm_create(intercomm, MPI_GROUP_EMPTY, &newcomm); + } + if (newcomm != MPI_COMM_NULL) { + printf("[%d] expected MPI_COMM_NULL, but got a different communicator\n", wrank); fflush(stdout); + errs++; + } + + if (newcomm != MPI_COMM_NULL) { + MPI_Comm_free(&newcomm); + } + MPI_Group_free( &oldgroup ); + MPI_Comm_free( &intercomm ); + } + + MTest_Finalize(errs); + + MPI_Finalize(); + + return 0; +} + +int TestIntercomm( MPI_Comm comm ) +{ + int local_size, remote_size, rank, **bufs, *bufmem, rbuf[2], j; + int errs = 0, wrank, nsize; + char commname[MPI_MAX_OBJECT_NAME+1]; + MPI_Request *reqs; + + MPI_Comm_rank( MPI_COMM_WORLD, &wrank ); + MPI_Comm_size( comm, &local_size ); + MPI_Comm_remote_size( comm, &remote_size ); + MPI_Comm_rank( comm, &rank ); + MPI_Comm_get_name( comm, commname, &nsize ); + + MTestPrintfMsg( 1, "Testing communication on intercomm '%s', remote_size=%d\n", + commname, remote_size ); + + reqs = (MPI_Request *)malloc( remote_size * sizeof(MPI_Request) ); + if (!reqs) { + printf( "[%d] Unable to allocated %d requests for testing intercomm %s\n", + wrank, remote_size, commname ); + errs++; + return errs; + } + bufs = (int **) malloc( remote_size * sizeof(int *) ); + if (!bufs) { + printf( "[%d] Unable to allocated %d int pointers for testing intercomm %s\n", + wrank, remote_size, commname ); + errs++; + return errs; + } + bufmem = (int *) malloc( remote_size * 2 * sizeof(int) ); + if (!bufmem) { + printf( "[%d] Unable to allocated %d int data for testing intercomm %s\n", + wrank, 2*remote_size, commname ); + errs++; + return errs; + } + + /* Each process sends a message containing its own rank and the + rank of the destination with a nonblocking send. Because we're using + nonblocking sends, we need to use different buffers for each isend */ + /* NOTE: the send buffer access restriction was relaxed in MPI-2.2, although + it doesn't really hurt to keep separate buffers for our purposes */ + for (j=0; j +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Get the group of an intercommunicator"; +*/ + +int main( int argc, char *argv[] ) +{ + int errs = 0; + int rank, size, grank, gsize; + int minsize = 2, isleft; + MPI_Comm comm; + MPI_Group group; + + MTest_Init( &argc, &argv ); + + /* The following illustrates the use of the routines to + run through a selection of communicators and datatypes. + Use subsets of these for tests that do not involve combinations + of communicators, datatypes, and counts of datatypes */ + while (MTestGetIntercomm( &comm, &isleft, minsize )) { + if (comm == MPI_COMM_NULL) continue; + /* Determine the sender and receiver */ + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + MPI_Comm_group( comm, &group ); + MPI_Group_rank( group, &grank ); + MPI_Group_size( group, &gsize ); + if (rank != grank) { + errs++; + fprintf( stderr, "Ranks of groups do not match %d != %d\n", + rank, grank ); + } + if (size != gsize) { + errs++; + fprintf( stderr, "Sizes of groups do not match %d != %d\n", + size, gsize ); + } + MPI_Group_free( &group ); + MTestFreeComm( &comm ); + } + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/comm/icm.c b/teshsuite/smpi/mpich3-test/comm/icm.c new file mode 100644 index 0000000000..102c738e84 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/comm/icm.c @@ -0,0 +1,107 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2004 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include "mpi.h" +#include +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Test intercomm merge, including the choice of the high value"; +*/ + +int main( int argc, char *argv[] ) +{ + int errs = 0; + int rank, size, rsize; + int nsize, nrank; + int minsize = 2; + int isLeft; + MPI_Comm comm, comm1, comm2, comm3, comm4; + + MTest_Init( &argc, &argv ); + + /* The following illustrates the use of the routines to + run through a selection of communicators and datatypes. + Use subsets of these for tests that do not involve combinations + of communicators, datatypes, and counts of datatypes */ + while (MTestGetIntercomm( &comm, &isLeft, minsize )) { + if (comm == MPI_COMM_NULL) continue; + /* Determine the sender and receiver */ + MPI_Comm_rank( comm, &rank ); + MPI_Comm_remote_size( comm, &rsize ); + MPI_Comm_size( comm, &size ); + + /* Try building intercomms */ + MPI_Intercomm_merge( comm, isLeft, &comm1 ); + /* Check the size and ranks */ + MPI_Comm_size( comm1, &nsize ); + MPI_Comm_rank( comm1, &nrank ); + if (nsize != size + rsize) { + errs++; + printf( "(1) Comm size is %d but should be %d\n", nsize, + size + rsize ); + if (isLeft) { + /* The left processes should be high */ + if (nrank != rsize + rank) { + errs++; + printf( "(1) rank for high process is %d should be %d\n", + nrank, rsize + rank ); + } + } + else { + /* The right processes should be low */ + if (nrank != rank) { + errs++; + printf( "(1) rank for low process is %d should be %d\n", + nrank, rank ); + } + } + } + + MPI_Intercomm_merge( comm, !isLeft, &comm2 ); + /* Check the size and ranks */ + MPI_Comm_size( comm1, &nsize ); + MPI_Comm_rank( comm1, &nrank ); + if (nsize != size + rsize) { + errs++; + printf( "(2) Comm size is %d but should be %d\n", nsize, + size + rsize ); + if (!isLeft) { + /* The right processes should be high */ + if (nrank != rsize + rank) { + errs++; + printf( "(2) rank for high process is %d should be %d\n", + nrank, rsize + rank ); + } + } + else { + /* The left processes should be low */ + if (nrank != rank) { + errs++; + printf( "(2) rank for low process is %d should be %d\n", + nrank, rank ); + } + } + } + + + MPI_Intercomm_merge( comm, 0, &comm3 ); + + MPI_Intercomm_merge( comm, 1, &comm4 ); + + MPI_Comm_free( &comm1 ); + MPI_Comm_free( &comm2 ); + MPI_Comm_free( &comm3 ); + MPI_Comm_free( &comm4 ); + + MTestFreeComm( &comm ); + } + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/comm/icsplit.c b/teshsuite/smpi/mpich3-test/comm/icsplit.c new file mode 100644 index 0000000000..9ad2d51085 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/comm/icsplit.c @@ -0,0 +1,192 @@ +/* -*- 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 +#include +#include "mpitest.h" + +/* + * This program tests that MPI_Comm_split applies to intercommunicators; + * this is an extension added in MPI-2 + */ + +int TestIntercomm( MPI_Comm ); + +int main( int argc, char *argv[] ) +{ + int errs = 0; + int size, isLeft; + MPI_Comm intercomm, newcomm; + + MTest_Init( &argc, &argv ); + + MPI_Comm_size( MPI_COMM_WORLD, &size ); + if (size < 4) { + printf( "This test requires at least 4 processes\n" ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + + while (MTestGetIntercomm( &intercomm, &isLeft, 2 )) { + int key, color; + + if (intercomm == MPI_COMM_NULL) continue; + + /* Split this intercomm. The new intercomms contain the + processes that had odd (resp even) rank in their local group + in the original intercomm */ + MTestPrintfMsg( 1, "Created intercomm %s\n", MTestGetIntercommName() ); + MPI_Comm_rank( intercomm, &key ); + color = (key % 2); + MPI_Comm_split( intercomm, color, key, &newcomm ); + /* Make sure that the new communicator has the appropriate pieces */ + if (newcomm != MPI_COMM_NULL) { + int orig_rsize, orig_size, new_rsize, new_size; + int predicted_size, flag, commok=1; + + MPI_Comm_test_inter( intercomm, &flag ); + if (!flag) { + errs++; + printf( "Output communicator is not an intercomm\n" ); + commok = 0; + } + + MPI_Comm_remote_size( intercomm, &orig_rsize ); + MPI_Comm_remote_size( newcomm, &new_rsize ); + MPI_Comm_size( intercomm, &orig_size ); + MPI_Comm_size( newcomm, &new_size ); + /* The local size is 1/2 the original size, +1 if the + size was odd and the color was even. More precisely, + let n be the orig_size. Then + color 0 color 1 + orig size even n/2 n/2 + orig size odd (n+1)/2 n/2 + + However, since these are integer valued, if n is even, + then (n+1)/2 = n/2, so this table is much simpler: + color 0 color 1 + orig size even (n+1)/2 n/2 + orig size odd (n+1)/2 n/2 + + */ + predicted_size = (orig_size + !color) / 2; + if (predicted_size != new_size) { + errs++; + printf( "Predicted size = %d but found %d for %s (%d,%d)\n", + predicted_size, new_size, MTestGetIntercommName(), + orig_size, orig_rsize ); + commok = 0; + } + predicted_size = (orig_rsize + !color) / 2; + if (predicted_size != new_rsize) { + errs++; + printf( "Predicted remote size = %d but found %d for %s (%d,%d)\n", + predicted_size, new_rsize, MTestGetIntercommName(), + orig_size, orig_rsize ); + commok = 0; + } + /* ... more to do */ + if (commok) { + errs += TestIntercomm( newcomm ); + } + } + else { + int orig_rsize; + /* If the newcomm is null, then this means that remote group + for this color is of size zero (since all processes in this + test have been given colors other than MPI_UNDEFINED). + Confirm that here */ + /* FIXME: ToDo */ + MPI_Comm_remote_size( intercomm, &orig_rsize ); + if (orig_rsize == 1) { + if (color == 0) { + errs++; + printf( "Returned null intercomm when non-null expected\n" ); + } + } + } + if (newcomm != MPI_COMM_NULL) + MPI_Comm_free( &newcomm ); + MPI_Comm_free( &intercomm ); + } + MTest_Finalize(errs); + + MPI_Finalize(); + + return 0; +} + +/* FIXME: This is copied from iccreate. It should be in one place */ +int TestIntercomm( MPI_Comm comm ) +{ + int local_size, remote_size, rank, **bufs, *bufmem, rbuf[2], j; + int errs = 0, wrank, nsize; + char commname[MPI_MAX_OBJECT_NAME+1]; + MPI_Request *reqs; + + MPI_Comm_rank( MPI_COMM_WORLD, &wrank ); + MPI_Comm_size( comm, &local_size ); + MPI_Comm_remote_size( comm, &remote_size ); + MPI_Comm_rank( comm, &rank ); + MPI_Comm_get_name( comm, commname, &nsize ); + + MTestPrintfMsg( 1, "Testing communication on intercomm %s\n", commname ); + + reqs = (MPI_Request *)malloc( remote_size * sizeof(MPI_Request) ); + if (!reqs) { + printf( "[%d] Unable to allocated %d requests for testing intercomm %s\n", + wrank, remote_size, commname ); + errs++; + return errs; + } + bufs = (int **) malloc( remote_size * sizeof(int *) ); + if (!bufs) { + printf( "[%d] Unable to allocated %d int pointers for testing intercomm %s\n", + wrank, remote_size, commname ); + errs++; + return errs; + } + bufmem = (int *) malloc( remote_size * 2 * sizeof(int) ); + if (!bufmem) { + printf( "[%d] Unable to allocated %d int data for testing intercomm %s\n", + wrank, 2*remote_size, commname ); + errs++; + return errs; + } + + /* Each process sends a message containing its own rank and the + rank of the destination with a nonblocking send. Because we're using + nonblocking sends, we need to use different buffers for each isend */ + for (j=0; j +#include +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Test MPI_Probe() for an intercomm"; +*/ +#define MAX_DATA_LEN 100 + +int main( int argc, char *argv[] ) +{ + int errs = 0, recvlen, isLeft; + MPI_Status status; + int rank, size; + MPI_Comm intercomm; + char buf[MAX_DATA_LEN]; + const char *test_str = "test"; + + MTest_Init( &argc, &argv ); + + MPI_Comm_rank( MPI_COMM_WORLD, &rank ); + MPI_Comm_size( MPI_COMM_WORLD, &size ); + + if (size < 2) { + fprintf( stderr, "This test requires at least two processes." ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + + while (MTestGetIntercomm( &intercomm, &isLeft, 2 )) { + if (intercomm == MPI_COMM_NULL) continue; + + MPI_Comm_rank(intercomm, &rank); + + /* 0 ranks on each side communicate, everyone else does nothing */ + if(rank == 0) { + if (isLeft) { + recvlen = -1; + MPI_Probe(0, 0, intercomm, &status); + MPI_Get_count(&status, MPI_CHAR, &recvlen); + if (recvlen != (strlen(test_str) + 1)) { + printf(" Error: recvlen (%d) != strlen(\"%s\")+1 (%d)\n", recvlen, test_str, (int)strlen(test_str) + 1); + ++errs; + } + buf[0] = '\0'; + MPI_Recv(buf, recvlen, MPI_CHAR, 0, 0, intercomm, &status); + if (strcmp(test_str,buf)) { + printf(" Error: strcmp(test_str,buf)!=0\n"); + ++errs; + } + } + else { + strncpy(buf, test_str, 5); + MPI_Send(buf, strlen(buf)+1, MPI_CHAR, 0, 0, intercomm); + } + } + MTestFreeComm(&intercomm); + } + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/comm/testlist b/teshsuite/smpi/mpich3-test/comm/testlist new file mode 100644 index 0000000000..1e58a6fa67 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/comm/testlist @@ -0,0 +1,36 @@ +dup 2 +#needs MPI_Intercomm_create +#dupic 4 +#works, but needs MPI_Comm_set_name +commcreate1 8 +#needs MPI_Comm_set_name and MPI_Intercomm_create +#commname 4 +#ic1 4 +# ic2 needs an unusually large number of processes (>= 33) +#ic2 33 +#icgroup 8 +#icm 8 +#icsplit 8 +#iccreate 8 +ctxalloc 2 timeLimit=300 +ctxsplit 4 timeLimit=300 +cmfree 4 +cmsplit 4 +cmsplit2 12 +#probe-intercomm 2 +cmsplit_type 4 mpiversion=3.0 +comm_create_group 4 mpiversion=3.0 +comm_create_group 8 mpiversion=3.0 +comm_group_half 2 mpiversion=3.0 +comm_group_half 4 mpiversion=3.0 +comm_group_half 8 mpiversion=3.0 +comm_group_rand 2 mpiversion=3.0 +comm_group_rand 4 mpiversion=3.0 +comm_group_rand 8 mpiversion=3.0 +comm_idup 2 mpiversion=3.0 +comm_idup 4 mpiversion=3.0 +comm_idup 9 mpiversion=3.0 +dup_with_info 2 mpiversion=3.0 +dup_with_info 4 mpiversion=3.0 +dup_with_info 9 mpiversion=3.0 +comm_info 6 mpiversion=3.0 diff --git a/teshsuite/smpi/mpich3-test/group/CMakeLists.txt b/teshsuite/smpi/mpich3-test/group/CMakeLists.txt new file mode 100644 index 0000000000..d46a945e94 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/group/CMakeLists.txt @@ -0,0 +1,71 @@ +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(groupcreate groupcreate.c ../util/mtest.c) + add_executable(groupnullincl groupnullincl.c ../util/mtest.c) + add_executable(grouptest2 grouptest2.c ../util/mtest.c) + add_executable(grouptest grouptest.c ../util/mtest.c) + add_executable(gtranks gtranks.c ../util/mtest.c) + add_executable(gtranksperf gtranksperf.c ../util/mtest.c) + + + + target_link_libraries(groupcreate simgrid) + target_link_libraries(groupnullincl simgrid) + target_link_libraries(grouptest2 simgrid) + target_link_libraries(grouptest simgrid) + target_link_libraries(gtranks simgrid) + target_link_libraries(gtranksperf simgrid) + + + + set_target_properties(groupcreate PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(groupnullincl PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(grouptest2 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(grouptest PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(gtranks PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(gtranksperf 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}/groupcreate.c + ${CMAKE_CURRENT_SOURCE_DIR}/groupnullincl.c + ${CMAKE_CURRENT_SOURCE_DIR}/grouptest2.c + ${CMAKE_CURRENT_SOURCE_DIR}/grouptest.c + ${CMAKE_CURRENT_SOURCE_DIR}/gtranks.c + ${CMAKE_CURRENT_SOURCE_DIR}/gtranksperf.c + PARENT_SCOPE + ) +set(bin_files + ${bin_files} + PARENT_SCOPE + ) +set(txt_files + ${txt_files} + ${CMAKE_CURRENT_SOURCE_DIR}/runtests + ${CMAKE_CURRENT_SOURCE_DIR}/testlist + PARENT_SCOPE + ) diff --git a/teshsuite/smpi/mpich3-test/group/groupcreate.c b/teshsuite/smpi/mpich3-test/group/groupcreate.c new file mode 100644 index 0000000000..c8952d84e1 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/group/groupcreate.c @@ -0,0 +1,86 @@ +/* -*- 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 +/* stdlib.h Needed for malloc declaration */ +#include + +int main( int argc, char **argv ) +{ + int i, n, n_goal = 2048, n_all, rc, n_ranks, *ranks, rank, size, len; + int group_size; + MPI_Group *group_array, world_group; + char msg[MPI_MAX_ERROR_STRING]; + + MPI_Init( &argc, &argv ); + MPI_Comm_size( MPI_COMM_WORLD, &size ); + MPI_Comm_rank( MPI_COMM_WORLD, &rank ); + n = n_goal; + + group_array = (MPI_Group *)malloc( n * sizeof(MPI_Group) ); + + MPI_Comm_group( MPI_COMM_WORLD, &world_group ); + + n_ranks = size; + ranks = (int *)malloc( size * sizeof(int) ); + for (i=0; i +#include "mpitest.h" + +int main( int argc, char *argv[] ) +{ + int errs = 0; + int rc, result; + int ranks[1]; + MPI_Group group, outgroup; + MPI_Comm comm; + + MTest_Init( &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 ); + + while (MTestGetComm( &comm, 1 )) { + if (comm == MPI_COMM_NULL) continue; + + MPI_Comm_group( comm, &group ); + rc = MPI_Group_incl( group, 0, 0, &outgroup ); + if (rc) { + errs++; + MTestPrintError( rc ); + printf( "Error in creating an empty group with (0,0)\n" ); + + /* Some MPI implementations may reject a null "ranks" pointer */ + rc = MPI_Group_incl( group, 0, ranks, &outgroup ); + if (rc) { + errs++; + MTestPrintError( rc ); + printf( "Error in creating an empty group with (0,ranks)\n" ); + } + } + + if (outgroup != MPI_GROUP_EMPTY) { + /* Is the group equivalent to group empty? */ + rc = MPI_Group_compare( outgroup, MPI_GROUP_EMPTY, &result ); + if (result != MPI_IDENT) { + errs++; + MTestPrintError( rc ); + printf( "Did not create a group equivalent to an empty group\n" ); + } + } + rc = MPI_Group_free( &group ); + if (rc) { + errs++; + MTestPrintError( rc ); + } + if (outgroup != MPI_GROUP_NULL) { + rc = MPI_Group_free( &outgroup ); + if (rc) { + errs++; + MTestPrintError( rc ); + } + } + + MTestFreeComm( &comm ); + } + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; + +} diff --git a/teshsuite/smpi/mpich3-test/group/grouptest.c b/teshsuite/smpi/mpich3-test/group/grouptest.c new file mode 100644 index 0000000000..e0e2d93c3b --- /dev/null +++ b/teshsuite/smpi/mpich3-test/group/grouptest.c @@ -0,0 +1,177 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2001 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include "mpi.h" +#include +#include + +int main( int argc, char *argv[] ) +{ + MPI_Group g1, g2, g4, g5, g45, selfgroup, g6; + int ranks[16], size, rank, myrank, range[1][3]; + int errs = 0; + int i, rin[16], rout[16], result; + + MPI_Init(&argc,&argv); + + MPI_Comm_group( MPI_COMM_WORLD, &g1 ); + MPI_Comm_rank( MPI_COMM_WORLD, &myrank ); + MPI_Comm_size( MPI_COMM_WORLD, &size ); + if (size < 8) { + fprintf( stderr, + "Test requires 8 processes (16 prefered) only %d provided\n", + size ); + errs++; + } + + /* 16 members, this process is rank 0, return in group 1 */ + ranks[0] = myrank; ranks[1] = 2; ranks[2] = 7; + if (myrank == 2) ranks[1] = 3; + if (myrank == 7) ranks[2] = 6; + MPI_Group_incl( g1, 3, ranks, &g2 ); + + /* Check the resulting group */ + MPI_Group_size( g2, &size ); + MPI_Group_rank( g2, &rank ); + + if (size != 3) { + fprintf( stderr, "Size should be %d, is %d\n", 3, size ); + errs++; + } + if (rank != 0) { + fprintf( stderr, "Rank should be %d, is %d\n", 0, rank ); + errs++; + } + + rin[0] = 0; rin[1] = 1; rin[2] = 2; + MPI_Group_translate_ranks( g2, 3, rin, g1, rout ); + for (i=0; i<3; i++) { + if (rout[i] != ranks[i]) { + fprintf( stderr, "translated rank[%d] %d should be %d\n", + i, rout[i], ranks[i] ); + errs++; + } + } + + /* Translate the process of the self group against another group */ + MPI_Comm_group( MPI_COMM_SELF, &selfgroup ); + rin[0] = 0; + MPI_Group_translate_ranks( selfgroup, 1, rin, g1, rout ); + if (rout[0] != myrank) { + fprintf( stderr, "translated of self is %d should be %d\n", + rout[0], myrank ); + errs++; + } + + for (i=0; i g2 + intersect ( w, g3 ) => g3 + intersect ( g2, g3 ) => empty + + g4 = rincl 1:n-1:2 + g5 = rexcl 1:n-1:2 + union( g4, g5 ) => world + g6 = rincl n-1:1:-1 + g7 = rexcl n-1:1:-1 + union( g6, g7 ) => concat of entries, similar to world + diff( w, g2 ) => g3 + */ + MPI_Group_free( &g2 ); + + range[0][0] = 1; + range[0][1] = size-1; + range[0][2] = 2; + MPI_Group_range_excl( g1, 1, range, &g5 ); + + range[0][0] = 1; + range[0][1] = size-1; + range[0][2] = 2; + MPI_Group_range_incl( g1, 1, range, &g4 ); + MPI_Group_union( g4, g5, &g45 ); + MPI_Group_compare( MPI_GROUP_EMPTY, g4, &result ); + if (result != MPI_UNEQUAL) { + errs++; + fprintf( stderr, "Comparison with empty group gave %d, not 3\n", + result ); + } + MPI_Group_free( &g4 ); + MPI_Group_free( &g5 ); + MPI_Group_free( &g45 ); + + /* Now, duplicate the test, but using negative strides */ + range[0][0] = size-1; + range[0][1] = 1; + range[0][2] = -2; + MPI_Group_range_excl( g1, 1, range, &g5 ); + + range[0][0] = size-1; + range[0][1] = 1; + range[0][2] = -2; + MPI_Group_range_incl( g1, 1, range, &g4 ); + + MPI_Group_union( g4, g5, &g45 ); + + MPI_Group_compare( MPI_GROUP_EMPTY, g4, &result ); + if (result != MPI_UNEQUAL) { + errs++; + fprintf( stderr, "Comparison with empty group (formed with negative strides) gave %d, not 3\n", + result ); + } + MPI_Group_free( &g4 ); + MPI_Group_free( &g5 ); + MPI_Group_free( &g45 ); + MPI_Group_free( &g1 ); + + if (myrank == 0) + { + if (errs == 0) { + printf( " No Errors\n" ); + } + else { + printf( "Found %d errors\n", errs ); + } + } + + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/group/grouptest2.c b/teshsuite/smpi/mpich3-test/group/grouptest2.c new file mode 100644 index 0000000000..7d8fb7e152 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/group/grouptest2.c @@ -0,0 +1,213 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2001 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ + +/* + Test the group routines + (some tested elsewere) + +MPI_Group_compare +MPI_Group_excl +MPI_Group_intersection +MPI_Group_range_excl +MPI_Group_rank +MPI_Group_size +MPI_Group_translate_ranks +MPI_Group_union + + */ +#include "mpi.h" +#include +/* stdlib.h Needed for malloc declaration */ +#include + +int main( int argc, char **argv ) +{ + int errs=0, toterr; + MPI_Group basegroup; + MPI_Group g1, g2, g3, g4, g5, g6, g7, g8, g9, g10; + MPI_Group g3a, g3b; + MPI_Comm comm, newcomm, splitcomm, dupcomm; + int i, grp_rank, rank, grp_size, size, result; + int nranks, *ranks, *ranks_out; + int range[1][3]; + int worldrank; + + MPI_Init( &argc, &argv ); + MPI_Comm_rank( MPI_COMM_WORLD, &worldrank ); + + comm = MPI_COMM_WORLD; + + MPI_Comm_group( comm, &basegroup ); + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + +/* Get the basic information on this group */ + MPI_Group_rank( basegroup, &grp_rank ); + if (grp_rank != rank) { + errs++; + fprintf( stdout, "group rank %d != comm rank %d\n", grp_rank, rank ); + } + + MPI_Group_size( basegroup, &grp_size ); + if (grp_size != size) { + errs++; + fprintf( stdout, "group size %d != comm size %d\n", grp_size, size ); + } + + +/* Form a new communicator with inverted ranking */ + MPI_Comm_split( comm, 0, size - rank, &newcomm ); + MPI_Comm_group( newcomm, &g1 ); + ranks = (int *)malloc( size * sizeof(int) ); + ranks_out = (int *)malloc( size * sizeof(int) ); + for (i=0; i +#include "mpitest.h" + +#define MAX_WORLD_SIZE 1024 + +int main( int argc, char *argv[] ) +{ + int errs = 0; + int ranks[MAX_WORLD_SIZE], ranksout[MAX_WORLD_SIZE], + ranksin[MAX_WORLD_SIZE]; + int range[1][3]; + MPI_Group gworld, gself, ngroup, galt; + MPI_Comm comm; + int rank, size, i, nelms; + + MTest_Init( &argc, &argv ); + + MPI_Comm_group( MPI_COMM_SELF, &gself ); + + comm = MPI_COMM_WORLD; + + MPI_Comm_size( comm, &size ); + MPI_Comm_rank( comm, &rank ); + + if (size > MAX_WORLD_SIZE) { + fprintf( stderr, + "This test requires a comm world with no more than %d processes\n", + MAX_WORLD_SIZE ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + if (size < 4) { + fprintf( stderr, "This test requiers at least 4 processes\n" ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + + MPI_Comm_group( comm, &gworld ); + for (i=0; i +#include +#include "mpitest.h" + +#include /* for fabs(3) */ + +/* Measure and compare the relative performance of MPI_Group_translate_ranks + * with small and large group2 sizes but a constant number of ranks. This + * serves as a performance sanity check for the Scalasca use case where we + * translate to MPI_COMM_WORLD ranks. The performance should only depend on the + * number of ranks passed, not the size of either group (especially group2). + * + * This test is probably only meaningful for large-ish process counts, so we may + * not be able to run this test by default in the nightlies. */ + +/* number of iterations used for timing */ +#define NUM_LOOPS (1000000) + +int main( int argc, char *argv[] ) +{ + int errs = 0; + int *ranks; + int *ranksout; + MPI_Group gworld, grev, gself; + MPI_Comm comm; + MPI_Comm commrev; + int rank, size, i; + double start, end, time1, time2; + + MTest_Init( &argc, &argv ); + + comm = MPI_COMM_WORLD; + + MPI_Comm_size( comm, &size ); + MPI_Comm_rank( comm, &rank ); + + ranks = malloc(size*sizeof(int)); + ranksout = malloc(size*sizeof(int)); + if (!ranks || !ranksout) { + fprintf(stderr, "out of memory\n"); + MPI_Abort(MPI_COMM_WORLD, 1); + } + + /* generate a comm with the rank order reversed */ + MPI_Comm_split(comm, 0, (size-rank-1), &commrev); + MPI_Comm_group(commrev, &grev); + MPI_Comm_group(MPI_COMM_SELF, &gself); + MPI_Comm_group(comm, &gworld); + + /* sanity check correctness first */ + for (i=0; i < size; i++) { + ranks[i] = i; + ranksout[i] = -1; + } + MPI_Group_translate_ranks(grev, size, ranks, gworld, ranksout); + for (i=0; i < size; i++) { + if (ranksout[i] != (size-i-1)) { + if (rank == 0) + printf("%d: (gworld) expected ranksout[%d]=%d, got %d\n", rank, i, (size-rank-1), ranksout[i]); + ++errs; + } + } + MPI_Group_translate_ranks(grev, size, ranks, gself, ranksout); + for (i=0; i < size; i++) { + int expected = (i == (size-rank-1) ? 0 : MPI_UNDEFINED); + if (ranksout[i] != expected) { + if (rank == 0) + printf("%d: (gself) expected ranksout[%d]=%d, got %d\n", rank, i, expected, ranksout[i]); + ++errs; + } + } + + /* now compare relative performance */ + + /* we needs lots of procs to get a group large enough to have meaningful + * numbers. On most testing machines this means that we're oversubscribing + * cores in a big way, which might perturb the timing results. So we make + * sure everyone started up and then everyone but rank 0 goes to sleep to + * let rank 0 do all the timings. */ + MPI_Barrier(comm); + + if (rank != 0) { + MTestSleep(10); + } + else /* rank==0 */ { + MTestSleep(1); /* try to avoid timing while everyone else is making syscalls */ + + MPI_Group_translate_ranks(grev, size, ranks, gworld, ranksout); /*throwaway iter*/ + start = MPI_Wtime(); + for (i = 0; i < NUM_LOOPS; ++i) { + MPI_Group_translate_ranks(grev, size, ranks, gworld, ranksout); + } + end = MPI_Wtime(); + time1 = end - start; + + MPI_Group_translate_ranks(grev, size, ranks, gself, ranksout); /*throwaway iter*/ + start = MPI_Wtime(); + for (i = 0; i < NUM_LOOPS; ++i) { + MPI_Group_translate_ranks(grev, size, ranks, gself, ranksout); + } + end = MPI_Wtime(); + time2 = end - start; + + /* complain if the "gworld" time exceeds 2x the "gself" time */ + if (fabs(time1 - time2) > (2.00 * time2)) { + printf("too much difference in MPI_Group_translate_ranks performance:\n"); + printf("time1=%f time2=%f\n", time1, time2); + printf("(fabs(time1-time2)/time2)=%f\n", (fabs(time1-time2)/time2)); + if (time1 < time2) { + printf("also, (time1 +#include "mpitest.h" + +/* +static char MTestDescrip[] = "Test creating and inserting attributes in \ +different orders to ensure that the list management code handles all cases."; +*/ + +int checkAttrs( MPI_Comm, int, int [], int [] ); +int delete_fn( MPI_Comm, int, void *, void *); + +#define NKEYS 5 +static int key[NKEYS]; /* Keys in creation order */ +static int keyorder[NKEYS]; /* Index (into key) of keys in order added to comm + (key[keyorder[0]] is first set) */ +static int nkeys = 0; +static int ncall = 0; +static int errs = 0; +/* + * Test that attributes on comm self are deleted in LIFO order + */ + +int main( int argc, char *argv[] ) +{ + int attrval[10]; + int wrank, i; + MPI_Comm comm; + + MPI_Init( &argc, &argv ); + + MPI_Comm_rank( MPI_COMM_WORLD, &wrank ); + + comm = MPI_COMM_SELF; + + /* Create key values */ + for (nkeys=0; nkeys= nkeys) { + printf( "delete function called too many times!\n" ); + errs++; + } + + /* As of MPI 2.2, the order of deletion of attributes on + MPI_COMM_SELF is defined */ + if (MPI_VERSION > 2 || (MPI_VERSION == 2 && MPI_SUBVERSION >= 2)) { + if (keyval != key[keyorder[nkeys-1-ncall]]) { + printf( "Expected key # %d but found key with value %d\n", + keyorder[nkeys-1-ncall], keyval ); + errs++; + } + } + ncall++; + return MPI_SUCCESS; +} + +/* +int checkNoAttrs( MPI_Comm comm, int n, int lkey[] ) +{ + int lerrs = 0; + int i, flag, *val_p; + + for (i=0; i + +/* FIXME: This test program assumes that MPI_Error_string will work even + if MPI is not initialized. That is not guaranteed. */ + +/* Normally, when checking for error returns from MPI calls, you must ensure + that the error handler on the relevant object (communicator, file, or + window) has been set to MPI_ERRORS_RETURN. The tests in this + program are a special case, as either a failure or an abort will + indicate a problem */ + +int main( int argc, char *argv[] ) +{ + int error; + int flag; + char err_string[1024]; + int length = 1024; + int rank; + + flag = 0; + error = MPI_Finalized(&flag); + if (error != MPI_SUCCESS) + { + MPI_Error_string(error, err_string, &length); + printf("MPI_Finalized failed: %s\n", err_string); + fflush(stdout); + return error; + } + if (flag) + { + printf("MPI_Finalized returned true before MPI_Init.\n"); + return -1; + } + + error = MPI_Init(&argc, &argv); + if (error != MPI_SUCCESS) + { + MPI_Error_string(error, err_string, &length); + printf("MPI_Init failed: %s\n", err_string); + fflush(stdout); + return error; + } + + error = MPI_Comm_rank(MPI_COMM_WORLD, &rank); + if (error != MPI_SUCCESS) + { + MPI_Error_string(error, err_string, &length); + printf("MPI_Comm_rank failed: %s\n", err_string); + fflush(stdout); + MPI_Abort(MPI_COMM_WORLD, error); + return error; + } + + flag = 0; + error = MPI_Finalized(&flag); + if (error != MPI_SUCCESS) + { + MPI_Error_string(error, err_string, &length); + printf("MPI_Finalized failed: %s\n", err_string); + fflush(stdout); + MPI_Abort(MPI_COMM_WORLD, error); + return error; + } + if (flag) + { + printf("MPI_Finalized returned true before MPI_Finalize.\n"); + fflush(stdout); + MPI_Abort(MPI_COMM_WORLD, error); + return -1; + } + + error = MPI_Barrier(MPI_COMM_WORLD); + if (error != MPI_SUCCESS) + { + MPI_Error_string(error, err_string, &length); + printf("MPI_Barrier failed: %s\n", err_string); + fflush(stdout); + MPI_Abort(MPI_COMM_WORLD, error); + return error; + } + + error = MPI_Finalize(); + if (error != MPI_SUCCESS) + { + MPI_Error_string(error, err_string, &length); + printf("MPI_Finalize failed: %s\n", err_string); + fflush(stdout); + return error; + } + + flag = 0; + error = MPI_Finalized(&flag); + if (error != MPI_SUCCESS) + { + MPI_Error_string(error, err_string, &length); + printf("MPI_Finalized failed: %s\n", err_string); + fflush(stdout); + return error; + } + if (!flag) + { + printf("MPI_Finalized returned false after MPI_Finalize.\n"); + return -1; + } + if (rank == 0) + { + printf(" No Errors\n"); + } + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/init/initstat.c b/teshsuite/smpi/mpich3-test/init/initstat.c new file mode 100644 index 0000000000..f3d42e17c6 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/init/initstat.c @@ -0,0 +1,36 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2003 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include "mpi.h" +#include +#include "mpitest.h" + +int main( int argc, char *argv[] ) +{ + int errs = 0; + int provided, flag, claimed; + + /* MTest_Init( &argc, &argv ); */ + + MPI_Init_thread( &argc, &argv, MPI_THREAD_MULTIPLE, &provided ); + + MPI_Is_thread_main( &flag ); + if (!flag) { + errs++; + printf( "This thread called init_thread but Is_thread_main gave false\n" ); + } + MPI_Query_thread( &claimed ); + if (claimed != provided) { + errs++; + printf( "Query thread gave thread level %d but Init_thread gave %d\n", + claimed, provided ); + } + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; + +} diff --git a/teshsuite/smpi/mpich3-test/init/library_version.c b/teshsuite/smpi/mpich3-test/init/library_version.c new file mode 100644 index 0000000000..132e135c55 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/init/library_version.c @@ -0,0 +1,34 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2012 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include "mpi.h" +#include +#include "mpitest.h" + +static int verbose = 0; + +int main(int argc, char *argv[]) +{ + int errs = 0, resultlen = -1; + char version[MPI_MAX_LIBRARY_VERSION_STRING]; + + MTest_Init(&argc, &argv); + + MPI_Get_library_version(version, &resultlen); + if (resultlen < 0) { + errs++; + printf("Resultlen is %d\n", resultlen); + } + else { + if (verbose) + printf("%s\n", version); + } + + MTest_Finalize(errs); + MPI_Finalize(); + return 0; + +} diff --git a/teshsuite/smpi/mpich3-test/init/testlist b/teshsuite/smpi/mpich3-test/init/testlist new file mode 100644 index 0000000000..b2e20fbc3f --- /dev/null +++ b/teshsuite/smpi/mpich3-test/init/testlist @@ -0,0 +1,9 @@ +exitst1 2 resultTest=TestStatus +exitst2 4 resultTest=TestStatus +initstat 1 +#timeout 2 resultTest=TestTimeout timeLimit=10 +version 1 +finalized 1 +#needs PMPI_Comm_free_keyval +#attrself 1 +library_version 1 mpiversion=3.0 diff --git a/teshsuite/smpi/mpich3-test/init/timeout.c b/teshsuite/smpi/mpich3-test/init/timeout.c new file mode 100644 index 0000000000..912619f4b4 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/init/timeout.c @@ -0,0 +1,20 @@ +/* -*- 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" + +/* This is a program that tests the ability of mpiexec to timeout a process + after no more than 3 minutes. By default, it will run for 5 minutes */ +int main( int argc, char *argv[] ) +{ + double t1; + double deltaTime = 300; + + MPI_Init( &argc, &argv ); + t1 = MPI_Wtime(); + while (MPI_Wtime() - t1 < deltaTime) ; + MPI_Finalize( ); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/init/version.c b/teshsuite/smpi/mpich3-test/init/version.c new file mode 100644 index 0000000000..40c5895fc4 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/init/version.c @@ -0,0 +1,34 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2003 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include "mpi.h" +#include +#include "mpitest.h" + +int main( int argc, char *argv[] ) +{ + int errs = 0; + int majversion, subversion; + + MTest_Init( &argc, &argv ); + + MPI_Get_version( &majversion, &subversion ); + if (majversion != MPI_VERSION) { + errs++; + printf( "Major version is %d but is %d in the mpi.h file\n", + majversion, MPI_VERSION ); + } + if (subversion != MPI_SUBVERSION) { + errs++; + printf( "Minor version is %d but is %d in the mpi.h file\n", + subversion, MPI_SUBVERSION ); + } + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; + +} diff --git a/teshsuite/smpi/mpich3-test/pt2pt/CMakeLists.txt b/teshsuite/smpi/mpich3-test/pt2pt/CMakeLists.txt new file mode 100644 index 0000000000..c774661d1b --- /dev/null +++ b/teshsuite/smpi/mpich3-test/pt2pt/CMakeLists.txt @@ -0,0 +1,191 @@ +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(anyall anyall.c ../util/mtest.c) + add_executable(bottom bottom.c ../util/mtest.c) + add_executable(bsend1 bsend1.c ../util/mtest.c) + add_executable(bsend2 bsend2.c ../util/mtest.c) + add_executable(bsend3 bsend3.c ../util/mtest.c) + add_executable(bsend4 bsend4.c ../util/mtest.c) + add_executable(bsend5 bsend5.c ../util/mtest.c) + add_executable(bsendalign bsendalign.c ../util/mtest.c) + add_executable(bsendfrag bsendfrag.c ../util/mtest.c) + add_executable(bsendpending bsendpending.c ../util/mtest.c) + add_executable(cancelrecv cancelrecv.c ../util/mtest.c) + add_executable(eagerdt eagerdt.c ../util/mtest.c) + add_executable(greq1 greq1.c ../util/mtest.c) + add_executable(icsend icsend.c ../util/mtest.c) + add_executable(inactivereq inactivereq.c ../util/mtest.c) + add_executable(isendself isendself.c ../util/mtest.c) + add_executable(isendselfprobe isendselfprobe.c ../util/mtest.c) + add_executable(large_message large_message.c ../util/mtest.c) + add_executable(mprobe mprobe.c ../util/mtest.c) + add_executable(pingping pingping.c ../util/mtest.c) + add_executable(probenull probenull.c ../util/mtest.c) + add_executable(probe-unexp probe-unexp.c ../util/mtest.c) + add_executable(pscancel pscancel.c ../util/mtest.c) + add_executable(rcancel rcancel.c ../util/mtest.c) + add_executable(rqfreeb rqfreeb.c ../util/mtest.c) + add_executable(rqstatus rqstatus.c ../util/mtest.c) + add_executable(scancel2 scancel2.c ../util/mtest.c) + add_executable(scancel scancel.c ../util/mtest.c) + add_executable(sendall sendall.c ../util/mtest.c) + add_executable(sendflood sendflood.c ../util/mtest.c) + add_executable(sendrecv1 sendrecv1.c ../util/mtest.c) + add_executable(sendrecv2 sendrecv2.c ../util/mtest.c) + add_executable(sendrecv3 sendrecv3.c ../util/mtest.c) + add_executable(sendself sendself.c ../util/mtest.c) + add_executable(waitany-null waitany-null.c ../util/mtest.c) + add_executable(waittestnull waittestnull.c ../util/mtest.c) + + + + target_link_libraries(anyall simgrid) + target_link_libraries(bottom simgrid) + target_link_libraries(bsend1 simgrid) + target_link_libraries(bsend2 simgrid) + target_link_libraries(bsend3 simgrid) + target_link_libraries(bsend4 simgrid) + target_link_libraries(bsend5 simgrid) + target_link_libraries(bsendalign simgrid) + target_link_libraries(bsendfrag simgrid) + target_link_libraries(bsendpending simgrid) + target_link_libraries(cancelrecv simgrid) + target_link_libraries(eagerdt simgrid) + target_link_libraries(greq1 simgrid) + target_link_libraries(icsend simgrid) + target_link_libraries(inactivereq simgrid) + target_link_libraries(isendself simgrid) + target_link_libraries(isendselfprobe simgrid) + target_link_libraries(large_message simgrid) + target_link_libraries(mprobe simgrid) + target_link_libraries(pingping simgrid) + target_link_libraries(probenull simgrid) + target_link_libraries(probe-unexp simgrid) + target_link_libraries(pscancel simgrid) + target_link_libraries(rcancel simgrid) + target_link_libraries(rqfreeb simgrid) + target_link_libraries(rqstatus simgrid) + target_link_libraries(scancel2 simgrid) + target_link_libraries(scancel simgrid) + target_link_libraries(sendall simgrid) + target_link_libraries(sendflood simgrid) + target_link_libraries(sendrecv1 simgrid) + target_link_libraries(sendrecv2 simgrid) + target_link_libraries(sendrecv3 simgrid) + target_link_libraries(sendself simgrid) + target_link_libraries(waitany-null simgrid) + target_link_libraries(waittestnull simgrid) + + + + set_target_properties(anyall PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(bottom PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(bsend1 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(bsend2 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(bsend3 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(bsend4 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(bsend5 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(bsendalign PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(bsendfrag PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(bsendpending PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(cancelrecv PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(eagerdt PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(greq1 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(icsend PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(inactivereq PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(isendself PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(isendselfprobe PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(large_message PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(mprobe PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(pingping PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(probenull PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(probe-unexp PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(pscancel PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(rcancel PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(rqfreeb PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(rqstatus PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(scancel2 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(scancel PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(sendall PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(sendflood PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(sendrecv1 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(sendrecv2 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(sendrecv3 PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(sendself PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(waitany-null PROPERTIES COMPILE_FLAGS "${MPICH_FLAGS}") + set_target_properties(waittestnull 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}/anyall.c + ${CMAKE_CURRENT_SOURCE_DIR}/bottom.c + ${CMAKE_CURRENT_SOURCE_DIR}/bsend1.c + ${CMAKE_CURRENT_SOURCE_DIR}/bsend2.c + ${CMAKE_CURRENT_SOURCE_DIR}/bsend3.c + ${CMAKE_CURRENT_SOURCE_DIR}/bsend4.c + ${CMAKE_CURRENT_SOURCE_DIR}/bsend5.c + ${CMAKE_CURRENT_SOURCE_DIR}/bsendalign.c + ${CMAKE_CURRENT_SOURCE_DIR}/bsendfrag.c + ${CMAKE_CURRENT_SOURCE_DIR}/bsendpending.c + ${CMAKE_CURRENT_SOURCE_DIR}/cancelrecv.c + ${CMAKE_CURRENT_SOURCE_DIR}/eagerdt.c + ${CMAKE_CURRENT_SOURCE_DIR}/greq1.c + ${CMAKE_CURRENT_SOURCE_DIR}/icsend.c + ${CMAKE_CURRENT_SOURCE_DIR}/inactivereq.c + ${CMAKE_CURRENT_SOURCE_DIR}/isendself.c + ${CMAKE_CURRENT_SOURCE_DIR}/isendselfprobe.c + ${CMAKE_CURRENT_SOURCE_DIR}/large_message.c + ${CMAKE_CURRENT_SOURCE_DIR}/mprobe.c + ${CMAKE_CURRENT_SOURCE_DIR}/pingping.c + ${CMAKE_CURRENT_SOURCE_DIR}/probenull.c + ${CMAKE_CURRENT_SOURCE_DIR}/probe-unexp.c + ${CMAKE_CURRENT_SOURCE_DIR}/pscancel.c + ${CMAKE_CURRENT_SOURCE_DIR}/rcancel.c + ${CMAKE_CURRENT_SOURCE_DIR}/rqfreeb.c + ${CMAKE_CURRENT_SOURCE_DIR}/rqstatus.c + ${CMAKE_CURRENT_SOURCE_DIR}/scancel2.c + ${CMAKE_CURRENT_SOURCE_DIR}/scancel.c + ${CMAKE_CURRENT_SOURCE_DIR}/sendall.c + ${CMAKE_CURRENT_SOURCE_DIR}/sendflood.c + ${CMAKE_CURRENT_SOURCE_DIR}/sendrecv1.c + ${CMAKE_CURRENT_SOURCE_DIR}/sendrecv2.c + ${CMAKE_CURRENT_SOURCE_DIR}/sendrecv3.c + ${CMAKE_CURRENT_SOURCE_DIR}/sendself.c + ${CMAKE_CURRENT_SOURCE_DIR}/waitany-null.c + ${CMAKE_CURRENT_SOURCE_DIR}/waittestnull.c + PARENT_SCOPE + ) +set(bin_files + ${bin_files} + PARENT_SCOPE + ) +set(txt_files + ${txt_files} + ${CMAKE_CURRENT_SOURCE_DIR}/runtests + ${CMAKE_CURRENT_SOURCE_DIR}/testlist + PARENT_SCOPE + ) diff --git a/teshsuite/smpi/mpich3-test/pt2pt/anyall.c b/teshsuite/smpi/mpich3-test/pt2pt/anyall.c new file mode 100644 index 0000000000..b54b13ad8f --- /dev/null +++ b/teshsuite/smpi/mpich3-test/pt2pt/anyall.c @@ -0,0 +1,88 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2009 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include "mpi.h" +#include +#include +#include "mpitest.h" + +#define MAX_MSGS 30 + +/* +static char MTEST_Descrip[] = "One implementation delivered incorrect data when an MPI recieve uses both ANY_SOURCE and ANY_TAG"; +*/ + +int main( int argc, char *argv[] ) +{ + int wrank, wsize, master, worker, i, j, idx, count; + int errs = 0; + MPI_Request r[MAX_MSGS]; + int buf[MAX_MSGS][MAX_MSGS]; + MPI_Comm comm; + MPI_Status status; + + MTest_Init( &argc, &argv ); + + MPI_Comm_rank( MPI_COMM_WORLD, &wrank ); + MPI_Comm_size( MPI_COMM_WORLD, &wsize ); + + comm = MPI_COMM_WORLD; + master = 0; + worker = 1; + + /* The test takes advantage of the ordering rules for messages*/ + + if (wrank == master) { + /* Initialize the send buffer */ + for (i=0; i +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Use of MPI_BOTTOM in communication"; +*/ + +int main( int argc, char *argv[] ) +{ + int errs = 0, err; + int rank, size, source, dest, len, ii; + MPI_Comm comm; + MPI_Status status; + MPI_Datatype newtype, oldtype; + MPI_Aint disp; + + MTest_Init( &argc, &argv ); + + MPI_Get_address( &ii, &disp ); + + len = 1; + oldtype = MPI_INT; + MPI_Type_create_struct( 1, &len, &disp, &oldtype, &newtype ); + MPI_Type_commit( &newtype ); + + comm = MPI_COMM_WORLD; + + MPI_Comm_size( comm, &size ); + MPI_Comm_rank( comm, &rank ); + + if (size < 2) { + errs++; + fprintf( stderr, "This test requires at least two processes\n" ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + source = 0; + dest = 1; + + /* To improve reporting of problems about operations, we + change the error handler to errors return */ + MPI_Comm_set_errhandler( comm, MPI_ERRORS_RETURN ); + + if (rank == source) { + ii = 2; + err = MPI_Send( MPI_BOTTOM, 1, newtype, dest, 0, comm ); + if (err) { + errs++; + MTestPrintError( err ); + printf( "MPI_Send did not return MPI_SUCCESS\n" ); + } + } + else if (rank == dest) { + ii = -1; + err = MPI_Recv( MPI_BOTTOM, 1, newtype, source, 0, comm, &status ); + if (err) { + MTestPrintError( err ); + errs++; + printf( "MPI_Recv did not return MPI_SUCCESS\n" ); + } + if (ii != 2) { + errs++; + printf( "Received %d but expected %d\n", ii, 2 ); + } + } + + MPI_Comm_set_errhandler( comm, MPI_ERRORS_ARE_FATAL ); + + MPI_Type_free( &newtype ); + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/pt2pt/bsend1.c b/teshsuite/smpi/mpich3-test/pt2pt/bsend1.c new file mode 100644 index 0000000000..8ef0062028 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/pt2pt/bsend1.c @@ -0,0 +1,84 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2001 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include "mpi.h" +#include +#include +#include "mpitest.h" +#include "mpitestconf.h" +#ifdef HAVE_STRING_H +#include +#endif + +/* + * This is a simple program that tests bsend. It may be run as a single + * process to simplify debugging; in addition, bsend allows send-to-self + * programs. + */ +int main( int argc, char *argv[] ) +{ + MPI_Comm comm = MPI_COMM_WORLD; + int dest = 0, src = 0, tag = 1; + int s1, s2, s3; + char *buf, *bbuf; + char msg1[7], msg3[17]; + double msg2[2]; + char rmsg1[64], rmsg3[64]; + double rmsg2[64]; + int errs = 0, rank; + int bufsize, bsize; + + MTest_Init( &argc, &argv ); + MPI_Comm_rank( MPI_COMM_WORLD, &rank ); + + /* According to the standard, we must use the PACK_SIZE length of each + message in the computation of the message buffer size */ + MPI_Pack_size( 7, MPI_CHAR, comm, &s1 ); + MPI_Pack_size( 2, MPI_DOUBLE, comm, &s2 ); + MPI_Pack_size( 17, MPI_CHAR, comm, &s3 ); + bufsize = 3 * MPI_BSEND_OVERHEAD + s1 + s2 + s3; + buf = (char *)malloc( bufsize ); + MPI_Buffer_attach( buf, bufsize ); + + strncpy( msg1, "012345", 7 ); + strncpy( msg3, "0123401234012341", 17 ); + msg2[0] = 1.23; msg2[1] = 3.21; + + if (rank == src) { + /* These message sizes are chosen to expose any alignment problems */ + MPI_Bsend( msg1, 7, MPI_CHAR, dest, tag, comm ); + MPI_Bsend( msg2, 2, MPI_DOUBLE, dest, tag, comm ); + MPI_Bsend( msg3, 17, MPI_CHAR, dest, tag, comm ); + } + + if (rank == dest) { + MPI_Recv( rmsg1, 7, MPI_CHAR, src, tag, comm, MPI_STATUS_IGNORE ); + MPI_Recv( rmsg2, 10, MPI_DOUBLE, src, tag, comm, MPI_STATUS_IGNORE ); + MPI_Recv( rmsg3, 17, MPI_CHAR, src, tag, comm, MPI_STATUS_IGNORE ); + + if (strcmp( rmsg1, msg1 ) != 0) { + errs++; + fprintf( stderr, "message 1 (%s) should be %s\n", rmsg1, msg1 ); + } + if (rmsg2[0] != msg2[0] || rmsg2[1] != msg2[1]) { + errs++; + fprintf( stderr, + "message 2 incorrect, values are (%f,%f) but should be (%f,%f)\n", + rmsg2[0], rmsg2[1], msg2[0], msg2[1] ); + } + if (strcmp( rmsg3, msg3 ) != 0) { + errs++; + fprintf( stderr, "message 3 (%s) should be %s\n", rmsg3, msg3 ); + } + } + + /* We can't guarantee that messages arrive until the detach */ + MPI_Buffer_detach( &bbuf, &bsize ); + + MTest_Finalize( errs ); + + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/pt2pt/bsend2.c b/teshsuite/smpi/mpich3-test/pt2pt/bsend2.c new file mode 100644 index 0000000000..4f6ad93ac7 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/pt2pt/bsend2.c @@ -0,0 +1,61 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2001 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include +#include "mpi.h" +#include "mpitest.h" + +#define BUFSIZE 2000 +int main( int argc, char *argv[] ) +{ + MPI_Status status; + int a[10], b[10]; + int buf[BUFSIZE], *bptr, bl, i, j, rank, size; + int errs = 0; + + MTest_Init( 0, 0 ); + MPI_Comm_rank( MPI_COMM_WORLD, &rank ); + MPI_Comm_size( MPI_COMM_WORLD, &size ); + MPI_Buffer_attach( buf, BUFSIZE ); + + for (j=0; j<10; j++) { + for (i=0; i<10; i++) { + a[i] = (rank + 10 * j) * size + i; + } + MPI_Bsend( a, 10, MPI_INT, 0, 27+j, MPI_COMM_WORLD ); + } + if (rank == 0) { + + for (i=0; i +#include "mpi.h" +#include "mpitest.h" + +#define BUFSIZE 2000 +int main( int argc, char *argv[] ) +{ + MPI_Status status; + MPI_Request request; + int a[10], b[10]; + int buf[BUFSIZE], *bptr, bl, i, j, rank, size; + int errs = 0; + + MTest_Init( 0, 0 ); + MPI_Comm_rank( MPI_COMM_WORLD, &rank ); + MPI_Comm_size( MPI_COMM_WORLD, &size ); + MPI_Buffer_attach( buf, BUFSIZE ); + + for (j=0; j<10; j++) { + MPI_Bsend_init( a, 10, MPI_INT, 0, 27+j, MPI_COMM_WORLD, &request ); + for (i=0; i<10; i++) { + a[i] = (rank + 10 * j) * size + i; + } + MPI_Start( &request ); + MPI_Wait( &request, &status ); + MPI_Request_free( &request ); + } + if (rank == 0) { + + for (i=0; i +#include "mpi.h" +#include "mpitest.h" + +#define BUFSIZE 2000 +int main( int argc, char *argv[] ) +{ + MPI_Status status; + MPI_Request request; + int a[10], b[10]; + int buf[BUFSIZE], *bptr, bl, i, j, rank, size, errs=0; + + MTest_Init( 0, 0 ); + MPI_Comm_rank( MPI_COMM_WORLD, &rank ); + MPI_Comm_size( MPI_COMM_WORLD, &size ); + MPI_Buffer_attach( buf, BUFSIZE ); + + for (j=0; j<10; j++) { + for (i=0; i<10; i++) { + a[i] = (rank + 10 * j) * size + i; + } + MPI_Ibsend( a, 10, MPI_INT, 0, 27+j, MPI_COMM_WORLD, &request ); + MPI_Wait( &request, &status ); + } + if (rank == 0) { + + for (i=0; i +#include "mpi.h" +#include "mpitest.h" + +#define BUFSIZE 2000 +int main( int argc, char *argv[] ) +{ + MPI_Status status; + MPI_Comm comm,scomm; + int a[10], b[10]; + int buf[BUFSIZE], *bptr, bl, i, j, rank, size, color, errs=0; + + MTest_Init( 0, 0 ); + MPI_Comm_rank( MPI_COMM_WORLD, &rank ); + color = rank % 2; + MPI_Comm_split( MPI_COMM_WORLD, color, rank, &scomm ); + MPI_Intercomm_create( scomm, 0, MPI_COMM_WORLD, 1-color, 52, &comm); + MPI_Comm_rank( comm, &rank ); + MPI_Comm_remote_size( comm, &size ); + MPI_Buffer_attach( buf, BUFSIZE ); + + for (j=0; j<10; j++) { + for (i=0; i<10; i++) { + a[i] = (rank + 10 * j) * size + i; + } + MPI_Bsend( a, 10, MPI_INT, 0, 27+j, comm ); + } + if (rank == 0) { + + for (i=0; i +#include "mpi.h" +#include "mpitest.h" + +/* Test bsend with a buffer with arbitray alignment */ +#define BUFSIZE 2000*4 +int main( int argc, char *argv[] ) +{ + MPI_Status status; + int a[10], b[10]; + int align; + char buf[BUFSIZE+8], *bptr; + int bl, i, j, rank, size; + int errs = 0; + + MTest_Init( 0, 0 ); + MPI_Comm_rank( MPI_COMM_WORLD, &rank ); + MPI_Comm_size( MPI_COMM_WORLD, &size ); + for (align = 0; align < 7; align++) { + MPI_Buffer_attach( buf+align, BUFSIZE); + + for (j=0; j<10; j++) { + for (i=0; i<10; i++) { + a[i] = (rank + 10 * j) * size + i; + } + MPI_Bsend( a, 10, MPI_INT, 0, 27+j, MPI_COMM_WORLD ); + } + if (rank == 0) { + + for (i=0; i +#include +#include "mpi.h" +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Test bsend message handling where \ +different messages are received in different orders"; +*/ + +/* + * Notes on the test. + * + * To ensure that messages remain in the bsend buffer until received, + * messages are sent with size MSG_SIZE (ints). + */ + +#define MSG_SIZE 17000 + +int main( int argc, char *argv[] ) +{ + int errs = 0; + int b1[MSG_SIZE], b2[MSG_SIZE], b3[MSG_SIZE], b4[MSG_SIZE]; + int src, dest, size, rank, i; + MPI_Comm comm; + MPI_Status status; + + MTest_Init( &argc, &argv ); + + MPI_Errhandler_set( MPI_COMM_WORLD, MPI_ERRORS_RETURN ); + + comm = MPI_COMM_WORLD; + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + + if (size < 2) { + errs++; + fprintf( stderr, "At least 2 processes required\n" ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + + src = 0; + dest = 1; + + if (rank == src) { + int *buf, bufsize, bsize; + + bufsize = 4 * (MSG_SIZE * sizeof(int) + MPI_BSEND_OVERHEAD); + buf = (int *)malloc( bufsize ); + if (!buf) { + fprintf( stderr, "Could not allocate buffer of %d bytes\n", + bufsize ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + MPI_Buffer_attach( buf, bufsize ); + + /* Initialize data */ + for (i=0; i +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Test the handling of BSend operations when a detach occurs before the bsend data has been sent."; +*/ + +int main( int argc, char *argv[] ) +{ + int errs = 0; + int rank, size, source, dest; + unsigned char *buf, *bufp; + int minsize = 2; + int i, msgsize, bufsize, outsize; + unsigned char *msg1, *msg2, *msg3; + MPI_Comm comm; + MPI_Status status1, status2, status3; + + MTest_Init( &argc, &argv ); + + /* The following illustrates the use of the routines to + run through a selection of communicators and datatypes. + Use subsets of these for tests that do not involve combinations + of communicators, datatypes, and counts of datatypes */ + msgsize = 128 * 1024; + msg1 = (unsigned char *)malloc( 3 * msgsize ); + msg2 = msg1 + msgsize; + msg3 = msg2 + msgsize; + while (MTestGetIntracommGeneral( &comm, minsize, 1 )) { + if (comm == MPI_COMM_NULL) continue; + /* Determine the sender and receiver */ + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + source = 0; + dest = size - 1; + + /* Here is the test: The sender */ + if (rank == source) { + /* Get a bsend buffer. Make it large enough that the Bsend + internals will (probably) not use a eager send for the data. + Have three such messages */ + bufsize = 3 * (MPI_BSEND_OVERHEAD + msgsize); + buf = (unsigned char *)malloc( bufsize ); + if (!buf) { + fprintf( stderr, "Unable to allocate a buffer of %d bytes\n", + bufsize ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + + MPI_Buffer_attach( buf, bufsize ); + + /* Initialize the buffers */ + for (i=0; i +#include +#include "mpitest.h" +#include /* For memset */ + +int main( int argc, char *argv[] ) +{ + MPI_Request r[3]; + MPI_Status s[3]; + int *buf0, *buf1, *buf2; + int rank, size, src, dest, flag, errs = 0; + int n0, n1, n2; + MPI_Comm comm; + + MTest_Init( &argc, &argv ); + + MPI_Comm_size( MPI_COMM_WORLD, &size ); + if (size < 2) { + fprintf( stderr, "Must run with at least 2 processes\n" ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + MPI_Comm_rank( MPI_COMM_WORLD, &rank ); + + dest = 0; + src = 1; + comm = MPI_COMM_WORLD; + + n0 = n1 = n2 = 65536; + buf0 = (int *)malloc( n0 * sizeof(int) ); + buf1 = (int *)malloc( n1 * sizeof(int) ); + buf2 = (int *)malloc( n2 * sizeof(int) ); + if (!buf0 || !buf1 || !buf2) { + fprintf( stderr, "Unable to allocate buffers of size %d\n", + n0 * (int)sizeof(int) ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + memset( buf0, -1, n0 * sizeof(int) ); + memset( buf1, -1, n0 * sizeof(int) ); + memset( buf2, -1, n0 * sizeof(int) ); + + if (rank == dest) { + MPI_Irecv( buf0, n0, MPI_INT, src, 0, comm, &r[0] ); + MPI_Irecv( buf1, n1, MPI_INT, src, 1, comm, &r[1] ); + MPI_Irecv( buf2, n2, MPI_INT, src, 2, comm, &r[2] ); + + MPI_Barrier( comm ); + + MPI_Cancel( &r[1] ); + MPI_Barrier( comm ); + memset( s, -1, sizeof(s) ); + MPI_Waitall( 3, r, s ); + MPI_Test_cancelled( &s[0], &flag ); + if (flag) { + errs++; + printf( "request 0 was cancelled!\n" ); + } + MPI_Test_cancelled( &s[1], &flag ); + if (!flag) { + errs++; + printf( "request 1 was not cancelled!\n" ); + } + MPI_Test_cancelled( &s[2], &flag ); + if (flag) { + errs++; + printf( "request 2 was cancelled!\n" ); + } + MPI_Barrier( comm ); + } + if (rank == src) { + int tflag; + MPI_Barrier( comm ); + MPI_Barrier( comm ); + MPI_Send( buf0, n0, MPI_INT, dest, 0, comm ); + MPI_Isend( buf2, n2, MPI_INT, dest, 2, comm, &r[1] ); + MPI_Isend( buf1, n1, MPI_INT, dest, 4, comm, &r[0] ); + MPI_Cancel( &r[0] ); + memset( s, -3, sizeof(s) ); + s[0].MPI_ERROR = -3; + s[1].MPI_ERROR = -3; + MPI_Testall( 2, r, &tflag, s ); + if (tflag) { + MPI_Test_cancelled( &s[0], &flag ); + if (!flag) { + errs++; + printf( "send request 0 was not cancelled!\n" ); + } + MPI_Test_cancelled( &s[1], &flag ); + if (flag) { + errs++; + printf( "send request 1 was cancelled!\n" ); + } + } + else { + /* If all requests are not complete, then neither r nor s + may be changed */ + if ( (s[0].MPI_ERROR) != -3) { + errs++; + printf( "Send request status 0 modified. s[0].MPI_ERROR = %x\n", + s[0].MPI_ERROR ); + } + if ( (s[1].MPI_ERROR) != -3) { + errs++; + printf( "Send request status 1 modified. s[1].MPI_ERROR = %x\n", + s[1].MPI_ERROR ); + } + } + MPI_Barrier( comm ); + while (!tflag) { + MPI_Testall( 2, r, &tflag, s ); + } + MPI_Test_cancelled( &s[0], &flag ); + if (!flag) { + errs++; + printf( "send request 0 was not cancelled!\n" ); + } + MPI_Test_cancelled( &s[1], &flag ); + if (flag) { + errs++; + printf( "send request 1 was cancelled!\n" ); + } + } + if (rank != src && rank != dest) { + MPI_Barrier( comm ); + MPI_Barrier( comm ); + MPI_Barrier( comm ); + } + + MTest_Finalize( errs ); + MPI_Finalize(); + + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/pt2pt/eagerdt.c b/teshsuite/smpi/mpich3-test/pt2pt/eagerdt.c new file mode 100644 index 0000000000..4adc26c124 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/pt2pt/eagerdt.c @@ -0,0 +1,77 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2006 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include "mpi.h" +#include +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Test of a large number of derived-datatype messages eagerly, with no preposted receive so that an MPI implementation may have to queue up messages on the sending side"; +*/ + +#define MAX_MSGS 30 + +int main( int argc, char *argv[] ) +{ + int errs = 0; + int rank, size, dest, source; + int i, indices[40]; + MPI_Aint extent; + int *buf, *bufs[MAX_MSGS]; + MPI_Comm comm; + MPI_Datatype dtype; + MPI_Request req[MAX_MSGS]; + + MTest_Init( &argc, &argv ); + + comm = MPI_COMM_WORLD; + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + source = 0; + dest = size - 1; + + /* Setup by creating a blocked datatype that is likely to be processed + in a piecemeal fashion */ + for (i=0; i<30; i++) { + indices[i] = i*40; + } + + /* 30 blocks of size 10 */ + MPI_Type_create_indexed_block( 30, 10, indices, MPI_INT, &dtype ); + MPI_Type_commit( &dtype ); + + /* Create the corresponding message buffers */ + MPI_Type_extent( dtype, &extent ); + for (i=0; i +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Simple test of generalized requests"; +*/ + + +int query_fn( void *extra_state, MPI_Status *status ); +int query_fn( void *extra_state, MPI_Status *status ) +{ + /* Set a default status */ + status->MPI_SOURCE = MPI_UNDEFINED; + status->MPI_TAG = MPI_UNDEFINED; + MPI_Status_set_cancelled( status, 0 ); + MPI_Status_set_elements( status, MPI_BYTE, 0 ); + return 0; +} +int free_fn( void *extra_state ); +int free_fn( void *extra_state ) +{ + int *b = (int *)extra_state; + if (b) *b = *b - 1; + /* The value returned by the free function is the error code + returned by the wait/test function */ + return 0; +} +int cancel_fn( void *extra_state, int complete ); +int cancel_fn( void *extra_state, int complete ) +{ + return 0; +} + +/* + * This is a very simple test of generalized requests. Normally, the + * MPI_Grequest_complete function would be called from another routine, + * often running in a separate thread. This simple code allows us to + * check that requests can be created, tested, and waited on in the + * case where the request is complete before the wait is called. + * + * Note that MPI did *not* define a routine that can be called within + * test or wait to advance the state of a generalized request. + * Most uses of generalized requests will need to use a separate thread. + */ +int main( int argc, char *argv[] ) +{ + int errs = 0; + int counter, flag; + MPI_Status status; + MPI_Request request; + + MTest_Init( &argc, &argv ); + + MPI_Grequest_start( query_fn, free_fn, cancel_fn, NULL, &request ); + + MPI_Test( &request, &flag, &status ); + if (flag) { + errs++; + fprintf( stderr, "Generalized request marked as complete\n" ); + } + + MPI_Grequest_complete( request ); + + MPI_Wait( &request, &status ); + + counter = 1; + MPI_Grequest_start( query_fn, free_fn, cancel_fn, &counter, &request ); + MPI_Grequest_complete( request ); + MPI_Wait( &request, MPI_STATUS_IGNORE ); + + if (counter) { + errs++; + fprintf( stderr, "Free routine not called, or not called with extra_data" ); + } + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/pt2pt/icsend.c b/teshsuite/smpi/mpich3-test/pt2pt/icsend.c new file mode 100644 index 0000000000..ae196ef438 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/pt2pt/icsend.c @@ -0,0 +1,72 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2003 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include "mpi.h" +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Simple test of intercommunicator send and receive"; +*/ + +int main( int argc, char *argv[] ) +{ + int errs = 0; + int leftGroup, buf, rank, remote_size, i; + MPI_Comm comm; + MPI_Status status; + + MTest_Init( &argc, &argv ); + + while (MTestGetIntercomm( &comm, &leftGroup, 4 )) { + if (comm == MPI_COMM_NULL) continue; + + if (leftGroup) { + MPI_Comm_rank( comm, &rank ); + buf = rank; + MPI_Send( &buf, 1, MPI_INT, 0, 0, comm ); + } + else { + MPI_Comm_remote_size( comm, &remote_size ); + MPI_Comm_rank( comm, &rank ); + if (rank == 0) { + for (i=0; i +#include +#include "mpitest.h" + +/* This test program checks that the point-to-point completion routines + can be applied to an inactive persistent request, as required by the + MPI-1 standard. See section 3.7.3, for example, + + One is allowed to call MPI TEST with a null or inactive request argument. + In such a case the operation returns with flag = true and empty status. + +*/ + +int StatusEmpty( MPI_Status *s ); +int StatusEmpty( MPI_Status *s ) +{ + int errs = 0; + int count = 10; + + if (s->MPI_TAG != MPI_ANY_TAG) { + errs++; + printf( "MPI_TAG not MPI_ANY_TAG in status\n" ); + } + if (s->MPI_SOURCE != MPI_ANY_SOURCE) { + errs++; + printf( "MPI_SOURCE not MPI_ANY_SOURCE in status\n" ); + } + MPI_Get_count( s, MPI_INT, &count ); + if (count != 0) { + errs++; + printf( "count in status is not 0\n" ); + } + /* Return true only if status passed all tests */ + return errs ? 0 : 1; +} + +int main(int argc, char *argv[]) +{ + MPI_Request r; + MPI_Status s; + int errs = 0; + int flag; + int buf[10]; + int rbuf[10]; + int tag = 27; + int dest = 0; + int rank, size; + + MTest_Init( &argc, &argv ); + + MPI_Comm_size( MPI_COMM_WORLD, &size ); + MPI_Comm_rank( MPI_COMM_WORLD, &rank ); + + /* Create a persistent send request */ + MPI_Send_init( buf, 10, MPI_INT, dest, tag, MPI_COMM_WORLD, &r ); + + flag = 0; + s.MPI_TAG = 10; + s.MPI_SOURCE = 10; + MPI_Test( &r, &flag, &s ); + if (!flag) { + errs++; + printf( "Flag not true after MPI_Test (send)\n" ); + printf( "Aborting further tests to avoid hanging in MPI_Wait\n" ); + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; + } + if (!StatusEmpty( &s )) { + errs++; + printf( "Status not empty after MPI_Test (send)\n" ); + } + + s.MPI_TAG = 10; + s.MPI_SOURCE = 10; + MPI_Wait( &r, &s ); + if (!StatusEmpty( &s )) { + errs++; + printf( "Status not empty after MPI_Wait (send)\n" ); + } + + /* Now try to use that request, then check again */ + if (rank == 0) { + int i; + MPI_Request *rr = (MPI_Request *)malloc(size * sizeof(MPI_Request)); + for (i=0; i +#include "mpi.h" +#include "mpitest.h" + +int main( int argc, char *argv[] ) +{ + int a[10], b[10], i; + MPI_Status status; + MPI_Request request; + int rank, count; + int errs = 0; + + + MTest_Init( &argc, &argv ); + + MPI_Comm_rank(MPI_COMM_WORLD, &rank); + + for (i=0; i<10; i++) a[i] = i+1; + + status.MPI_ERROR = 0; + MPI_Isend( a, 0, MPI_INT, rank, 0, MPI_COMM_WORLD, &request ); + MPI_Recv( b, 1, MPI_INT, MPI_ANY_SOURCE, MPI_ANY_TAG, MPI_COMM_WORLD, + &status ); + MPI_Get_count( &status, MPI_INT, &count ); + if (status.MPI_SOURCE != rank || + status.MPI_TAG != 0 || + status.MPI_ERROR != 0 || + count != 0) { + errs++; + printf ("1 status = %d %d %d %d\n", status.MPI_SOURCE, status.MPI_TAG, + status.MPI_ERROR, count ); + } + /* printf( "b[0] = %d\n", b[0] );*/ + MPI_Wait( &request, &status ); + + MPI_Isend( 0, 0, MPI_INT, rank, 0, MPI_COMM_WORLD, &request ); + MPI_Recv( 0, 0, MPI_INT, MPI_ANY_SOURCE, MPI_ANY_TAG, MPI_COMM_WORLD, + &status ); + MPI_Get_count( &status, MPI_INT, &count ); + if (status.MPI_SOURCE != rank || + status.MPI_TAG != 0 || + status.MPI_ERROR != 0 || + count != 0) { + errs++; + printf ("2 status = %d %d %d %d\n", status.MPI_SOURCE, status.MPI_TAG, + status.MPI_ERROR, count ); + } + MPI_Wait( &request, &status ); + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/pt2pt/isendselfprobe.c b/teshsuite/smpi/mpich3-test/pt2pt/isendselfprobe.c new file mode 100644 index 0000000000..1b3c6c051b --- /dev/null +++ b/teshsuite/smpi/mpich3-test/pt2pt/isendselfprobe.c @@ -0,0 +1,47 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2001 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include +#include "mpi.h" +#include "mpitest.h" + +int main( int argc, char * argv[] ) +{ + int rank; + int sendMsg = 123; + int recvMsg = 0; + int flag = 0; + int count; + MPI_Status status; + MPI_Request request; + int errs = 0; + + MTest_Init( &argc, &argv ); + + MPI_Comm_rank(MPI_COMM_WORLD, &rank); + + if(rank == 0) + { + MPI_Isend( &sendMsg, 1, MPI_INT, 0, 0, MPI_COMM_WORLD, &request ); + while(!flag) + { + MPI_Iprobe( 0, 0, MPI_COMM_WORLD, &flag, &status ); + } + MPI_Get_count( &status, MPI_INT, &count ); + if(count != 1) + { + errs++; + } + MPI_Recv( &recvMsg, 1, MPI_INT, 0, 0, MPI_COMM_WORLD, &status ); + if(recvMsg != 123) + { + errs++; + } + MPI_Wait( &request, &status ); + } + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/pt2pt/large_message.c b/teshsuite/smpi/mpich3-test/pt2pt/large_message.c new file mode 100644 index 0000000000..db3d2755cb --- /dev/null +++ b/teshsuite/smpi/mpich3-test/pt2pt/large_message.c @@ -0,0 +1,69 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2010 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include +#include +#include +#include "mpitest.h" + +/* tests send/recv of a message > 2GB. count=270M, type=long long + run with 3 processes to exercise both shared memory and TCP in Nemesis tests*/ + +int main(int argc, char *argv[]) +{ + int ierr,i,size,rank; + int cnt = 270000000; + MPI_Status status; + long long *cols; + int errs = 0; + + + MTest_Init(&argc,&argv); + +/* need large memory */ + if (sizeof(void *) < 8) { + MTest_Finalize(errs); + MPI_Finalize(); + return 0; + } + + ierr = MPI_Comm_size(MPI_COMM_WORLD,&size); + ierr = MPI_Comm_rank(MPI_COMM_WORLD,&rank); + if (size != 3) { + fprintf(stderr,"[%d] usage: mpiexec -n 3 %s\n",rank,argv[0]); + MPI_Abort(MPI_COMM_WORLD,1); + } + + cols = malloc(cnt*sizeof(long long)); + if (cols == NULL) { + printf("malloc of >2GB array failed\n"); + errs++; + MTest_Finalize(errs); + MPI_Finalize(); + return 0; + } + + if (rank == 0) { + for (i=0; i +#include +#include +#include "mpi.h" +#include "mpitest.h" + +/* This is a temporary #ifdef to control whether we test this functionality. A + * configure-test or similar would be better. Eventually the MPI-3 standard + * will be released and this can be gated on a MPI_VERSION check */ +#if !defined(USE_STRICT_MPI) && defined(MPICH) +#define TEST_MPROBE_ROUTINES 1 +#endif + +/* 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 found, completed; + int rank, size; + int sendbuf[8], recvbuf[8]; + int count; +#ifdef TEST_MPROBE_ROUTINES + MPI_Message msg; +#endif + MPI_Request rreq; + MPI_Status s1, s2; + + MPI_Init(&argc, &argv); + + MPI_Comm_rank(MPI_COMM_WORLD, &rank); + MPI_Comm_size(MPI_COMM_WORLD, &size); + + if (size < 2) { + printf("this test requires at least 2 processes\n"); + MPI_Abort(MPI_COMM_WORLD, 1); + } + + /* all processes besides ranks 0 & 1 aren't used by this test */ + if (rank >= 2) { + goto epilogue; + } + +#ifdef TEST_MPROBE_ROUTINES + /* test 0: simple send & mprobe+mrecv */ + if (rank == 0) { + sendbuf[0] = 0xdeadbeef; + sendbuf[1] = 0xfeedface; + MPI_Send(sendbuf, 2, MPI_INT, 1, 5, MPI_COMM_WORLD); + } + else { + memset(&s1, 0xab, sizeof(MPI_Status)); + memset(&s2, 0xab, sizeof(MPI_Status)); + /* the error field should remain unmodified */ + s1.MPI_ERROR = MPI_ERR_DIMS; + s2.MPI_ERROR = MPI_ERR_TOPOLOGY; + + msg = MPI_MESSAGE_NULL; + MPI_Mprobe(0, 5, MPI_COMM_WORLD, &msg, &s1); + check(s1.MPI_SOURCE == 0); + check(s1.MPI_TAG == 5); + check(s1.MPI_ERROR == MPI_ERR_DIMS); + check(msg != MPI_MESSAGE_NULL); + + count = -1; + MPI_Get_count(&s1, MPI_INT, &count); + check(count == 2); + + recvbuf[0] = 0x01234567; + recvbuf[1] = 0x89abcdef; + MPI_Mrecv(recvbuf, count, MPI_INT, &msg, &s2); + check(recvbuf[0] == 0xdeadbeef); + check(recvbuf[1] == 0xfeedface); + check(s2.MPI_SOURCE == 0); + check(s2.MPI_TAG == 5); + check(s2.MPI_ERROR == MPI_ERR_TOPOLOGY); + check(msg == MPI_MESSAGE_NULL); + } + + /* test 1: simple send & mprobe+imrecv */ + if (rank == 0) { + sendbuf[0] = 0xdeadbeef; + sendbuf[1] = 0xfeedface; + MPI_Send(sendbuf, 2, MPI_INT, 1, 5, MPI_COMM_WORLD); + } + else { + memset(&s1, 0xab, sizeof(MPI_Status)); + memset(&s2, 0xab, sizeof(MPI_Status)); + /* the error field should remain unmodified */ + s1.MPI_ERROR = MPI_ERR_DIMS; + s2.MPI_ERROR = MPI_ERR_TOPOLOGY; + + msg = MPI_MESSAGE_NULL; + MPI_Mprobe(0, 5, MPI_COMM_WORLD, &msg, &s1); + check(s1.MPI_SOURCE == 0); + check(s1.MPI_TAG == 5); + check(s1.MPI_ERROR == MPI_ERR_DIMS); + check(msg != MPI_MESSAGE_NULL); + + count = -1; + MPI_Get_count(&s1, MPI_INT, &count); + check(count == 2); + + rreq = MPI_REQUEST_NULL; + recvbuf[0] = 0x01234567; + recvbuf[1] = 0x89abcdef; + MPI_Imrecv(recvbuf, count, MPI_INT, &msg, &rreq); + check(rreq != MPI_REQUEST_NULL); + MPI_Wait(&rreq, &s2); + check(recvbuf[0] == 0xdeadbeef); + check(recvbuf[1] == 0xfeedface); + check(s2.MPI_SOURCE == 0); + check(s2.MPI_TAG == 5); + check(s2.MPI_ERROR == MPI_ERR_TOPOLOGY); + check(msg == MPI_MESSAGE_NULL); + } + + /* test 2: simple send & improbe+mrecv */ + if (rank == 0) { + sendbuf[0] = 0xdeadbeef; + sendbuf[1] = 0xfeedface; + MPI_Send(sendbuf, 2, MPI_INT, 1, 5, MPI_COMM_WORLD); + } + else { + memset(&s1, 0xab, sizeof(MPI_Status)); + memset(&s2, 0xab, sizeof(MPI_Status)); + /* the error field should remain unmodified */ + s1.MPI_ERROR = MPI_ERR_DIMS; + s2.MPI_ERROR = MPI_ERR_TOPOLOGY; + + msg = MPI_MESSAGE_NULL; + do { + check(msg == MPI_MESSAGE_NULL); + MPI_Improbe(0, 5, MPI_COMM_WORLD, &found, &msg, &s1); + } while (!found); + check(msg != MPI_MESSAGE_NULL); + check(s1.MPI_SOURCE == 0); + check(s1.MPI_TAG == 5); + check(s1.MPI_ERROR == MPI_ERR_DIMS); + + count = -1; + MPI_Get_count(&s1, MPI_INT, &count); + check(count == 2); + + recvbuf[0] = 0x01234567; + recvbuf[1] = 0x89abcdef; + MPI_Mrecv(recvbuf, count, MPI_INT, &msg, &s2); + check(recvbuf[0] == 0xdeadbeef); + check(recvbuf[1] == 0xfeedface); + check(s2.MPI_SOURCE == 0); + check(s2.MPI_TAG == 5); + check(s2.MPI_ERROR == MPI_ERR_TOPOLOGY); + check(msg == MPI_MESSAGE_NULL); + } + + /* test 3: simple send & improbe+imrecv */ + if (rank == 0) { + sendbuf[0] = 0xdeadbeef; + sendbuf[1] = 0xfeedface; + MPI_Send(sendbuf, 2, MPI_INT, 1, 5, MPI_COMM_WORLD); + } + else { + memset(&s1, 0xab, sizeof(MPI_Status)); + memset(&s2, 0xab, sizeof(MPI_Status)); + /* the error field should remain unmodified */ + s1.MPI_ERROR = MPI_ERR_DIMS; + s2.MPI_ERROR = MPI_ERR_TOPOLOGY; + + msg = MPI_MESSAGE_NULL; + do { + check(msg == MPI_MESSAGE_NULL); + MPI_Improbe(0, 5, MPI_COMM_WORLD, &found, &msg, &s1); + } while (!found); + check(msg != MPI_MESSAGE_NULL); + check(s1.MPI_SOURCE == 0); + check(s1.MPI_TAG == 5); + check(s1.MPI_ERROR == MPI_ERR_DIMS); + + count = -1; + MPI_Get_count(&s1, MPI_INT, &count); + check(count == 2); + + rreq = MPI_REQUEST_NULL; + MPI_Imrecv(recvbuf, count, MPI_INT, &msg, &rreq); + check(rreq != MPI_REQUEST_NULL); + MPI_Wait(&rreq, &s2); + check(recvbuf[0] == 0xdeadbeef); + check(recvbuf[1] == 0xfeedface); + check(s2.MPI_SOURCE == 0); + check(s2.MPI_TAG == 5); + check(s2.MPI_ERROR == MPI_ERR_TOPOLOGY); + check(msg == MPI_MESSAGE_NULL); + } + + /* test 4: mprobe+mrecv with MPI_PROC_NULL */ + { + memset(&s1, 0xab, sizeof(MPI_Status)); + memset(&s2, 0xab, sizeof(MPI_Status)); + /* the error field should remain unmodified */ + s1.MPI_ERROR = MPI_ERR_DIMS; + s2.MPI_ERROR = MPI_ERR_TOPOLOGY; + + msg = MPI_MESSAGE_NULL; + MPI_Mprobe(MPI_PROC_NULL, 5, MPI_COMM_WORLD, &msg, &s1); + check(s1.MPI_SOURCE == MPI_PROC_NULL); + check(s1.MPI_TAG == MPI_ANY_TAG); + check(s1.MPI_ERROR == MPI_ERR_DIMS); + check(msg == MPI_MESSAGE_NO_PROC); + + count = -1; + MPI_Get_count(&s1, MPI_INT, &count); + check(count == 0); + + recvbuf[0] = 0x01234567; + recvbuf[1] = 0x89abcdef; + MPI_Mrecv(recvbuf, count, MPI_INT, &msg, &s2); + /* recvbuf should remain unmodified */ + check(recvbuf[0] == 0x01234567); + check(recvbuf[1] == 0x89abcdef); + /* should get back "proc null status" */ + check(s2.MPI_SOURCE == MPI_PROC_NULL); + check(s2.MPI_TAG == MPI_ANY_TAG); + check(s2.MPI_ERROR == MPI_ERR_TOPOLOGY); + check(msg == MPI_MESSAGE_NULL); + count = -1; + MPI_Get_count(&s2, MPI_INT, &count); + check(count == 0); + } + + /* test 5: mprobe+imrecv with MPI_PROC_NULL */ + { + memset(&s1, 0xab, sizeof(MPI_Status)); + memset(&s2, 0xab, sizeof(MPI_Status)); + /* the error field should remain unmodified */ + s1.MPI_ERROR = MPI_ERR_DIMS; + s2.MPI_ERROR = MPI_ERR_TOPOLOGY; + + msg = MPI_MESSAGE_NULL; + MPI_Mprobe(MPI_PROC_NULL, 5, MPI_COMM_WORLD, &msg, &s1); + check(s1.MPI_SOURCE == MPI_PROC_NULL); + check(s1.MPI_TAG == MPI_ANY_TAG); + check(s1.MPI_ERROR == MPI_ERR_DIMS); + check(msg == MPI_MESSAGE_NO_PROC); + count = -1; + MPI_Get_count(&s1, MPI_INT, &count); + check(count == 0); + + rreq = MPI_REQUEST_NULL; + recvbuf[0] = 0x01234567; + recvbuf[1] = 0x89abcdef; + MPI_Imrecv(recvbuf, count, MPI_INT, &msg, &rreq); + check(rreq != MPI_REQUEST_NULL); + completed = 0; + MPI_Test(&rreq, &completed, &s2); /* single test should always succeed */ + check(completed); + /* recvbuf should remain unmodified */ + check(recvbuf[0] == 0x01234567); + check(recvbuf[1] == 0x89abcdef); + /* should get back "proc null status" */ + check(s2.MPI_SOURCE == MPI_PROC_NULL); + check(s2.MPI_TAG == MPI_ANY_TAG); + check(s2.MPI_ERROR == MPI_ERR_TOPOLOGY); + check(msg == MPI_MESSAGE_NULL); + count = -1; + MPI_Get_count(&s2, MPI_INT, &count); + check(count == 0); + } + + /* test 6: improbe+mrecv with MPI_PROC_NULL */ + { + memset(&s1, 0xab, sizeof(MPI_Status)); + memset(&s2, 0xab, sizeof(MPI_Status)); + /* the error field should remain unmodified */ + s1.MPI_ERROR = MPI_ERR_DIMS; + s2.MPI_ERROR = MPI_ERR_TOPOLOGY; + + msg = MPI_MESSAGE_NULL; + found = 0; + MPI_Improbe(MPI_PROC_NULL, 5, MPI_COMM_WORLD, &found, &msg, &s1); + check(found); + check(msg == MPI_MESSAGE_NO_PROC); + check(s1.MPI_SOURCE == MPI_PROC_NULL); + check(s1.MPI_TAG == MPI_ANY_TAG); + check(s1.MPI_ERROR == MPI_ERR_DIMS); + count = -1; + MPI_Get_count(&s1, MPI_INT, &count); + check(count == 0); + + recvbuf[0] = 0x01234567; + recvbuf[1] = 0x89abcdef; + MPI_Mrecv(recvbuf, count, MPI_INT, &msg, &s2); + /* recvbuf should remain unmodified */ + check(recvbuf[0] == 0x01234567); + check(recvbuf[1] == 0x89abcdef); + /* should get back "proc null status" */ + check(s2.MPI_SOURCE == MPI_PROC_NULL); + check(s2.MPI_TAG == MPI_ANY_TAG); + check(s2.MPI_ERROR == MPI_ERR_TOPOLOGY); + check(msg == MPI_MESSAGE_NULL); + count = -1; + MPI_Get_count(&s2, MPI_INT, &count); + check(count == 0); + } + + /* test 7: improbe+imrecv */ + { + memset(&s1, 0xab, sizeof(MPI_Status)); + memset(&s2, 0xab, sizeof(MPI_Status)); + /* the error field should remain unmodified */ + s1.MPI_ERROR = MPI_ERR_DIMS; + s2.MPI_ERROR = MPI_ERR_TOPOLOGY; + + msg = MPI_MESSAGE_NULL; + MPI_Improbe(MPI_PROC_NULL, 5, MPI_COMM_WORLD, &found, &msg, &s1); + check(found); + check(msg == MPI_MESSAGE_NO_PROC); + check(s1.MPI_SOURCE == MPI_PROC_NULL); + check(s1.MPI_TAG == MPI_ANY_TAG); + check(s1.MPI_ERROR == MPI_ERR_DIMS); + count = -1; + MPI_Get_count(&s1, MPI_INT, &count); + check(count == 0); + + rreq = MPI_REQUEST_NULL; + MPI_Imrecv(recvbuf, count, MPI_INT, &msg, &rreq); + check(rreq != MPI_REQUEST_NULL); + completed = 0; + MPI_Test(&rreq, &completed, &s2); /* single test should always succeed */ + check(completed); + /* recvbuf should remain unmodified */ + check(recvbuf[0] == 0x01234567); + check(recvbuf[1] == 0x89abcdef); + /* should get back "proc null status" */ + check(s2.MPI_SOURCE == MPI_PROC_NULL); + check(s2.MPI_TAG == MPI_ANY_TAG); + check(s2.MPI_ERROR == MPI_ERR_TOPOLOGY); + check(msg == MPI_MESSAGE_NULL); + count = -1; + MPI_Get_count(&s2, MPI_INT, &count); + check(count == 0); + } + + /* TODO MPI_ANY_SOURCE and MPI_ANY_TAG should be tested as well */ + /* TODO a full range of message sizes should be tested too */ + /* TODO threaded tests are also needed, but they should go in a separate + * program */ + + /* simple test to ensure that c2f/f2c routines are present (initially missed + * in MPICH impl) */ + { + MPI_Fint f_handle = 0xdeadbeef; + f_handle = MPI_Message_c2f(MPI_MESSAGE_NULL); + msg = MPI_Message_f2c(f_handle); + check(f_handle != 0xdeadbeef); + check(msg == MPI_MESSAGE_NULL); + + /* PMPI_ versions should also exists */ + f_handle = 0xdeadbeef; + f_handle = PMPI_Message_c2f(MPI_MESSAGE_NULL); + msg = PMPI_Message_f2c(f_handle); + check(f_handle != 0xdeadbeef); + check(msg == MPI_MESSAGE_NULL); + } + +#endif /* TEST_MPROBE_ROUTINES */ + +epilogue: + MPI_Reduce((rank == 0 ? MPI_IN_PLACE : &errs), &errs, 1, MPI_INT, MPI_SUM, 0, MPI_COMM_WORLD); + if (rank == 0) { + if (errs) { + printf("found %d errors\n", errs); + } + else { + printf(" No errors\n"); + } + } + + MPI_Finalize(); + + return 0; +} + diff --git a/teshsuite/smpi/mpich3-test/pt2pt/pingping.c b/teshsuite/smpi/mpich3-test/pt2pt/pingping.c new file mode 100644 index 0000000000..95f6e397ef --- /dev/null +++ b/teshsuite/smpi/mpich3-test/pt2pt/pingping.c @@ -0,0 +1,111 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2003 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include "mpi.h" +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Send flood test"; +*/ + +#define MAX_MSG_SIZE 40000000 +#define MAX_COUNT 4000 +int main( int argc, char *argv[] ) +{ + int errs = 0, err; + int rank, size, source, dest; + int minsize = 2, count, nmsg, maxmsg; + MPI_Comm comm; + MTestDatatype sendtype, recvtype; + + MTest_Init( &argc, &argv ); + + /* The following illustrates the use of the routines to + run through a selection of communicators and datatypes. + Use subsets of these for tests that do not involve combinations + of communicators, datatypes, and counts of datatypes */ + while (MTestGetIntracommGeneral( &comm, minsize, 1 )) { + if (comm == MPI_COMM_NULL) continue; + /* Determine the sender and receiver */ + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + source = 0; + dest = size - 1; + + /* To improve reporting of problems about operations, we + change the error handler to errors return */ + MPI_Comm_set_errhandler( comm, MPI_ERRORS_RETURN ); + + for (count = 1; count < MAX_COUNT; count = count * 2) { + while (MTestGetDatatypes( &sendtype, &recvtype, count )) { + int nbytes; + MPI_Type_size( sendtype.datatype, &nbytes ); + + /* We may want to limit the total message size sent */ + if (nbytes > MAX_MSG_SIZE) { + /* We do not need to free, as we haven't + initialized any of the buffers (?) */ + continue; + } + maxmsg = MAX_COUNT - count; + MTestPrintfMsg( 1, "Sending count = %d of sendtype %s of total size %d bytes\n", + count, MTestGetDatatypeName( &sendtype ), + nbytes*count ); + /* Make sure that everyone has a recv buffer */ + recvtype.InitBuf( &recvtype ); + + if (rank == source) { + sendtype.InitBuf( &sendtype ); + + for (nmsg=1; nmsg +#include "mpi.h" +#include "mpitest.h" + +#define MAX_BUF_SIZE_LG 22 +#define NUM_MSGS_PER_BUF_SIZE 5 +char buf[1 << MAX_BUF_SIZE_LG]; + +/* + * This program verifies that MPI_Probe() is operating properly in the face of + * unexpected messages arriving after MPI_Probe() has + * been called. This program may hang if MPI_Probe() does not return when the + * message finally arrives (see req #375). + */ +int main(int argc, char **argv) +{ + int p_size; + int p_rank; + int msg_size_lg; + int errs = 0; + int mpi_errno; + + MTest_Init(&argc, &argv); + + MPI_Comm_size(MPI_COMM_WORLD, &p_size); + MPI_Comm_rank(MPI_COMM_WORLD, &p_rank); + /* 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 ); + + + for (msg_size_lg = 0; msg_size_lg <= MAX_BUF_SIZE_LG; msg_size_lg++) + { + const int msg_size = 1 << msg_size_lg; + int msg_cnt; + + MTestPrintfMsg( 2, "testing messages of size %d\n", msg_size ); + for (msg_cnt = 0; msg_cnt < NUM_MSGS_PER_BUF_SIZE; msg_cnt++) + { + MPI_Status status; + const int tag = msg_size_lg * NUM_MSGS_PER_BUF_SIZE + msg_cnt; + + MTestPrintfMsg( 2, "Message count %d\n", msg_cnt ); + if (p_rank == 0) + { + int p; + + for (p = 1; p < p_size; p ++) + { + /* Wait for synchronization message */ + mpi_errno = MPI_Recv(NULL, 0, MPI_BYTE, MPI_ANY_SOURCE, + tag, MPI_COMM_WORLD, &status); + if (mpi_errno != MPI_SUCCESS && errs++ < 10) + { + MTestPrintError(mpi_errno); + } + + if (status.MPI_TAG != tag && errs++ < 10) + { + printf("ERROR: unexpected message tag from MPI_Recv(): lp=0, rp=%d, expected=%d, actual=%d, count=%d\n", + status.MPI_SOURCE, status.MPI_TAG, tag, msg_cnt); + } + +# if defined(VERBOSE) + { + printf("sending message: p=%d s=%d c=%d\n", + status.MPI_SOURCE, msg_size, msg_cnt); + } +# endif + + /* Send unexpected message which hopefully MPI_Probe() is + already waiting for at the remote process */ + mpi_errno = MPI_Send (buf, msg_size, MPI_BYTE, + status.MPI_SOURCE, status.MPI_TAG, MPI_COMM_WORLD); + if (mpi_errno != MPI_SUCCESS && errs++ < 10) + { + MTestPrintError(mpi_errno); + } + } + } + else + { + int incoming_msg_size; + + /* Send synchronization message */ + mpi_errno = MPI_Send(NULL, 0, MPI_BYTE, 0, tag, MPI_COMM_WORLD); + if (mpi_errno != MPI_SUCCESS && errs++ < 10) + { + MTestPrintError(mpi_errno); + } + + /* Perform probe, hopefully before the master process can + send its reply */ + mpi_errno = MPI_Probe(MPI_ANY_SOURCE, MPI_ANY_TAG, + MPI_COMM_WORLD, &status); + if (mpi_errno != MPI_SUCCESS && errs++ < 10) + { + MTestPrintError(mpi_errno); + } + mpi_errno = MPI_Get_count(&status, MPI_BYTE, &incoming_msg_size); + if (mpi_errno != MPI_SUCCESS && errs++ < 10) + { + MTestPrintError(mpi_errno); + } + if (status.MPI_SOURCE != 0 && errs++ < 10) + { + printf("ERROR: unexpected message source from MPI_Probe(): p=%d, expected=0, actual=%d, count=%d\n", + p_rank, status.MPI_SOURCE, msg_cnt); + } + if (status.MPI_TAG != tag && errs++ < 10) + { + printf("ERROR: unexpected message tag from MPI_Probe(): p=%d, expected=%d, actual=%d, count=%d\n", + p_rank, tag, status.MPI_TAG, msg_cnt); + } + if (incoming_msg_size != msg_size && errs++ < 10) + { + printf("ERROR: unexpected message size from MPI_Probe(): p=%d, expected=%d, actual=%d, count=%d\n", + p_rank, msg_size, incoming_msg_size, msg_cnt); + } + + /* Receive the probed message from the master process */ + mpi_errno = MPI_Recv(buf, msg_size, MPI_BYTE, 0, tag, + MPI_COMM_WORLD, &status); + if (mpi_errno != MPI_SUCCESS && errs++ < 10) + { + MTestPrintError(mpi_errno); + } + mpi_errno = MPI_Get_count(&status, MPI_BYTE, &incoming_msg_size); + if (mpi_errno != MPI_SUCCESS && errs++ < 10) + { + MTestPrintError(mpi_errno); + } + if (status.MPI_SOURCE != 0 && errs++ < 10) + { + printf("ERROR: unexpected message source from MPI_Recv(): p=%d, expected=0, actual=%d, count=%d\n", + p_rank, status.MPI_SOURCE, msg_cnt); + } + if (status.MPI_TAG != tag && errs++ < 10) + { + printf("ERROR: unexpected message tag from MPI_Recv(): p=%d, expected=%d, actual=%d, count=%d\n", + p_rank, tag, status.MPI_TAG, msg_cnt); + } + if (incoming_msg_size != msg_size && errs++ < 10) + { + printf("ERROR: unexpected message size from MPI_Recv(): p=%d, expected=%d, actual=%d, count=%d\n", + p_rank, msg_size, incoming_msg_size, msg_cnt); + } + } + } + } + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/pt2pt/probenull.c b/teshsuite/smpi/mpich3-test/pt2pt/probenull.c new file mode 100644 index 0000000000..547960522e --- /dev/null +++ b/teshsuite/smpi/mpich3-test/pt2pt/probenull.c @@ -0,0 +1,59 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2005 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include +#include "mpi.h" +#include "mpitest.h" + +/* + * This program checks that MPI_Iprobe and MPI_Probe correctly handle + * a source of MPI_PROC_NULL + */ + +int main(int argc, char **argv) +{ + int flag; + int errs = 0; + MPI_Status status; + + MTest_Init(&argc, &argv); + + MPI_Iprobe( MPI_PROC_NULL, 10, MPI_COMM_WORLD, &flag, &status ); + if (!flag) { + errs++; + printf( "Iprobe of source=MPI_PROC_NULL returned flag=false\n" ); + } + else { + if (status.MPI_SOURCE != MPI_PROC_NULL) { + printf( "Status.MPI_SOURCE was %d, should be MPI_PROC_NULL\n", + status.MPI_SOURCE ); + errs++; + } + if (status.MPI_TAG != MPI_ANY_TAG) { + printf( "Status.MPI_TAG was %d, should be MPI_ANY_TAGL\n", + status.MPI_TAG ); + errs++; + } + } + /* If Iprobe failed, probe is likely to as well. Avoid a possible hang + by testing Probe only if Iprobe test passed */ + if (errs == 0) { + MPI_Probe( MPI_PROC_NULL, 10, MPI_COMM_WORLD, &status ); + if (status.MPI_SOURCE != MPI_PROC_NULL) { + printf( "Status.MPI_SOURCE was %d, should be MPI_PROC_NULL\n", + status.MPI_SOURCE ); + errs++; + } + if (status.MPI_TAG != MPI_ANY_TAG) { + printf( "Status.MPI_TAG was %d, should be MPI_ANY_TAGL\n", + status.MPI_TAG ); + errs++; + } + } + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/pt2pt/pscancel.c b/teshsuite/smpi/mpich3-test/pt2pt/pscancel.c new file mode 100644 index 0000000000..49714c9743 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/pt2pt/pscancel.c @@ -0,0 +1,273 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2003 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include "mpi.h" +#include +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Test of various send cancel calls"; +*/ + +int main( int argc, char *argv[] ) +{ + int errs = 0; + int rank, size, source, dest; + MPI_Comm comm; + MPI_Status status; + MPI_Request req; + static int bufsizes[4] = { 1, 100, 10000, 1000000 }; + char *buf; + int cs, flag, n; +#ifdef TEST_IRSEND + int veryPicky = 0; /* Set to 1 to test "quality of implementation" in + a tricky part of cancel */ +#endif + + MTest_Init( &argc, &argv ); + + comm = MPI_COMM_WORLD; + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + + source = 0; + dest = size - 1; + + for (cs=0; cs<4; cs++) { + if (rank == 0) { + n = bufsizes[cs]; + buf = (char *)malloc( n ); + if (!buf) { + fprintf( stderr, "Unable to allocate %d bytes\n", n ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + MPI_Send_init( buf, n, MPI_CHAR, dest, cs+n+1, comm, &req ); + MPI_Start( &req ); + MPI_Cancel( &req ); + MPI_Wait( &req, &status ); + MPI_Test_cancelled( &status, &flag ); + if (!flag) { + errs ++; + printf( "Failed to cancel a persistent send request\n" ); + fflush(stdout); + } + else + { + n = 0; + } + MPI_Request_free( &req ); + /* Send the size, zero for successfully cancelled */ + MPI_Send( &n, 1, MPI_INT, dest, 123, comm ); + /* Send the tag so the message can be received */ + n = cs+n+1; + MPI_Send( &n, 1, MPI_INT, dest, 123, comm ); + free( buf ); + } + else if (rank == dest) + { + int nn, tag; + char *btemp; + MPI_Recv( &nn, 1, MPI_INT, 0, 123, comm, &status ); + MPI_Recv( &tag, 1, MPI_INT, 0, 123, comm, &status ); + if (nn > 0) + { + /* If the message was not cancelled, receive it here */ + btemp = (char*)malloc( nn ); + if (!btemp) + { + fprintf( stderr, "Unable to allocate %d bytes\n", nn); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + MPI_Recv( btemp, nn, MPI_CHAR, 0, tag, comm, &status ); + free(btemp); + } + } + MPI_Barrier( comm ); + + if (rank == 0) { + char *bsendbuf; + int bsendbufsize; + int bf, bs; + n = bufsizes[cs]; + buf = (char *)malloc( n ); + if (!buf) { + fprintf( stderr, "Unable to allocate %d bytes\n", n ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + bsendbufsize = n + MPI_BSEND_OVERHEAD; + bsendbuf = (char *)malloc( bsendbufsize ); + if (!bsendbuf) { + fprintf( stderr, "Unable to allocate %d bytes for bsend\n", n ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + MPI_Buffer_attach( bsendbuf, bsendbufsize ); + MPI_Bsend_init( buf, n, MPI_CHAR, dest, cs+n+2, comm, &req ); + MPI_Start( &req ); + MPI_Cancel( &req ); + MPI_Wait( &req, &status ); + MPI_Test_cancelled( &status, &flag ); + if (!flag) { + errs ++; + printf( "Failed to cancel a persistent bsend request\n" ); + fflush(stdout); + } + else + { + n = 0; + } + MPI_Request_free( &req ); + /* Send the size, zero for successfully cancelled */ + MPI_Send( &n, 1, MPI_INT, dest, 123, comm ); + /* Send the tag so the message can be received */ + n = cs+n+2; + MPI_Send( &n, 1, MPI_INT, dest, 123, comm ); + free( buf ); + MPI_Buffer_detach( &bf, &bs ); + free( bsendbuf ); + } + else if (rank == dest) + { + int nn, tag; + char *btemp; + MPI_Recv( &nn, 1, MPI_INT, 0, 123, comm, &status ); + MPI_Recv( &tag, 1, MPI_INT, 0, 123, comm, &status ); + if (nn > 0) + { + /* If the message was not cancelled, receive it here */ + btemp = (char*)malloc( nn ); + if (!btemp) + { + fprintf( stderr, "Unable to allocate %d bytes\n", nn); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + MPI_Recv( btemp, nn, MPI_CHAR, 0, tag, comm, &status ); + free(btemp); + } + } + MPI_Barrier( comm ); + + /* Because this test is erroneous, we do not perform it unless + TEST_IRSEND is defined. */ +#ifdef TEST_IRSEND + /* We avoid ready send to self because an implementation + is free to detect the error in delivering a message to + itself without a pending receive; we could also check + for an error return from the MPI_Irsend */ + if (rank == 0 && dest != rank) { + n = bufsizes[cs]; + buf = (char *)malloc( n ); + if (!buf) { + fprintf( stderr, "Unable to allocate %d bytes\n", n ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + MPI_Rsend_init( buf, n, MPI_CHAR, dest, cs+n+3, comm, &req ); + MPI_Start( &req ); + MPI_Cancel( &req ); + MPI_Wait( &req, &status ); + MPI_Test_cancelled( &status, &flag ); + /* This can be pretty ugly. The standard is clear (Section 3.8) + that either a sent message is received or the + sent message is successfully cancelled. Since this message + can never be received, the cancel must complete + successfully. + + However, since there is no matching receive, this + program is erroneous. In this case, we can't really + flag this as an error */ + if (!flag && veryPicky) { + errs ++; + printf( "Failed to cancel a persistent rsend request\n" ); + fflush(stdout); + } + if (flag) + { + n = 0; + } + MPI_Request_free( &req ); + /* Send the size, zero for successfully cancelled */ + MPI_Send( &n, 1, MPI_INT, dest, 123, comm ); + /* Send the tag so the message can be received */ + n = cs+n+3; + MPI_Send( &n, 1, MPI_INT, dest, 123, comm ); + free( buf ); + } + else if (rank == dest) + { + int n, tag; + char *btemp; + MPI_Recv( &n, 1, MPI_INT, 0, 123, comm, &status ); + MPI_Recv( &tag, 1, MPI_INT, 0, 123, comm, &status ); + if (n > 0) + { + /* If the message was not cancelled, receive it here */ + btemp = (char*)malloc( n ); + if (!btemp) + { + fprintf( stderr, "Unable to allocate %d bytes\n", n); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + MPI_Recv( btemp, n, MPI_CHAR, 0, tag, comm, &status ); + free(btemp); + } + } + MPI_Barrier( comm ); +#endif + + if (rank == 0) { + n = bufsizes[cs]; + buf = (char *)malloc( n ); + if (!buf) { + fprintf( stderr, "Unable to allocate %d bytes\n", n ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + MPI_Ssend_init( buf, n, MPI_CHAR, dest, cs+n+4, comm, &req ); + MPI_Start( &req ); + MPI_Cancel( &req ); + MPI_Wait( &req, &status ); + MPI_Test_cancelled( &status, &flag ); + if (!flag) { + errs ++; + printf( "Failed to cancel a persistent ssend request\n" ); + fflush(stdout); + } + else + { + n = 0; + } + MPI_Request_free( &req ); + /* Send the size, zero for successfully cancelled */ + MPI_Send( &n, 1, MPI_INT, dest, 123, comm ); + /* Send the tag so the message can be received */ + n = cs+n+4; + MPI_Send( &n, 1, MPI_INT, dest, 123, comm ); + free( buf ); + } + else if (rank == dest) + { + int nn, tag; + char *btemp; + MPI_Recv( &nn, 1, MPI_INT, 0, 123, comm, &status ); + MPI_Recv( &tag, 1, MPI_INT, 0, 123, comm, &status ); + if (nn > 0) + { + /* If the message was not cancelled, receive it here */ + btemp = (char*)malloc( nn ); + if (!btemp) + { + fprintf( stderr, "Unable to allocate %d bytes\n", nn); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + MPI_Recv( btemp, nn, MPI_CHAR, 0, tag, comm, &status ); + free(btemp); + } + } + MPI_Barrier( comm ); + } + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/pt2pt/rcancel.c b/teshsuite/smpi/mpich3-test/pt2pt/rcancel.c new file mode 100644 index 0000000000..398ed9abea --- /dev/null +++ b/teshsuite/smpi/mpich3-test/pt2pt/rcancel.c @@ -0,0 +1,86 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2003 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include "mpi.h" +#include +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Test of various receive cancel calls, with multiple requests to cancel"; +*/ + +int main( int argc, char *argv[] ) +{ + int errs = 0; + int rank, size, source, dest; + MPI_Comm comm; + MPI_Status status; + MPI_Request req[4]; + static int bufsizes[4] = { 1, 100, 10000, 1000000 }; + char *bufs[4]; + int flag, i; + + MTest_Init( &argc, &argv ); + + comm = MPI_COMM_WORLD; + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + + source = 0; + dest = size - 1; + + if (rank == source) { + MPI_Send( MPI_BOTTOM, 0, MPI_CHAR, dest, 1, MPI_COMM_WORLD ); + } + else if (rank == dest) { + /* Create 3 requests to cancel, plus one to use. + Then receive one message and exit */ + for (i=0; i<4; i++) { + bufs[i] = (char *) malloc( bufsizes[i] ); + MPI_Irecv( bufs[i], bufsizes[i], MPI_CHAR, source, + i, MPI_COMM_WORLD, &req[i] ); + } + /* Now, cancel them in a more interesting order, to ensure that the + queue operation work properly */ + MPI_Cancel( &req[2] ); + MPI_Wait( &req[2], &status ); + MTestPrintfMsg( 1, "Completed wait on irecv[2]\n" ); + MPI_Test_cancelled( &status, &flag ); + if (!flag) { + errs ++; + printf( "Failed to cancel a Irecv[2] request\n" ); + fflush(stdout); + } + MPI_Cancel( &req[3] ); + MPI_Wait( &req[3], &status ); + MTestPrintfMsg( 1, "Completed wait on irecv[3]\n" ); + MPI_Test_cancelled( &status, &flag ); + if (!flag) { + errs ++; + printf( "Failed to cancel a Irecv[3] request\n" ); + fflush(stdout); + } + MPI_Cancel( &req[0] ); + MPI_Wait( &req[0], &status ); + MTestPrintfMsg( 1, "Completed wait on irecv[0]\n" ); + MPI_Test_cancelled( &status, &flag ); + if (!flag) { + errs ++; + printf( "Failed to cancel a Irecv[0] request\n" ); + fflush(stdout); + } + MPI_Wait( &req[1], &status ); + MPI_Test_cancelled( &status, &flag ); + if (flag) { + errs ++; + printf( "Incorrectly cancelled Irecv[1]\n" ); fflush(stdout); + } + } + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/pt2pt/rqfreeb.c b/teshsuite/smpi/mpich3-test/pt2pt/rqfreeb.c new file mode 100644 index 0000000000..1a6eab1216 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/pt2pt/rqfreeb.c @@ -0,0 +1,123 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2006 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include "mpi.h" +#include +#include +#include "mpitest.h" + +/* Test Ibsend and Request_free */ +int main( int argc, char *argv[] ) +{ + MPI_Comm comm = MPI_COMM_WORLD; + int dest = 1, src = 0, tag = 1; + int s1; + char *buf, *bbuf; + int smsg[5], rmsg[5]; + int errs = 0, rank, size; + int bufsize, bsize; + + MTest_Init( &argc, &argv ); + MPI_Comm_rank( MPI_COMM_WORLD, &rank ); + MPI_Comm_size( MPI_COMM_WORLD, &size ); + if (src >= size || dest >= size) { + int r = src; + if (dest > r) r = dest; + fprintf( stderr, "This program requires %d processes\n", r-1 ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + + if (rank == src) { + MPI_Request r; + + MPI_Barrier( MPI_COMM_WORLD ); + + /* According to the standard, we must use the PACK_SIZE length of each + message in the computation of the message buffer size */ + MPI_Pack_size( 5, MPI_INT, comm, &s1 ); + bufsize = MPI_BSEND_OVERHEAD + s1 + 2000; + buf = (char *)malloc( bufsize ); + MPI_Buffer_attach( buf, bufsize ); + + MTestPrintfMsg( 10, "About create and free Isend request\n" ); + smsg[0] = 10; + MPI_Isend( &smsg[0], 1, MPI_INT, dest, tag, comm, &r ); + MPI_Request_free( &r ); + if (r != MPI_REQUEST_NULL) { + errs++; + fprintf( stderr, "Request not set to NULL after request free\n" ); + } + MTestPrintfMsg( 10, "About create and free Ibsend request\n" ); + smsg[1] = 11; + MPI_Ibsend( &smsg[1], 1, MPI_INT, dest, tag+1, comm, &r ); + MPI_Request_free( &r ); + if (r != MPI_REQUEST_NULL) { + errs++; + fprintf( stderr, "Request not set to NULL after request free\n" ); + } + MTestPrintfMsg( 10, "About create and free Issend request\n" ); + smsg[2] = 12; + MPI_Issend( &smsg[2], 1, MPI_INT, dest, tag+2, comm, &r ); + MPI_Request_free( &r ); + if (r != MPI_REQUEST_NULL) { + errs++; + fprintf( stderr, "Request not set to NULL after request free\n" ); + } + MTestPrintfMsg( 10, "About create and free Irsend request\n" ); + smsg[3] = 13; + MPI_Irsend( &smsg[3], 1, MPI_INT, dest, tag+3, comm, &r ); + MPI_Request_free( &r ); + if (r != MPI_REQUEST_NULL) { + errs++; + fprintf( stderr, "Request not set to NULL after request free\n" ); + } + smsg[4] = 14; + MPI_Isend( &smsg[4], 1, MPI_INT, dest, tag+4, comm, &r ); + MPI_Wait( &r, MPI_STATUS_IGNORE ); + + /* We can't guarantee that messages arrive until the detach */ + MPI_Buffer_detach( &bbuf, &bsize ); + } + + if (rank == dest) { + MPI_Request r[5]; + int i; + + for (i=0; i<5; i++) { + MPI_Irecv( &rmsg[i], 1, MPI_INT, src, tag+i, comm, &r[i] ); + } + if (rank != src) /* Just in case rank == src */ + MPI_Barrier( MPI_COMM_WORLD ); + + for (i=0; i<4; i++) { + MPI_Wait( &r[i], MPI_STATUS_IGNORE ); + if (rmsg[i] != 10+i) { + errs++; + fprintf( stderr, "message %d (%d) should be %d\n", i, rmsg[i], 10+i ); + } + } + /* The MPI standard says that there is no way to use MPI_Request_free + safely with receive requests. A strict MPI implementation may + choose to consider these erroreous (an IBM MPI implementation + does so) */ +#ifdef USE_STRICT_MPI + MPI_Wait( &r[4], MPI_STATUS_IGNORE ); +#else + MTestPrintfMsg( 10, "About free Irecv request\n" ); + MPI_Request_free( &r[4] ); +#endif + } + + if (rank != dest && rank != src) { + MPI_Barrier( MPI_COMM_WORLD ); + } + + + MTest_Finalize( errs ); + + MPI_Finalize(); + + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/pt2pt/rqstatus.c b/teshsuite/smpi/mpich3-test/pt2pt/rqstatus.c new file mode 100644 index 0000000000..102e9f8acd --- /dev/null +++ b/teshsuite/smpi/mpich3-test/pt2pt/rqstatus.c @@ -0,0 +1,114 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2003 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include "mpi.h" +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Test Request_get_status"; +*/ + +int main( int argc, char *argv[] ) +{ + int errs = 0; + int rank, size, source, dest; + int buf[2], flag, count; + MPI_Comm comm; + MPI_Status status, status2; + MPI_Request req; + + 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; + + + /* Handling MPI_REQUEST_NULL in MPI_Request_get_status was only required + starting with MPI-2.2. */ +#if MTEST_HAVE_MIN_MPI_VERSION(2,2) + MPI_Request_get_status( MPI_REQUEST_NULL, &flag, &status ); + if (!flag) { + errs++; + fprintf( stderr, "flag not true for MPI_REQUEST_NULL, flag=%d\n", flag ); + } + if ((status.MPI_SOURCE != MPI_ANY_SOURCE) || + (status.MPI_TAG != MPI_ANY_TAG) || + (status.MPI_ERROR != MPI_SUCCESS)) + { + errs++; + fprintf( stderr, "non-empty MPI_Status returned for MPI_REQUEST_NULL\n" ); + } + + /* also pass MPI_STATUS_IGNORE to make sure the implementation doesn't + * blow up when it is passed as the status argument */ + MPI_Request_get_status( MPI_REQUEST_NULL, &flag, MPI_STATUS_IGNORE ); + if (!flag) { + errs++; + fprintf( stderr, "flag not true for MPI_REQUEST_NULL with MPI_STATUS_IGNORE, flag=%d\n", flag ); + } +#endif + + if (rank == source) { + buf[0] = size; + buf[1] = 3; + MPI_Ssend( buf, 2, MPI_INT, dest, 10, comm ); + } + if (rank == dest) { + MPI_Irecv( buf, 2, MPI_INT, source, 10, comm, &req ); + } + MPI_Barrier( comm ); + /* At this point, we know that the receive has at least started, + because of the Ssend. Check the status on the request */ + if (rank == dest) { + status.MPI_SOURCE = -1; + status.MPI_TAG = -1; + MPI_Request_get_status( req, &flag, &status ); + if (flag) { + if (status.MPI_TAG != 10) { + errs++; + fprintf( stderr, "Tag value %d should be 10\n", status.MPI_TAG ); + } + if (status.MPI_SOURCE != source) { + errs++; + fprintf( stderr, "Source value %d should be %d\n", status.MPI_SOURCE, source ); + } + MPI_Get_count( &status, MPI_INT, &count ); + if (count != 2) { + errs++; + fprintf( stderr, "Count value %d should be 2\n", count ); + } + } + else { + errs++; + fprintf( stderr, "Unexpected flag value from get_status\n" ); + } + /* Now, complete the request */ + MPI_Wait( &req, &status2 ); + /* Check that the status is correct */ + if (status2.MPI_TAG != 10) { + errs++; + fprintf( stderr, "(wait)Tag value %d should be 10\n", status2.MPI_TAG ); + } + if (status2.MPI_SOURCE != source) { + errs++; + fprintf( stderr, "(wait)Source value %d should be %d\n", status2.MPI_SOURCE, source ); + } + MPI_Get_count( &status2, MPI_INT, &count ); + if (count != 2) { + errs++; + fprintf( stderr, "(wait)Count value %d should be 2\n", count ); + } + } + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/pt2pt/scancel.c b/teshsuite/smpi/mpich3-test/pt2pt/scancel.c new file mode 100644 index 0000000000..c78b122fee --- /dev/null +++ b/teshsuite/smpi/mpich3-test/pt2pt/scancel.c @@ -0,0 +1,271 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2003 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include "mpi.h" +#include +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Test of various send cancel calls"; +*/ + +int main( int argc, char *argv[] ) +{ + int errs = 0; + int rank, size, source, dest; + MPI_Comm comm; + MPI_Status status; + MPI_Request req; + static int bufsizes[4] = { 1, 100, 10000, 1000000 }; + char *buf; +#ifdef TEST_IRSEND + int veryPicky = 0; /* Set to 1 to test "quality of implementation" in + a tricky part of cancel */ +#endif + int cs, flag, n; + + MTest_Init( &argc, &argv ); + + comm = MPI_COMM_WORLD; + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + + source = 0; + dest = size - 1; + + MTestPrintfMsg( 1, "Starting scancel test\n" ); + for (cs=0; cs<4; cs++) { + if (rank == 0) { + n = bufsizes[cs]; + buf = (char *)malloc( n ); + if (!buf) { + fprintf( stderr, "Unable to allocate %d bytes\n", n ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + MTestPrintfMsg( 1, "(%d) About to create isend and cancel\n",cs ); + MPI_Isend( buf, n, MPI_CHAR, dest, cs+n+1, comm, &req ); + MPI_Cancel( &req ); + MPI_Wait( &req, &status ); + MTestPrintfMsg( 1, "Completed wait on isend\n" ); + MPI_Test_cancelled( &status, &flag ); + if (!flag) { + errs ++; + printf( "Failed to cancel an Isend request\n" ); + fflush(stdout); + } + else + { + n = 0; + } + /* Send the size, zero for successfully cancelled */ + MPI_Send( &n, 1, MPI_INT, dest, 123, comm ); + /* Send the tag so the message can be received */ + n = cs+n+1; + MPI_Send( &n, 1, MPI_INT, dest, 123, comm ); + free( buf ); + } + else if (rank == dest) + { + int nn, tag; + char *btemp; + MPI_Recv( &nn, 1, MPI_INT, 0, 123, comm, &status ); + MPI_Recv( &tag, 1, MPI_INT, 0, 123, comm, &status ); + if (nn > 0) + { + /* If the message was not cancelled, receive it here */ + btemp = (char*)malloc( nn ); + if (!btemp) + { + fprintf( stderr, "Unable to allocate %d bytes\n", nn ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + MPI_Recv( btemp, nn, MPI_CHAR, 0, tag, comm, &status ); + free(btemp); + } + } + MPI_Barrier( comm ); + + if (rank == 0) { + char *bsendbuf; + int bsendbufsize; + int bf, bs; + n = bufsizes[cs]; + buf = (char *)malloc( n ); + if (!buf) { + fprintf( stderr, "Unable to allocate %d bytes\n", n ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + bsendbufsize = n + MPI_BSEND_OVERHEAD; + bsendbuf = (char *)malloc( bsendbufsize ); + if (!bsendbuf) { + fprintf( stderr, "Unable to allocate %d bytes for bsend\n", n ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + MPI_Buffer_attach( bsendbuf, bsendbufsize ); + MTestPrintfMsg( 1, "About to create and cancel ibsend\n" ); + MPI_Ibsend( buf, n, MPI_CHAR, dest, cs+n+2, comm, &req ); + MPI_Cancel( &req ); + MPI_Wait( &req, &status ); + MPI_Test_cancelled( &status, &flag ); + if (!flag) { + errs ++; + printf( "Failed to cancel an Ibsend request\n" ); + fflush(stdout); + } + else + { + n = 0; + } + /* Send the size, zero for successfully cancelled */ + MPI_Send( &n, 1, MPI_INT, dest, 123, comm ); + /* Send the tag so the message can be received */ + n = cs+n+2; + MPI_Send( &n, 1, MPI_INT, dest, 123, comm ); + free( buf ); + MPI_Buffer_detach( &bf, &bs ); + free( bsendbuf ); + } + else if (rank == dest) + { + int nn, tag; + char *btemp; + MPI_Recv( &nn, 1, MPI_INT, 0, 123, comm, &status ); + MPI_Recv( &tag, 1, MPI_INT, 0, 123, comm, &status ); + if (nn > 0) + { + /* If the message was not cancelled, receive it here */ + btemp = (char*)malloc( nn ); + if (!btemp) + { + fprintf( stderr, "Unable to allocate %d bytes\n", nn); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + MPI_Recv( btemp, nn, MPI_CHAR, 0, tag, comm, &status ); + free(btemp); + } + } + MPI_Barrier( comm ); + + /* Because this test is erroneous, we do not perform it unless + TEST_IRSEND is defined. */ +#ifdef TEST_IRSEND + /* We avoid ready send to self because an implementation + is free to detect the error in delivering a message to + itself without a pending receive; we could also check + for an error return from the MPI_Irsend */ + if (rank == 0 && dest != rank) { + n = bufsizes[cs]; + buf = (char *)malloc( n ); + if (!buf) { + fprintf( stderr, "Unable to allocate %d bytes\n", n ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + MTestPrintfMsg( 1, "About to create and cancel irsend\n" ); + MPI_Irsend( buf, n, MPI_CHAR, dest, cs+n+3, comm, &req ); + MPI_Cancel( &req ); + MPI_Wait( &req, &status ); + MPI_Test_cancelled( &status, &flag ); + /* This can be pretty ugly. The standard is clear (Section 3.8) + that either a sent message is received or the + sent message is successfully cancelled. Since this message + can never be received, the cancel must complete + successfully. + + However, since there is no matching receive, this + program is erroneous. In this case, we can't really + flag this as an error */ + if (!flag && veryPicky) { + errs ++; + printf( "Failed to cancel an Irsend request\n" ); + fflush(stdout); + } + if (flag) + { + n = 0; + } + /* Send the size, zero for successfully cancelled */ + MPI_Send( &n, 1, MPI_INT, dest, 123, comm ); + /* Send the tag so the message can be received */ + n = cs+n+3; + MPI_Send( &n, 1, MPI_INT, dest, 123, comm ); + free( buf ); + } + else if (rank == dest) + { + int n, tag; + char *btemp; + MPI_Recv( &n, 1, MPI_INT, 0, 123, comm, &status ); + MPI_Recv( &tag, 1, MPI_INT, 0, 123, comm, &status ); + if (n > 0) + { + /* If the message was not cancelled, receive it here */ + btemp = (char*)malloc( n ); + if (!btemp) + { + fprintf( stderr, "Unable to allocate %d bytes\n", n); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + MPI_Recv( btemp, n, MPI_CHAR, 0, tag, comm, &status ); + free(btemp); + } + } + MPI_Barrier( comm ); +#endif + + if (rank == 0) { + n = bufsizes[cs]; + buf = (char *)malloc( n ); + if (!buf) { + fprintf( stderr, "Unable to allocate %d bytes\n", n ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + MTestPrintfMsg( 1, "About to create and cancel issend\n" ); + MPI_Issend( buf, n, MPI_CHAR, dest, cs+n+4, comm, &req ); + MPI_Cancel( &req ); + MPI_Wait( &req, &status ); + MPI_Test_cancelled( &status, &flag ); + if (!flag) { + errs ++; + printf( "Failed to cancel an Issend request\n" ); + fflush(stdout); + } + else + { + n = 0; + } + /* Send the size, zero for successfully cancelled */ + MPI_Send( &n, 1, MPI_INT, dest, 123, comm ); + /* Send the tag so the message can be received */ + n = cs+n+4; + MPI_Send( &n, 1, MPI_INT, dest, 123, comm ); + free( buf ); + } + else if (rank == dest) + { + int nn, tag; + char *btemp; + MPI_Recv( &nn, 1, MPI_INT, 0, 123, comm, &status ); + MPI_Recv( &tag, 1, MPI_INT, 0, 123, comm, &status ); + if (nn > 0) + { + /* If the message was not cancelled, receive it here */ + btemp = (char*)malloc( nn ); + if (!btemp) + { + fprintf( stderr, "Unable to allocate %d bytes\n", nn); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + MPI_Recv( btemp, nn, MPI_CHAR, 0, tag, comm, &status ); + free(btemp); + } + } + MPI_Barrier( comm ); + } + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/pt2pt/scancel2.c b/teshsuite/smpi/mpich3-test/pt2pt/scancel2.c new file mode 100644 index 0000000000..b027f0b6d8 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/pt2pt/scancel2.c @@ -0,0 +1,83 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2003 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include "mpi.h" +#include +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Test of send cancel (failure) calls"; +*/ + +int main( int argc, char *argv[] ) +{ + int errs = 0; + int rank, size, source, dest; + MPI_Comm comm; + MPI_Status status; + MPI_Request req; + static int bufsizes[4] = { 1, 100, 10000, 1000000 }; + char *buf; + int cs, flag, n; + + MTest_Init( &argc, &argv ); + + comm = MPI_COMM_WORLD; + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + + source = 0; + dest = size - 1; + + MTestPrintfMsg( 1, "Starting scancel test\n" ); + + for (cs=0; cs<4; cs++) { + n = bufsizes[cs]; + buf = (char *)malloc( n ); + if (!buf) { + fprintf( stderr, "Unable to allocate %d bytes\n", n ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + + if (rank == source) { + MTestPrintfMsg( 1, "(%d) About to create isend and cancel\n",cs ); + MPI_Isend( buf, n, MPI_CHAR, dest, cs+n+1, comm, &req ); + MPI_Barrier( comm ); + MPI_Cancel( &req ); + MPI_Wait( &req, &status ); + MTestPrintfMsg( 1, "Completed wait on isend\n" ); + MPI_Test_cancelled( &status, &flag ); + if (flag) { + errs ++; + printf( "Cancelled a matched Isend request (msg size = %d)!\n", + n ); + fflush(stdout); + } + else + { + n = 0; + } + /* Send the size, zero for not cancelled (success) */ + MPI_Send( &n, 1, MPI_INT, dest, 123, comm ); + } + else if (rank == dest) + { + MPI_Recv( buf, n, MPI_CHAR, source, cs+n+1, comm, &status ); + MPI_Barrier( comm ); + MPI_Recv( &n, 1, MPI_INT, source, 123, comm, &status ); + } + else { + MPI_Barrier( comm ); + } + + MPI_Barrier( comm ); + free( buf ); + } + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/pt2pt/sendall.c b/teshsuite/smpi/mpich3-test/pt2pt/sendall.c new file mode 100644 index 0000000000..eba48e60a8 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/pt2pt/sendall.c @@ -0,0 +1,82 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2007 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ + +#include +#include +#include "mpi.h" +#include "mpitest.h" + +/* + * This test makes sure that each process can send to each other process. + * If there are bugs in the handling of request completions or in + * queue operations, then this test may fail on them (it did with + * early EagerShort handling). + */ + +#define MAXPES 32 +#define MYBUFSIZE 16*1024 +static int buffer[MAXPES][MYBUFSIZE]; + +#define NUM_RUNS 10 + +int main ( int argc, char *argv[] ) +{ + int i; + int count, size; + int self, npes; + double secs; + MPI_Request request[MAXPES]; + MPI_Status status; + + MTest_Init (&argc, &argv); + MPI_Comm_rank (MPI_COMM_WORLD, &self); + MPI_Comm_size (MPI_COMM_WORLD, &npes); + + if (npes > MAXPES) { + fprintf( stderr, "This program requires a comm_world no larger than %d", + MAXPES ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + + for (size = 1; size <= MYBUFSIZE ; size += size) { + secs = -MPI_Wtime (); + for (count = 0; count < NUM_RUNS; count++) { + MPI_Barrier (MPI_COMM_WORLD); + + for (i = 0; i < npes; i++) { + if (i != self) + MPI_Irecv (buffer[i], size, MPI_INT, i, + MPI_ANY_TAG, MPI_COMM_WORLD, &request[i]); + } + + for (i = 0; i < npes; i++) { + if (i != self) + MPI_Send (buffer[self], size, MPI_INT, i, 0, MPI_COMM_WORLD); + } + + for (i = 0; i < npes; i++) { + if (i != self) + MPI_Wait (&request[i], &status); + } + + } + MPI_Barrier (MPI_COMM_WORLD); + secs += MPI_Wtime (); + + if (self == 0) { + secs = secs / (double) NUM_RUNS; + MTestPrintfMsg( 1, "length = %d ints\n", size ); + } + } + + /* Simple completion is all that we normally ask of this program */ + + MTest_Finalize( 0 ); + + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/pt2pt/sendflood.c b/teshsuite/smpi/mpich3-test/pt2pt/sendflood.c new file mode 100644 index 0000000000..e2fed07b26 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/pt2pt/sendflood.c @@ -0,0 +1,156 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2008 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include +#include +#include +#include "mpi.h" + +/* + * Run this test with 8 processes. This test was submitted by xxx + * as a result of problems seen with the ch3:shm device on a Solaris + * system. The symptom is that the test hangs; this is due to losing + * a message, probably due to a race condition in a message-queue update. + * As a test for race conditions, it may need to be run multiple times + * to expose a problem if a problem does exist. + */ + +#define LOOP_COUNT 10000 +#define DATA_SIZE 4 +#define MP_TAG 999 + +#define PROGRESS_COUNT 0xfff +static int verbose = 0; +static int loopProgress = 0; + +int main( int argc, char *argv[] ) +{ + int nProc, rank ; + int i, j, status ; + FILE *pf=0 ; + + MPI_Init( &argc, &argv ) ; + MPI_Comm_size( MPI_COMM_WORLD, &nProc ) ; + MPI_Comm_rank( MPI_COMM_WORLD, &rank ) ; + + for (i=1; i +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Send-Recv"; +*/ + +int main( int argc, char *argv[] ) +{ + int errs = 0, err; + int rank, size, source, dest; + int minsize = 2, count; + MPI_Comm comm; + MTestDatatype sendtype, recvtype; + + MTest_Init( &argc, &argv ); + + /* The following illustrates the use of the routines to + run through a selection of communicators and datatypes. + Use subsets of these for tests that do not involve combinations + of communicators, datatypes, and counts of datatypes */ + while (MTestGetIntracommGeneral( &comm, minsize, 1 )) { + if (comm == MPI_COMM_NULL) continue; + + /* Determine the sender and receiver */ + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + source = 0; + dest = size - 1; + + /* To improve reporting of problems about operations, we + change the error handler to errors return */ + MPI_Comm_set_errhandler( comm, MPI_ERRORS_RETURN ); + + for (count = 1; count < 65000; count = count * 2) { + while (MTestGetDatatypes( &sendtype, &recvtype, count )) { + /* Make sure that everyone has a recv buffer */ + recvtype.InitBuf( &recvtype ); + + if (rank == source) { + sendtype.InitBuf( &sendtype ); + + err = MPI_Send( sendtype.buf, sendtype.count, + sendtype.datatype, dest, 0, comm); + if (err) { + errs++; + if (errs < 10) { + MTestPrintError( err ); + } + } + } + else if (rank == dest) { + err = MPI_Recv( recvtype.buf, recvtype.count, + recvtype.datatype, source, 0, comm, MPI_STATUS_IGNORE); + if (err) { + errs++; + if (errs < 10) { + MTestPrintError( err ); + } + } + + err = MTestCheckRecv( 0, &recvtype ); + if (err) { + if (errs < 10) { + printf( "Data in target buffer did not match for destination datatype %s and source datatype %s, count = %d\n", + MTestGetDatatypeName( &recvtype ), + MTestGetDatatypeName( &sendtype ), + count ); + recvtype.printErrors = 1; + (void)MTestCheckRecv( 0, &recvtype ); + } + errs += err; + } + } + MTestFreeDatatype( &sendtype ); + MTestFreeDatatype( &recvtype ); + } + } + MTestFreeComm( &comm ); + } + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/pt2pt/sendrecv2.c b/teshsuite/smpi/mpich3-test/pt2pt/sendrecv2.c new file mode 100644 index 0000000000..f4845c6be7 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/pt2pt/sendrecv2.c @@ -0,0 +1,136 @@ +/* -*- 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 "mpitestconf.h" +#include +#include +#ifdef HAVE_STRING_H +#include +#endif + +static int verbose = 0; + +static int parse_args(int argc, char **argv); + +int main( int argc, char *argv[] ) +{ + int i, j, errs = 0; + int rank, size; + MPI_Datatype newtype; + char *buf = NULL; + + MPI_Init(&argc, &argv); + parse_args(argc, argv); + + MPI_Comm_rank(MPI_COMM_WORLD, &rank); + MPI_Comm_size(MPI_COMM_WORLD, &size); + + if (size < 2) { + if (verbose) fprintf(stderr, "comm size must be > 1\n"); + errs++; + goto fn_exit; + } + + buf = malloc(64 * 129); + if (buf == NULL) { + if (verbose) fprintf(stderr, "error allocating buffer\n"); + errs++; + goto fn_exit; + } + + for (i = 8; i < 64; i += 4) { + MPI_Type_vector(i, 128, 129, MPI_CHAR, &newtype); + + MPI_Type_commit(&newtype); + memset(buf, 0, 64*129); + + if (rank == 0) { + /* init buffer */ + for (j=0; j < i; j++) { + int k; + for (k=0; k < 129; k++) { + buf[129*j + k] = (char) j; + } + } + + /* send */ + MPI_Send(buf, 1, newtype, 1, i, MPI_COMM_WORLD); + } + else if (rank == 1) { + /* recv */ + MPI_Recv(buf, 1, newtype, 0, i, MPI_COMM_WORLD, MPI_STATUS_IGNORE); + + /* check buffer */ + for (j=0; j < i; j++) { + int k; + for (k=0; k < 129; k++) { + if (k < 128 && buf[129*j + k] != (char) j) { + if (verbose) fprintf(stderr, + "(i=%d, pos=%d) should be %d but is %d\n", + i, 129*j + k, j, (int) buf[129*j + k]); + errs++; + } + else if (k == 128 && buf[129*j + k] != (char) 0) { + if (verbose) fprintf(stderr, + "(i=%d, pos=%d) should be %d but is %d\n", + i, 129*j + k, 0, (int) buf[129*j + k]); + errs++; + } + } + } + } + + MPI_Type_free(&newtype); + } + + if (rank == 0) { + int recv_errs = 0; + + MPI_Recv(&recv_errs, 1, MPI_INT, 1, 0, MPI_COMM_WORLD, + MPI_STATUS_IGNORE); + if (recv_errs) { + if (verbose) fprintf(stderr, "%d errors reported from receiver\n", + recv_errs); + errs += recv_errs; + } + } + else if (rank == 1) { + MPI_Send(&errs, 1, MPI_INT, 0, 0, MPI_COMM_WORLD); + } + + fn_exit: + + free(buf); + /* print message and exit */ + if (errs) { + if (rank == 0) fprintf(stderr, "Found %d errors\n", errs); + } + else { + if (rank == 0) printf(" No Errors\n"); + } + MPI_Finalize(); + return 0; +} + +static int parse_args(int argc, char **argv) +{ + /* + int ret; + + while ((ret = getopt(argc, argv, "v")) >= 0) + { + switch (ret) { + case 'v': + verbose = 1; + break; + } + } + */ + if (argc > 1 && strcmp(argv[1], "-v") == 0) + verbose = 1; + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/pt2pt/sendrecv3.c b/teshsuite/smpi/mpich3-test/pt2pt/sendrecv3.c new file mode 100644 index 0000000000..e0c21a7ad9 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/pt2pt/sendrecv3.c @@ -0,0 +1,105 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * + * (C) 2003 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include "mpi.h" +#include +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Head to head send-recv to test backoff in device when large messages are being transferred"; +*/ + +#define MAX_NMSGS 100 +int main( int argc, char *argv[] ) +{ + int errs = 0; + int rank, size, source, dest, partner; + int i, testnum; + double tsend; + static int msgsizes[] = { 100, 1000, 10000, 100000, -1 }; + static int nmsgs[] = { 100, 10, 10, 4 }; + MPI_Comm comm; + + MTest_Init( &argc, &argv ); + + comm = MPI_COMM_WORLD; + + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + source = 0; + dest = 1; + if (size < 2) { + printf( "This test requires at least 2 processes\n" ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + + for (testnum=0; msgsizes[testnum] > 0; testnum++) { + if (rank == source || rank == dest) { + int nmsg = nmsgs[testnum]; + int msgSize = msgsizes[testnum]; + MPI_Request r[MAX_NMSGS]; + int *buf[MAX_NMSGS]; + + for (i=0; i 0.5) { + printf( "Isends for %d messages of size %d took too long (%f seconds)\n", nmsg, msgSize, tsend ); + errs++; + } + MTestPrintfMsg( 1, "%d Isends for size = %d took %f seconds\n", + nmsg, msgSize, tsend ); + + for (i=0; i +#include +#include "mpitest.h" + +/* +static char MTEST_Descrip[] = "Test of sending to self (with a preposted receive)"; +*/ + +int main( int argc, char *argv[] ) +{ + int errs = 0, err; + int rank, size; + int count; + MPI_Comm comm; + MPI_Request req; + MTestDatatype sendtype, recvtype; + + MTest_Init( &argc, &argv ); + + comm = MPI_COMM_WORLD; + MPI_Comm_rank( comm, &rank ); + MPI_Comm_size( comm, &size ); + + /* To improve reporting of problems about operations, we + change the error handler to errors return */ + MPI_Comm_set_errhandler( comm, MPI_ERRORS_RETURN ); + + for (count = 1; count < 65000; count = count * 2) { + while (MTestGetDatatypes( &sendtype, &recvtype, count )) { + + sendtype.InitBuf( &sendtype ); + recvtype.InitBuf( &recvtype ); + + err = MPI_Irecv( recvtype.buf, recvtype.count, + recvtype.datatype, rank, 0, comm, &req ); + if (err) { + errs++; + if (errs < 10) { + MTestPrintError( err ); + } + } + + err = MPI_Send( sendtype.buf, sendtype.count, + sendtype.datatype, rank, 0, comm); + if (err) { + errs++; + if (errs < 10) { + MTestPrintError( err ); + } + } + err = MPI_Wait( &req, MPI_STATUS_IGNORE ); + err = MTestCheckRecv( 0, &recvtype ); + if (err) { + if (errs < 10) { + printf( "Data in target buffer did not match for destination datatype %s and source datatype %s, count = %d\n", + MTestGetDatatypeName( &recvtype ), + MTestGetDatatypeName( &sendtype ), + count ); + recvtype.printErrors = 1; + (void)MTestCheckRecv( 0, &recvtype ); + } + errs += err; + } + + err = MPI_Irecv( recvtype.buf, recvtype.count, + recvtype.datatype, rank, 0, comm, &req ); + if (err) { + errs++; + if (errs < 10) { + MTestPrintError( err ); + } + } + + err = MPI_Ssend( sendtype.buf, sendtype.count, + sendtype.datatype, rank, 0, comm); + if (err) { + errs++; + if (errs < 10) { + MTestPrintError( err ); + } + } + err = MPI_Wait( &req, MPI_STATUS_IGNORE ); + err = MTestCheckRecv( 0, &recvtype ); + if (err) { + if (errs < 10) { + printf( "Data in target buffer did not match for destination datatype %s and source datatype %s, count = %d\n", + MTestGetDatatypeName( &recvtype ), + MTestGetDatatypeName( &sendtype ), + count ); + recvtype.printErrors = 1; + (void)MTestCheckRecv( 0, &recvtype ); + } + errs += err; + } + + err = MPI_Irecv( recvtype.buf, recvtype.count, + recvtype.datatype, rank, 0, comm, &req ); + if (err) { + errs++; + if (errs < 10) { + MTestPrintError( err ); + } + } + + err = MPI_Rsend( sendtype.buf, sendtype.count, + sendtype.datatype, rank, 0, comm); + if (err) { + errs++; + if (errs < 10) { + MTestPrintError( err ); + } + } + err = MPI_Wait( &req, MPI_STATUS_IGNORE ); + err = MTestCheckRecv( 0, &recvtype ); + if (err) { + if (errs < 10) { + printf( "Data in target buffer did not match for destination datatype %s and source datatype %s, count = %d\n", + MTestGetDatatypeName( &recvtype ), + MTestGetDatatypeName( &sendtype ), + count ); + recvtype.printErrors = 1; + (void)MTestCheckRecv( 0, &recvtype ); + } + errs += err; + } + + MTestFreeDatatype( &sendtype ); + MTestFreeDatatype( &recvtype ); + } + } + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/pt2pt/testlist b/teshsuite/smpi/mpich3-test/pt2pt/testlist new file mode 100644 index 0000000000..1f16dedb05 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/pt2pt/testlist @@ -0,0 +1,52 @@ +#needs MPI_Type_dup, MPI_Type_set_name +#sendrecv1 4 +sendrecv2 2 +sendrecv3 2 +sendflood 8 timeLimit=600 +#needs rsend +#sendself 1 +sendall 4 +anyall 2 +eagerdt 2 +#needs MPI_Type_get_name, MPI_Type_dup +#pingping 2 +bottom 2 +#needs MPI_Bsend +#bsend1 1 +#bsend2 1 +#bsend3 1 +#bsend4 1 +#bsend5 4 +#bsendalign 2 +#bsendpending 2 +isendself 1 +#needs MPI_Buffer_attach, MPI_Bsend, MPI_Buffer_detach +#bsendfrag 2 +#needs MPI_Intercomm_create +#icsend 4 +#needs MPI_Request_get_status +#rqstatus 2 +#needs MPI_Pack, MPI_Buffer_attach, MPI_Buffer_detach, MPI_Irsend, MPI_Ibsend +#rqfreeb 4 +#needs MPI_Grequest_start MPI_Grequest_complete +#greq1 1 +probe-unexp 4 +probenull 1 +# For testing, scancel will run with 1 process as well +#needs MPI_Cancel, MPI_Test_cancelled, MPI_Ibsend +#scancel 2 xfail=ticket287 +#needs MPI_Cancel, MPI_Test_cancelled +#scancel2 2 +#pscancel 2 xfail=ticket287 +#needs MPI_Cancel +#rcancel 2 +#cancelrecv 2 xfail=ticket287 +isendselfprobe 1 +inactivereq 1 +#needs MPI_Error_string, but fails with testany +waittestnull 1 +waitany-null 1 +# this should be run only on machines with large amount of memory (>=8GB) +# perhaps disable in the release tarball +#large_message 3 +mprobe 2 mpiversion=3.0 diff --git a/teshsuite/smpi/mpich3-test/pt2pt/waitany-null.c b/teshsuite/smpi/mpich3-test/pt2pt/waitany-null.c new file mode 100644 index 0000000000..9ba1eefa91 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/pt2pt/waitany-null.c @@ -0,0 +1,85 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2001 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include +#include +#include "mpitestconf.h" +#ifdef HAVE_STRING_H +#include +#endif +#include "mpi.h" + +static int verbose = 0; + +int main(int argc, char *argv[]); +int parse_args(int argc, char **argv); + +int main(int argc, char *argv[]) +{ + int i, err, errs = 0, rank, toterrs; + + int index; + MPI_Request requests[10]; + MPI_Status statuses[10]; + + MPI_Init(&argc, &argv); + parse_args(argc, argv); + + for (i=0; i < 10; i++) { + requests[i] = MPI_REQUEST_NULL; + } + + /* begin testing */ + /* 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_Waitany(10, requests, &index, statuses); + + if (err != MPI_SUCCESS) { + errs++; + fprintf(stderr, "MPI_Waitany did not return MPI_SUCCESS\n"); + } + + if (index != MPI_UNDEFINED) { + errs++; + fprintf(stderr, "MPI_Waitany did not set index to MPI_UNDEFINED\n"); + } + + /* end testing */ + + MPI_Comm_set_errhandler( MPI_COMM_WORLD, MPI_ERRORS_ARE_FATAL ); + MPI_Comm_rank( MPI_COMM_WORLD, & rank ); + MPI_Allreduce( &errs, &toterrs, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD ); + if (rank == 0) { + if (toterrs) { + fprintf(stderr, " Found %d errors\n", toterrs); + } + else { + printf(" No Errors\n"); + } + } + MPI_Finalize(); + return 0; +} + +int parse_args(int argc, char **argv) +{ + /* + int ret; + + while ((ret = getopt(argc, argv, "v")) >= 0) + { + switch (ret) { + case 'v': + verbose = 1; + break; + } + } + */ + if (argc > 1 && strcmp(argv[1], "-v") == 0) + verbose = 1; + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/pt2pt/waittestnull.c b/teshsuite/smpi/mpich3-test/pt2pt/waittestnull.c new file mode 100644 index 0000000000..d23c91d7d3 --- /dev/null +++ b/teshsuite/smpi/mpich3-test/pt2pt/waittestnull.c @@ -0,0 +1,81 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */ +/* + * (C) 2005 by Argonne National Laboratory. + * See COPYRIGHT in top-level directory. + */ +#include +#include "mpi.h" +#include "mpitest.h" + +/* + * This program checks that the various MPI_Test and MPI_Wait routines + * allow both null requests and in the multiple completion cases, empty + * lists of requests. + */ + +int main(int argc, char **argv) +{ + int errs = 0; + MPI_Status status, *status_array = 0; + int count = 0, flag, idx, rc, errlen, *indices=0, outcnt; + MPI_Request *reqs = 0; + char errmsg[MPI_MAX_ERROR_STRING]; + + MTest_Init(&argc, &argv); + + MPI_Comm_set_errhandler( MPI_COMM_WORLD, MPI_ERRORS_RETURN ); + + rc = MPI_Testall( count, reqs, &flag, status_array ); + if (rc != MPI_SUCCESS) { + MPI_Error_string( rc, errmsg, &errlen ); + printf( "MPI_Testall returned failure: %s\n", errmsg ); + errs ++; + } + else if (!flag) { + printf( "MPI_Testall( 0, ... ) did not return a true flag\n") ; + errs++; + } + + rc = MPI_Waitall( count, reqs, status_array ); + if (rc != MPI_SUCCESS) { + MPI_Error_string( rc, errmsg, &errlen ); + printf( "MPI_Waitall returned failure: %s\n", errmsg ); + errs ++; + } + + rc = MPI_Testany( count, reqs, &idx, &flag, &status ); + if (rc != MPI_SUCCESS) { + MPI_Error_string( rc, errmsg, &errlen ); + printf( "MPI_Testany returned failure: %s\n", errmsg ); + errs ++; + } + else if (!flag) { + printf( "MPI_Testany( 0, ... ) did not return a true flag\n") ; + errs++; + } + + rc = MPI_Waitany( count, reqs, &idx, &status ); + if (rc != MPI_SUCCESS) { + MPI_Error_string( rc, errmsg, &errlen ); + printf( "MPI_Waitany returned failure: %s\n", errmsg ); + errs ++; + } + + rc = MPI_Testsome( count, reqs, &outcnt, indices, status_array ); + if (rc != MPI_SUCCESS) { + MPI_Error_string( rc, errmsg, &errlen ); + printf( "MPI_Testsome returned failure: %s\n", errmsg ); + errs ++; + } + + rc = MPI_Waitsome( count, reqs, &outcnt, indices, status_array ); + if (rc != MPI_SUCCESS) { + MPI_Error_string( rc, errmsg, &errlen ); + printf( "MPI_Waitsome returned failure: %s\n", errmsg ); + errs ++; + } + + MTest_Finalize( errs ); + MPI_Finalize(); + return 0; +} diff --git a/teshsuite/smpi/mpich3-test/runtests b/teshsuite/smpi/mpich3-test/runtests new file mode 100755 index 0000000000..5cc28252cb --- /dev/null +++ b/teshsuite/smpi/mpich3-test/runtests @@ -0,0 +1,1075 @@ +#! /usr/local/bin/perl +# -*- Mode: perl; -*- +# +# This script is the beginnings of a script to run a sequence of test +# programs. See the MPICH document for a description of the test +# strategy and requirements. +# +# Description +# Tests are controlled by a file listing test programs; if the file is +# a directory, then all of the programs in the directory and subdirectories +# are run +# +# To run a test, the following steps are executed +# Build the executable: +# make programname +# Run the executable +# mpiexec -n ./programname >out 2>err +# Check the return code (non zero is failure) +# Check the stderr output (non empty is failure) +# Check the stdout output (No Errors or Test passed are the only valid +# output) +# Remove executable, out, err files +# +# The format of a list file is +# programname number-of-processes +# If number-of-processes is missing, $np_default is used (this is 2 but can +# be overridden with -np=new-value) +# +# Special feature: +# Because these tests can take a long time to run, there is an +# option to cause the tests to stop is a "stopfile" is found. +# The stopfile can be created by a separate, watchdog process, to ensure that +# tests end at a certain time. +# The name of this file is (by default) .stoptest +# in the top-level run directory. The environment variable +# MPITEST_STOPTEST +# can specify a different file name. +# +# Import the mkpath command +use File::Path; + +# Global variables +$MPIMajorVersion = "1"; +$MPIMinorVersion = "1"; +$mpiexec = "smpirun"; # Name of mpiexec program (including path, if necessary) +$testIsStrict = "true"; +$MPIhasMPIX = "no"; +$np_arg = "-np"; # Name of argument to specify the number of processes +$err_count = 0; # Number of programs that failed. +$total_run = 0; # Number of programs tested +$total_seen = 0; # Number of programs considered for testing +$np_default = 2; # Default number of processes to use +$np_max = -1; # Maximum number of processes to use (overrides any + # value in the test list files. -1 is Infinity +$defaultTimeLimit = 180; # default timeout + +$srcdir = "."; # Used to set the source dir for testlist files + +$curdir = "."; # used to track the relative current directory + +# Output forms +$xmloutput = 0; # Set to true to get xml output (also specify file) +$closeXMLOutput = 1; # Set to false to leave XML output file open to + # accept additional data +$verbose = 1; # Set to true to get more output +$showProgress = 0; # Set to true to get a "." with each run program. +$newline = "\r\n"; # Set to \r\n for Windows-friendly, \n for Unix only +$batchRun = 0; # Set to true to batch the execution of the tests + # (i.e., run them together, then test output, + # rather than build/run/check for each test) +$testCount = 0; # Used with batchRun to count tests. +$batrundir = "."; # Set to the directory into which to run the examples + +$execarg=""; +# TAP (Test Anything Protocol) output +my $tapoutput = 0; +my $tapfile = ''; +my $tapfullfile = ''; + +$debug = 1; + +$depth = 0; # This is used to manage multiple open list files + +# Build flags +$remove_this_pgm = 0; +$clean_pgms = 1; + +my $program_wrapper = ''; + +#--------------------------------------------------------------------------- +# Get some arguments from the environment +# Currently, only the following are understood: +# VERBOSE +# RUNTESTS_VERBOSE (an alias for VERBOSE in case you want to +# reserve VERBOSE) +# RUNTESTS_SHOWPROGRESS +# MPITEST_STOPTEST +# MPITEST_TIMEOUT +# MPITEST_PROGRAM_WRAPPER (Value is added after -np but before test +# executable. Tools like valgrind may be inserted +# this way.) +#--------------------------------------------------------------------------- +if ( defined($ENV{"VERBOSE"}) || defined($ENV{"V"}) || defined($ENV{"RUNTESTS_VERBOSE"}) ) { + $verbose = 1; +} +if ( defined($ENV{"RUNTESTS_SHOWPROGRESS"} ) ) { + $showProgress = 1; +} +if (defined($ENV{"MPITEST_STOPTEST"})) { + $stopfile = $ENV{"MPITEST_STOPTEST"}; +} +else { + $stopfile = `pwd` . "/.stoptest"; + $stopfile =~ s/\r*\n*//g; # Remove any newlines (from pwd) +} + +if (defined($ENV{"MPITEST_TIMEOUT"})) { + $defaultTimeLimit = $ENV{"MPITEST_TIMEOUT"}; +} + +# Define this to leave the XML output file open to receive additional data +if (defined($ENV{'NOXMLCLOSE'}) && $ENV{'NOXMLCLOSE'} eq 'YES') { + $closeXMLOutput = 0; +} + +if (defined($ENV{'MPITEST_PROGRAM_WRAPPER'})) { + $program_wrapper = $ENV{'MPITEST_PROGRAM_WRAPPER'}; +} + +if (defined($ENV{'MPITEST_BATCH'})) { + if ($ENV{'MPITEST_BATCH'} eq 'YES' || $ENV{'MPITEST_BATCH'} eq 'yes') { + $batchRun = 1; + } elsif ($ENV{'MPITEST_BATCH'} eq 'NO' || $ENV{'MPITEST_BATCH'} eq 'no') { + $batchRun = 0; + } + else { + print STDERR "Unrecognized value for MPITEST_BATCH = $ENV{'MPITEST_BATCH'}\n"; + } +} +if (defined($ENV{'MPITEST_BATCHDIR'})) { + $batrundir = $ENV{'MPITEST_BATCHDIR'}; +} + +#--------------------------------------------------------------------------- +# Process arguments and override any defaults +#--------------------------------------------------------------------------- +foreach $_ (@ARGV) { + if (/--?mpiexec=(.*)/) { + # Use mpiexec as given - it may be in the path, and + # we don't want to bother to try and find it. + $mpiexec = $1; + } + elsif (/--?np=(.*)/) { $np_default = $1; } + elsif (/--?maxnp=(.*)/) { $np_max = $1; } + elsif (/--?tests=(.*)/) { $listfiles = $1; } + elsif (/--?srcdir=(.*)/) { $srcdir = $1; + $mpiexec="$mpiexec -platform ${srcdir}/../../../../examples/msg/small_platform_with_routers.xml -hostfile ${srcdir}/../hostfile --log=root.thr:critical" } + elsif (/--?verbose/) { $verbose = 1; } + elsif (/--?showprogress/) { $showProgress = 1; } + elsif (/--?debug/) { $debug = 1; } + elsif (/--?batch/) { $batchRun = 1; } + elsif (/--?batchdir=(.*)/) { $batrundir = $1; } + elsif (/--?timeoutarg=(.*)/) { $timeoutArgPattern = $1; } + elsif (/--?execarg=(.*)/) { $execarg = "$execarg $1"; } + elsif (/--?xmlfile=(.*)/) { + $xmlfile = $1; + if (! ($xmlfile =~ /^\//)) { + $thisdir = `pwd`; + chop $thisdir; + $xmlfullfile = $thisdir . "/" . $xmlfile ; + } + else { + $xmlfullfile = $xmlfile; + } + $xmloutput = 1; + open( XMLOUT, ">$xmlfile" ) || die "Cannot open $xmlfile\n"; + my $date = `date "+%Y-%m-%d-%H-%M"`; + $date =~ s/\r?\n//; + # MPISOURCE can be used to describe the source of MPI for this + # test. + print XMLOUT "$newline"; + print XMLOUT "$newline"; + print XMLOUT "$newline"; + print XMLOUT "$date$newline"; + print XMLOUT "$newline"; + } + elsif (/--?noxmlclose/) { + $closeXMLOutput = 0; + } + elsif (/--?tapfile=(.*)/) { + $tapfile = $1; + if ($tapfile !~ m|^/|) { + $thisdir = `pwd`; + chomp $thisdir; + $tapfullfile = $thisdir . "/" . $tapfile ; + } + else { + $tapfullfile = $tapfile; + } + $tapoutput = 1; + open( TAPOUT, ">$tapfile" ) || die "Cannot open $tapfile\n"; + my $date = `date "+%Y-%m-%d-%H-%M"`; + $date =~ s/\r?\n//; + print TAPOUT "TAP version 13\n"; + print TAPOUT "# MPICH test suite results (TAP format)\n"; + print TAPOUT "# date ${date}\n"; + # we do not know at this point how many tests will be run, so do + # not print a test plan line like "1..450" until the very end + } + else { + print STDERR "Unrecognized argument $_\n"; + print STDERR "runtests [-tests=testfile] [-np=nprocesses] \ + [-maxnp=max-nprocesses] [-srcdir=location-of-tests] \ + [-xmlfile=filename ] [-noxmlclose] \ + [-verbose] [-showprogress] [-debug] [-batch]\n"; + exit(1); + } +} + +# Perform any post argument processing +if ($batchRun) { + if (! -d $batrundir) { + mkpath $batrundir || die "Could not create $batrundir\n"; + } + open( BATOUT, ">$batrundir/runtests.batch" ) || die "Could not open $batrundir/runtests.batch\n"; +} +else { + # We must have mpiexec + if ("$mpiexec" eq "") { + print STDERR "No mpiexec found!\n"; + exit(1); + } +} + +# +# Process any files +if ($listfiles eq "") { + if ($batchRun) { + print STDERR "An implicit list of tests is not permitted in batch mode\n"; + exit(1); + } + else { + &ProcessImplicitList; + } +} +elsif (-d $listfiles) { + print STDERR "Testing by directories not yet supported\n"; +} +else { + &RunList( $listfiles ); +} + +if ($xmloutput && $closeXMLOutput) { + print XMLOUT "$newline"; + close XMLOUT; +} + +if ($tapoutput) { + print TAPOUT "1..$total_seen\n"; + close TAPOUT; +} + +# Output a summary: +if ($batchRun) { + print "Programs created along with a runtest.batch file in $batrundir\n"; + print "Run that script and then use checktests to summarize the results\n"; +} +else { + if ($err_count) { + print "$err_count tests failed out of $total_run\n"; + if ($xmloutput) { + print "Details in $xmlfullfile\n"; + } + } + else { + print " All $total_run tests passed!\n"; + } + if ($tapoutput) { + print "TAP formatted results in $tapfullfile\n"; + } +} +# +# --------------------------------------------------------------------------- +# Routines +# +# Enter a new directory and process a list file. +# ProcessDir( directory-name, list-file-name ) +sub ProcessDir { + my $dir = $_[0]; $dir =~ s/\/$//; + my $listfile = $_[1]; + my $savedir = `pwd`; + my $savecurdir = $curdir; + my $savesrcdir = $srcdir; + + chop $savedir; + if (substr($srcdir,0,3) eq "../") { + $srcdir = "../$srcdir"; + } + + print "Processing directory $dir\n" if ($verbose || $debug); + chdir $dir; + if ($dir =~ /\//) { + print STDERR "only direct subdirectories allowed in list files"; + } + $curdir .= "/$dir"; + + &RunList( $listfile ); + print "\n" if $showProgress; # Terminate line from progress output + chdir $savedir; + $curdir = $savecurdir; + $srcdir = $savesrcdir; +} +# --------------------------------------------------------------------------- +# Run the programs listed in the file given as the argument. +# This file describes the tests in the format +# programname number-of-processes [ key=value ... ] +# If the second value is not given, the default value is used. +# +sub RunList { + my $LIST = "LIST$depth"; $depth++; + my $listfile = $_[0]; + my $ResultTest = ""; + my $InitForRun = ""; + my $listfileSource = $listfile; + + print "Looking in $curdir/$listfile\n" if $debug; + if (! -s "$listfile" && -s "$srcdir/$curdir/$listfile" ) { + $listfileSource = "$srcdir/$curdir/$listfile"; + } + open( $LIST, "<$listfileSource" ) || + die "Could not open $listfileSource\n"; + while (<$LIST>) { + # Check for stop file + if (-s $stopfile) { + # Exit because we found a stopfile + print STDERR "Terminating test because stopfile $stopfile found\n"; + last; + } + # Skip comments + s/#.*//g; + # Remove any trailing newlines/returns + s/\r?\n//; + # Remove any leading whitespace + s/^\s*//; + # Some tests require that support routines are built first + # This is specified with !: + if (/^\s*\!([^:]*):(.*)/) { + # Hack: just execute in a subshell. This discards any + # output. + `cd $1 && make $2`; + next; + } + # List file entries have the form: + # program [ np [ name=value ... ] ] + # See files errhan/testlist, init/testlist, and spawn/testlist + # for examples of using the key=value form + my @args = split(/\s+/,$_); + my $programname = $args[0]; + my $np = ""; + my $ResultTest = ""; + my $InitForRun = ""; + my $timeLimit = ""; + my $progArgs = ""; + my $mpiexecArgs = "$execarg"; + my $requiresStrict = ""; + my $requiresMPIX = ""; + my $progEnv = ""; + my $mpiVersion = ""; + my $xfail = ""; + if ($#args >= 1) { $np = $args[1]; } + # Process the key=value arguments + for (my $i=2; $i <= $#args; $i++) { + if ($args[$i] =~ /([^=]+)=(.*)/) { + my $key = $1; + my $value = $2; + if ($key eq "resultTest") { + $ResultTest = $value; + } + elsif ($key eq "init") { + $InitForRun = $value; + } + elsif ($key eq "timeLimit") { + $timeLimit = $value; + } + elsif ($key eq "arg") { + $progArgs = "$progArgs $value"; + } + elsif ($key eq "mpiexecarg") { + $mpiexecArgs = "$mpiexecArgs $value"; + } + elsif ($key eq "env") { + $progEnv = "$progEnv $value"; + } + elsif ($key eq "mpiversion") { + $mpiVersion = $value; + } + elsif ($key eq "strict") { + $requiresStrict = $value + } + elsif ($key eq "mpix") { + $requiresMPIX = $value + } + elsif ($key eq "xfail") { + if ($value eq "") { + print STDERR "\"xfail=\" requires an argument\n"; + } + $xfail = $value; + } + else { + print STDERR "Unrecognized key $key in $listfileSource\n"; + } + } + } + + # skip empty lines + if ($programname eq "") { next; } + + if ($np eq "") { $np = $np_default; } + if ($np_max > 0 && $np > $np_max) { $np = $np_max; } + + # allows us to accurately output TAP test numbers without disturbing the + # original totals that have traditionally been reported + # + # These "unless" blocks are ugly, but permit us to honor skipping + # criteria for directories as well without counting directories as tests + # in our XML/TAP output. + unless (-d $programname) { + $total_seen++; + } + + # If a minimum MPI version is specified, check against the + # available MPI. If the version is unknown, we ignore this + # test (thus, all tests will be run). + if ($mpiVersion ne "" && $MPIMajorVersion ne "unknown" && + $MPIMinorVersion ne "unknown") { + my ($majorReq,$minorReq) = split(/\./,$mpiVersion); + if ($majorReq > $MPIMajorVersion or + ($majorReq == $MPIMajorVersion && $minorReq > $MPIMinorVersion)) + { + unless (-d $programname) { + SkippedTest($programname, $np, $workdir, "requires MPI version $mpiVersion"); + } + next; + } + } + # Check whether strict is required by MPI but not by the + # test (use strict=false for tests that use non-standard extensions) + if (lc($requiresStrict) eq "false" && lc($testIsStrict) eq "true") { + unless (-d $programname) { + SkippedTest($programname, $np, $workdir, "non-strict test, strict MPI mode requested"); + } + next; + } + + if (lc($testIsStrict) eq "true") { + # Strict MPI testing was requested, so assume that a non-MPICH MPI + # implementation is being tested and the "xfail" implementation + # assumptions do not hold. + $xfail = ''; + } + + if (lc($requiresMPIX) eq "true" && lc($MPIHasMPIX) eq "no") { + unless (-d $programname) { + SkippedTest($programname, $np, $workdir, "tests MPIX extensions, MPIX testing disabled"); + } + next; + } + + if (-d $programname) { + # If a directory, go into the that directory and + # look for a new list file + &ProcessDir( $programname, $listfile ); + } + else { + $total_run++; + if (&BuildMPIProgram( $programname, $xfail ) == 0) { + if ($batchRun == 1) { + &AddMPIProgram( $programname, $np, $ResultTest, + $InitForRun, $timeLimit, $progArgs, + $progEnv, $mpiexecArgs, $xfail ); + } + else { + &RunMPIProgram( $programname, $np, $ResultTest, + $InitForRun, $timeLimit, $progArgs, + $progEnv, $mpiexecArgs, $xfail ); + } + } + elsif ($xfail ne '') { + # We expected to run this program, so failure to build + # is an error + $found_error = 1; + $err_count++; + } + if ($batchRun == 0) { + &CleanUpAfterRun( $programname ); + } + } + } + close( $LIST ); +} +# +# This routine tries to run all of the files in the current +# directory +sub ProcessImplicitList { + # The default is to run every file in the current directory. + # If there are no built programs, build and run every file + # WARNING: This assumes that anything executable should be run as + # an MPI test. + $found_exec = 0; + $found_src = 0; + open (PGMS, "ls -1 |" ) || die "Cannot list directory\n"; + while () { + s/\r?\n//; + $programname = $_; + if (-d $programname) { next; } # Ignore directories + if ($programname eq "runtests") { next; } # Ignore self + if ($programname eq "checktests") { next; } # Ignore helper + if ($programname eq "configure") { next; } # Ignore configure script + if ($programname eq "config.status") { next; } # Ignore configure helper + if (-x $programname) { $found_exec++; } + if ($programname =~ /\.[cf]$/) { $found_src++; } + } + close PGMS; + + if ($found_exec) { + print "Found executables\n" if $debug; + open (PGMS, "ls -1 |" ) || die "Cannot list programs\n"; + while () { + # Check for stop file + if (-s $stopfile) { + # Exit because we found a stopfile + print STDERR "Terminating test because stopfile $stopfile found\n"; + last; + } + s/\r?\n//; + $programname = $_; + if (-d $programname) { next; } # Ignore directories + if ($programname eq "runtests") { next; } # Ignore self + if (-x $programname) { + $total_run++; + &RunMPIProgram( $programname, $np_default, "", "", "", "", "", "", "" ); + } + } + close PGMS; + } + elsif ($found_src) { + print "Found source files\n" if $debug; + open (PGMS, "ls -1 *.c |" ) || die "Cannot list programs\n"; + while () { + if (-s $stopfile) { + # Exit because we found a stopfile + print STDERR "Terminating test because stopfile $stopfile found\n"; + last; + } + s/\r?\n//; + $programname = $_; + # Skip messages from ls about no files + if (! -s $programname) { next; } + $programname =~ s/\.c//; + $total_run++; + if (&BuildMPIProgram( $programname, "") == 0) { + &RunMPIProgram( $programname, $np_default, "", "", "", "", "", "", "" ); + } + else { + # We expected to run this program, so failure to build + # is an error + $found_error = 1; + $err_count++; + } + &CleanUpAfterRun( $programname ); + } + close PGMS; + } +} +# Run the program. +# ToDo: Add a way to limit the time that any particular program may run. +# The arguments are +# name of program, number of processes, name of routine to check results +# init for testing, timelimit, and any additional program arguments +# If the 3rd arg is not present, the a default that simply checks that the +# return status is 0 and that the output is " No Errors" is used. +sub RunMPIProgram { + my ($programname,$np,$ResultTest,$InitForTest,$timeLimit,$progArgs,$progEnv,$mpiexecArgs,$xfail) = @_; + my $found_error = 0; + my $found_noerror = 0; + my $inline = ""; + + &RunPreMsg( $programname, $np, $curdir ); + + unlink "err"; + + # Set a default timeout on tests (3 minutes for now) + my $timeout = $defaultTimeLimit; + if (defined($timeLimit) && $timeLimit =~ /^\d+$/) { + $timeout = $timeLimit; + } + $ENV{"MPIEXEC_TIMEOUT"} = $timeout; + + # Run the optional setup routine. For example, the timeout tests could + # be set to a shorter timeout. + if ($InitForTest ne "") { + &$InitForTest(); + } + print STDOUT "Env includes $progEnv\n" if $verbose; + print STDOUT "$mpiexec $mpiexecArgs $np_arg $np $program_wrapper ./$programname $progArgs\n" if $verbose; + print STDOUT "." if $showProgress; + # Save and restore the environment if necessary before running mpiexec. + if ($progEnv ne "") { + %saveEnv = %ENV; + foreach $val (split(/\s+/, $progEnv)) { + if ($val =~ /([^=]+)=(.*)/) { + $ENV{$1} = $2; + } + else { + print STDERR "Environment variable/value $val not in a=b form\n"; + } + } + } + open ( MPIOUT, "$mpiexec $np_arg $np $mpiexecArgs $program_wrapper ./$programname $progArgs 2>&1 |" ) || + die "Could not run ./$programname\n"; + if ($progEnv ne "") { + %ENV = %saveEnv; + } + if ($ResultTest ne "") { + # Read and process the output + ($found_error, $inline) = &$ResultTest( MPIOUT, $programname ); + } + else { + if ($verbose) { + $inline = "$mpiexec $np_arg $np $program_wrapper ./$programname\n"; + } + else { + $inline = ""; + } + while () { + print STDOUT $_ if $verbose; + # Skip FORTRAN STOP + if (/FORTRAN STOP/) { next; } + $inline .= $_; + if (/^\s*No [Ee]rrors\s*$/ && $found_noerror == 0) { + $found_noerror = 1; + } + if (! /^\s*No [Ee]rrors\s*$/ && !/^\s*Test Passed\s*$/) { + print STDERR "Unexpected output in $programname: $_"; + if (!$found_error) { + $found_error = 1; + $err_count ++; + } + } + } + if ($found_noerror == 0) { + print STDERR "Program $programname exited without No Errors\n"; + if (!$found_error) { + $found_error = 1; + $err_count ++; + } + } + $rc = close ( MPIOUT ); + if ($rc == 0) { + # Only generate a message if we think that the program + # passed the test. + if (!$found_error) { + $run_status = $?; + $signal_num = $run_status & 127; + if ($run_status > 255) { $run_status >>= 8; } + print STDERR "Program $programname exited with non-zero status $run_status\n"; + if ($signal_num != 0) { + print STDERR "Program $programname exited with signal $signal_num\n"; + } + $found_error = 1; + $err_count ++; + } + } + } + if ($found_error) { + &RunTestFailed( $programname, $np, $curdir, $inline, $xfail ); + } + else { + &RunTestPassed( $programname, $np, $curdir, $xfail ); + } + &RunPostMsg( $programname, $np, $curdir ); +} + +# This version simply writes the mpiexec command out, with the output going +# into a file, and recording the output status of the run. +sub AddMPIProgram { + my ($programname,$np,$ResultTest,$InitForTest,$timeLimit,$progArgs,$progEnv,$mpiexecArgs, $xfail) = @_; + + if (! -x $programname) { + print STDERR "Could not find $programname!"; + return; + } + + if ($ResultTest ne "") { + # This test really needs to be run manually, with this test + # Eventually, we can update this to include handleing in checktests. + print STDERR "Run $curdir/$programname with $np processes and use $ResultTest to check the results\n"; + return; + } + + # Set a default timeout on tests (3 minutes for now) + my $timeout = $defaultTimeLimit; + if (defined($timeLimit) && $timeLimit =~ /^\d+$/) { + # On some systems, there is no effective time limit on + # individual mpi program runs. In that case, we may + # want to treat these also as "run manually". + $timeout = $timeLimit; + } + print BATOUT "export MPIEXEC_TIMEOUT=$timeout\n"; + + # Run the optional setup routine. For example, the timeout tests could + # be set to a shorter timeout. + if ($InitForTest ne "") { + &$InitForTest(); + } + + # For non-MPICH versions of mpiexec, a timeout may require a different + # environment variable or command line option (e.g., for Cray aprun, + # the option -t must be given, there is no environment variable + # to set the timeout. + $extraArgs = ""; + if (defined($timeoutArgPattern) && $timeoutArgPattern ne "") { + my $timeArg = $timeoutArgPattern; + $timeoutArg =~ s//$timeout/; + $extraArgs .= $timeoutArg + } + + print STDOUT "Env includes $progEnv\n" if $verbose; + print STDOUT "$mpiexec $np_arg $np $extraArgs $program_wrapper ./$programname $progArgs\n" if $verbose; + print STDOUT "." if $showProgress; + # Save and restore the environment if necessary before running mpiexec. + if ($progEnv ne "") { + # Need to fix: + # save_NAME_is_set=is old name set + # save_NAME=oldValue + # export NAME=newvalue + # (run) + # export NAME=oldValue (if set!) + print STDERR "Batch output does not permit changes to environment\n"; + } + # The approach here is to move the test codes to a single directory from + # which they can be run; this avoids complex code to change directories + # and ensure that the output goes "into the right place". + $testCount++; + rename $programname, "$batrundir/$programname"; + print BATOUT "echo \"# $mpiexec $np_arg $np $extraArgs $mpiexecArgs $program_wrapper $curdir/$programname $progArgs\" > runtests.$testCount.out\n"; + # Some programs expect to run in the same directory as the executable + print BATOUT "$mpiexec $np_arg $np $extraArgs $mpiexecArgs $program_wrapper ./$programname $progArgs >> runtests.$testCount.out 2>&1\n"; + print BATOUT "echo \$? > runtests.$testCount.status\n"; +} + +# +# Return value is 0 on success, non zero on failure +sub BuildMPIProgram { + my $programname = shift; + my $xfail = shift; + my $rc = 0; + if ($verbose) { print STDERR "making $programname\n"; } + if (! -x $programname) { $remove_this_pgm = 1; } + else { $remove_this_pgm = 0; } + my $output = `make $programname 2>&1`; + $rc = $?; + if ($rc > 255) { $rc >>= 8; } + if (! -x $programname) { + print STDERR "Failed to build $programname; $output\n"; + if ($rc == 0) { + $rc = 1; + } + # Add a line to the summary file describing the failure + # This will ensure that failures to build will end up + # in the summary file (which is otherwise written by the + # RunMPIProgram step) + &RunPreMsg( $programname, $np, $curdir ); + &RunTestFailed( $programname, $np, $curdir, "Failed to build $programname; $output", $xfail ); + &RunPostMsg( $programname, $np, $curdir ); + } + return $rc; +} + +sub CleanUpAfterRun { + my $programname = $_[0]; + + # Check for that this program has exited. If it is still running, + # issue a warning and leave the application. Of course, this + # check is complicated by the lack of a standard access to the + # running processes for this user in Unix. + @stillRunning = &FindRunning( $programname ); + + if ($#stillRunning > -1) { + print STDERR "Some programs ($programname) may still be running:\npids = "; + for (my $i=0; $i <= $#stillRunning; $i++ ) { + print STDERR $stillRunning[$i] . " "; + } + print STDERR "\n"; + # Remind the user that the executable remains; we leave it around + # to allow the programmer to debug the running program, for which + # the executable is needed. + print STDERR "The executable ($programname) will not be removed.\n"; + } + else { + if ($remove_this_pgm && $clean_pgms) { + unlink $programname, "$programname.o"; + } + $remove_this_pgm = 0; + } +} +# ---------------------------------------------------------------------------- +sub FindRunning { + my $programname = $_[0]; + my @pids = (); + + my $logname = $ENV{'USER'}; + my $pidloc = 1; + my $rc = open PSFD, "ps auxw -U $logname 2>&1 |"; + + if ($rc == 0) { + $rc = open PSFD, "ps -fu $logname 2>&1 |"; + } + if ($rc == 0) { + print STDERR "Could not execute ps command\n"; + return @pids; + } + + while () { + if (/$programname/) { + @fields = split(/\s+/); + my $pid = $fields[$pidloc]; + # Check that we've found a numeric pid + if ($pid =~ /^\d+$/) { + $pids[$#pids + 1] = $pid; + } + } + } + close PSFD; + + return @pids; +} +# ---------------------------------------------------------------------------- +# +# TestStatus is a special test that reports success *only* when the +# status return is NONZERO +sub TestStatus { + my $MPIOUT = $_[0]; + my $programname = $_[1]; + my $found_error = 0; + + my $inline = ""; + while (<$MPIOUT>) { + #print STDOUT $_ if $verbose; + # Skip FORTRAN STOP + if (/FORTRAN STOP/) { next; } + $inline .= $_; + # ANY output is an error. We have the following output + # exception for the Hydra process manager. + if (/=*/) { last; } + if (! /^\s*$/) { + print STDERR "Unexpected output in $programname: $_"; + if (!$found_error) { + $found_error = 1; + $err_count ++; + } + } + } + $rc = close ( MPIOUT ); + if ($rc == 0) { + $run_status = $?; + $signal_num = $run_status & 127; + if ($run_status > 255) { $run_status >>= 8; } + } + else { + # This test *requires* non-zero return codes + if (!$found_error) { + $found_error = 1; + $err_count ++; + } + $inline .= "$mpiexec returned a zero status but the program returned a nonzero status\n"; + } + return ($found_error,$inline); +} +# +# TestTimeout is a special test that reports success *only* when the +# status return is NONZERO and there are no processes left over. +# This test currently checks only for the return status. +sub TestTimeout { + my $MPIOUT = $_[0]; + my $programname = $_[1]; + my $found_error = 0; + + my $inline = ""; + while (<$MPIOUT>) { + #print STDOUT $_ if $verbose; + # Skip FORTRAN STOP + if (/FORTRAN STOP/) { next; } + $inline .= $_; + if (/[Tt]imeout/) { next; } + # Allow 'signaled with Interrupt' (see gforker mpiexec) + if (/signaled with Interrupt/) { next; } + # Allow 'job ending due to env var MPIEXEC_TIMEOUT' (mpd) + if (/job ending due to env var MPIEXEC_TIMEOUT/) { next; } + # Allow 'APPLICATION TIMED OUT' (hydra) + if (/\[mpiexec@.*\] APPLICATION TIMED OUT/) { last; } + # ANY output is an error (other than timeout) + if (! /^\s*$/) { + print STDERR "Unexpected output in $programname: $_"; + if (!$found_error) { + $found_error = 1; + $err_count ++; + } + } + } + $rc = close ( MPIOUT ); + if ($rc == 0) { + $run_status = $?; + $signal_num = $run_status & 127; + if ($run_status > 255) { $run_status >>= 8; } + } + else { + # This test *requires* non-zero return codes + if (!$found_error) { + $found_error = 1; + $err_count ++; + } + $inline .= "$mpiexec returned a zero status but the program returned a nonzero status\n"; + } + # + # Here should go a check of the processes + # open( PFD, "ps -fu $LOGNAME | grep -v grep | grep $programname |" ); + # while () { + # + # } + # close PFD; + return ($found_error,$inline); +} +# +# TestErrFatal is a special test that reports success *only* when the +# status return is NONZERO; it ignores error messages +sub TestErrFatal { + my $MPIOUT = $_[0]; + my $programname = $_[1]; + my $found_error = 0; + + my $inline = ""; + while (<$MPIOUT>) { + #print STDOUT $_ if $verbose; + # Skip FORTRAN STOP + if (/FORTRAN STOP/) { next; } + $inline .= $_; + # ALL output is allowed. + } + $rc = close ( MPIOUT ); + if ($rc == 0) { + $run_status = $?; + $signal_num = $run_status & 127; + if ($run_status > 255) { $run_status >>= 8; } + } + else { + # This test *requires* non-zero return codes + if (!$found_error) { + $found_error = 1; + $err_count ++; + } + $inline .= "$mpiexec returned a zero status but the program returned a nonzero status\n"; + } + return ($found_error,$inline); +} + +# ---------------------------------------------------------------------------- +# Output routines: +# RunPreMsg( programname, np, workdir ) - Call before running a program +# RunTestFailed, RunTestPassed - Call after test +# RunPostMsg - Call at end of each test +# +sub RunPreMsg { + my ($programname,$np,$workdir) = @_; + if ($xmloutput) { + print XMLOUT "$newline$programname$newline"; + print XMLOUT "$np$newline"; + print XMLOUT "$workdir$newline"; + } +} +sub RunPostMsg { + my ($programname, $np, $workdir) = @_; + if ($xmloutput) { + print XMLOUT "$newline"; + } +} +sub RunTestPassed { + my ($programname, $np, $workdir, $xfail) = @_; + if ($xmloutput) { + print XMLOUT "pass$newline"; + } + if ($tapoutput) { + my $xfailstr = ''; + if ($xfail ne '') { + $xfailstr = " # TODO $xfail"; + } + print TAPOUT "ok ${total_run} - $workdir/$programname ${np}${xfailstr}\n"; + } +} +sub RunTestFailed { + my $programname = shift; + my $np = shift; + my $workdir = shift; + my $output = shift; + my $xfail = shift; + + if ($xmloutput) { + my $xout = $output; + # basic escapes that wreck the XML output + $xout =~ s//\*AMP\*gt;/g; + $xout =~ s/&/\*AMP\*amp;/g; + $xout =~ s/\*AMP\*/&/g; + # TODO: Also capture any non-printing characters (XML doesn't like them + # either). + print XMLOUT "fail$newline"; + print XMLOUT "$newline$xout$newline"; + } + + if ($tapoutput) { + my $xfailstr = ''; + if ($xfail ne '') { + $xfailstr = " # TODO $xfail"; + } + print TAPOUT "not ok ${total_run} - $workdir/$programname ${np}${xfailstr}\n"; + print TAPOUT " ---\n"; + print TAPOUT " Directory: $workdir\n"; + print TAPOUT " File: $programname\n"; + print TAPOUT " Num-procs: $np\n"; + print TAPOUT " Date: \"" . localtime . "\"\n"; + + # The following would be nice, but it leads to unfortunate formatting in + # the Jenkins web output for now. Using comment lines instead, since + # they are easier to read/find in a browser. +## print TAPOUT " Output: |\n"; +## # using block literal format, requires that all chars are printable +## # UTF-8 (or UTF-16, but we won't encounter that) +## foreach my $line (split m/\r?\n/, $output) { +## chomp $line; +## # 4 spaces, 2 for TAP indent, 2 more for YAML block indent +## print TAPOUT " $line\n"; +## } + + print TAPOUT " ...\n"; + + # Alternative to the "Output:" YAML block literal above. Do not put any + # spaces before the '#', this causes some TAP parsers (including Perl's + # TAP::Parser) to treat the line as "unknown" instead of a proper + # comment. + print TAPOUT "## Test output (expected 'No Errors'):\n"; + foreach my $line (split m/\r?\n/, $output) { + chomp $line; + print TAPOUT "## $line\n"; + } + } +} + +sub SkippedTest { + my $programname = shift; + my $np = shift; + my $workdir = shift; + my $reason = shift; + + # simply omit from the XML output + + if ($tapoutput) { + print TAPOUT "ok ${total_seen} - $workdir/$programname $np # SKIP $reason\n"; + } +} + +# ---------------------------------------------------------------------------- +# Alternate init routines +sub InitQuickTimeout { + $ENV{"MPIEXEC_TIMEOUT"} = 10; +} diff --git a/teshsuite/smpi/mpich3-test/testlist b/teshsuite/smpi/mpich3-test/testlist new file mode 100644 index 0000000000..f4764eed5a --- /dev/null +++ b/teshsuite/smpi/mpich3-test/testlist @@ -0,0 +1,23 @@ +# The next item ensures that the support routines are built first +!util:all +attr +#basic +coll +comm +datatype +#errhan +group +#info +init +#mpi_t +pt2pt +# +#spawn +#topo +#perf +#io +#f77 +#cxx +# +# +