[mpich-commits] [mpich] MPICH primary repository branch, master, updated. v3.1-142-gba2493d

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "MPICH primary repository". The branch, master has been updated via ba2493db4f8afd10507cce3a61c1a44764f0fcae (commit) via 688689c3efe2701c1789d95ffb03c952dc447202 (commit) from 4d106d4b77560638cfae0c6b98259376d1394dbd (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- http://git.mpich.org/mpich.git/commitdiff/ba2493db4f8afd10507cce3a61c1a44764... commit ba2493db4f8afd10507cce3a61c1a44764f0fcae Author: Wesley Bland <[email protected]> Date: Wed Jan 22 11:06:01 2014 -0600 Add the universe check to the fortran spawn tests This adds the same checks as the previous commit to the fortran tests. For the most part, the F77 tests are copied over to the F90 tests so little was added to the F90 directory. Fixes #1699 Signed-off-by: Ken Raffenetti <[email protected]> diff --git a/test/mpi/f77/spawn/spawnargvf.f b/test/mpi/f77/spawn/spawnargvf.f index edfbad0..7eea404 100644 --- a/test/mpi/f77/spawn/spawnargvf.f +++ b/test/mpi/f77/spawn/spawnargvf.f @@ -22,6 +22,7 @@ C implicit none data inargv /"a", "b=c", "d e", "-pf", " Ss", " " / data outargv /"a", "b=c", "d e", "-pf", " Ss", " " / integer ierr + integer can_spawn errs = 0 np = 2 @@ -29,6 +30,12 @@ C implicit none call MTest_Init( ierr ) + call MTestSpawnPossible( can_spawn, errs ) + if ( can_spawn .eq. 0 ) then + call MTest_Finalize( errs ) + goto 300 + endif + call MPI_Comm_get_parent( parentcomm, ierr ) if (parentcomm .eq. MPI_COMM_NULL) then @@ -115,5 +122,6 @@ C Note that the MTest_Finalize get errs only over COMM_WORLD call MTest_Finalize( errs ) endif + 300 continue call MPI_Finalize( ierr ) end diff --git a/test/mpi/f77/spawn/spawnf.f b/test/mpi/f77/spawn/spawnf.f index 0aef2fd..138bf60 100644 --- a/test/mpi/f77/spawn/spawnf.f +++ b/test/mpi/f77/spawn/spawnf.f @@ -13,12 +13,19 @@ C integer parentcomm, intercomm integer status(MPI_STATUS_SIZE) integer ierr + integer can_spawn errs = 0 np = 2 call MTest_Init( ierr ) + call MTestSpawnPossible( can_spawn, errs ) + if ( can_spawn .eq. 0 ) then + call MTest_Finalize( errs ) + goto 300 + endif + call MPI_Comm_get_parent( parentcomm, ierr ) if (parentcomm .eq. MPI_COMM_NULL) then @@ -87,5 +94,6 @@ C Errors" if both call MTest_Finalize call MTest_Finalize( errs ) endif + 300 continue call MPI_Finalize( ierr ) end diff --git a/test/mpi/f77/spawn/spawnmult2f.f b/test/mpi/f77/spawn/spawnmult2f.f index 6ecd4c2..e8d1f00 100644 --- a/test/mpi/f77/spawn/spawnmult2f.f +++ b/test/mpi/f77/spawn/spawnmult2f.f @@ -22,10 +22,18 @@ C integer appnum logical flag integer ierr + integer can_spawn + errs = 0 call MTest_Init( ierr ) + call MTestSpawnPossible( can_spawn, errs ) + if ( can_spawn .eq. 0 ) then + call MTest_Finalize( errs ) + goto 300 + endif + call MPI_Comm_get_parent( parentcomm, ierr ) if (parentcomm .eq. MPI_COMM_NULL) then @@ -121,5 +129,6 @@ C Note that the MTest_Finalize get errs only over COMM_WORLD call MTest_Finalize( errs ) endif + 300 continue call MPI_Finalize( ierr ) end diff --git a/test/mpi/f77/spawn/spawnmultf.f b/test/mpi/f77/spawn/spawnmultf.f index f8ed9f4..353b64a 100644 --- a/test/mpi/f77/spawn/spawnmultf.f +++ b/test/mpi/f77/spawn/spawnmultf.f @@ -24,6 +24,7 @@ C implicit none character*(80) argv(64) integer argc integer ierr + integer can_spawn C C Arguments are stored by rows, not columns in the vector. C We write the data in a way that looks like the transpose, @@ -45,6 +46,12 @@ C since Fortran stores by column call MTest_Init( ierr ) + call MTestSpawnPossible( can_spawn, errs ) + if ( can_spawn .eq. 0 ) then + call MTest_Finalize( errs ) + goto 300 + endif + call MPI_Comm_get_parent( parentcomm, ierr ) if (parentcomm .eq. MPI_COMM_NULL) then @@ -143,5 +150,6 @@ C Note that the MTest_Finalize get errs only over COMM_WORLD call MTest_Finalize( errs ) endif + 300 continue call MPI_Finalize( ierr ) end diff --git a/test/mpi/f77/util/mtestf.f b/test/mpi/f77/util/mtestf.f index 81edc25..9286464 100644 --- a/test/mpi/f77/util/mtestf.f +++ b/test/mpi/f77/util/mtestf.f @@ -111,3 +111,43 @@ C print *, msg, ": Error class ", errclass, " $ (", string(1:slen), ")" end + + subroutine MTestSpawnPossible( can_spawn, errs ) + implicit none + include 'mpif.h' + integer can_spawn + integer errs + integer val, ierror + logical flag + integer comm_size + + call mpi_comm_get_attr( MPI_COMM_WORLD, MPI_UNIVERSE_SIZE, val, + & flag, ierror ) + if ( ierror .ne. MPI_SUCCESS ) then +C MPI_UNIVERSE_SIZE keyval missing from MPI_COMM_WORLD attributes + can_spawn = -1 + errs = errs + 1 + else + if ( flag ) then + comm_size = -1 + + call mpi_comm_size( MPI_COMM_WORLD, comm_size, ierror ) + if ( ierror .ne. MPI_SUCCESS ) then +C MPI_COMM_SIZE failed for MPI_COMM_WORLD + can_spawn = -1 + errs = errs + 1 + return + endif + + if ( val .le. comm_size ) then +C no additional processes can be spawned + can_spawn = 0 + else + can_spawn = 1 + endif + else +C No attribute associated with key MPI_UNIVERSE_SIZE of MPI_COMM_WORLD + can_spawn = -1 + endif + endif + end diff --git a/test/mpi/f90/spawn/spawnargvf03.f90 b/test/mpi/f90/spawn/spawnargvf03.f90 index 7f35990..24a0481 100644 --- a/test/mpi/f90/spawn/spawnargvf03.f90 +++ b/test/mpi/f90/spawn/spawnargvf03.f90 @@ -21,6 +21,8 @@ data inargv /"a", "b=c", "d e", "-pf", " Ss", " " / data outargv /"a", "b=c", "d e", "-pf", " Ss", " " / integer ierr + integer comm_size + integer can_spawn errs = 0 np = 2 @@ -28,6 +30,12 @@ call MTest_Init( ierr ) + call MTestSpawnPossible( can_spawn, errs ) + if ( can_spawn .eq. 0 ) then + call MTest_Finalize( errs ) + goto 300 + endif + call MPI_Comm_get_parent( parentcomm, ierr ) if (parentcomm .eq. MPI_COMM_NULL) then @@ -114,5 +122,6 @@ call MTest_Finalize( errs ) endif + 300 continue call MPI_Finalize( ierr ) end diff --git a/test/mpi/f90/spawn/spawnmultf03.f90 b/test/mpi/f90/spawn/spawnmultf03.f90 index a97f446..e381a9b 100644 --- a/test/mpi/f90/spawn/spawnmultf03.f90 +++ b/test/mpi/f90/spawn/spawnmultf03.f90 @@ -21,6 +21,7 @@ character*(80) argv(64) integer argc integer ierr + integer can_spawn ! ! Arguments are stored by rows, not columns in the vector. ! We write the data in a way that looks like the transpose, @@ -42,6 +43,12 @@ call MTest_Init( ierr ) + call MTestSpawnPossible( can_spawn, errs ) + if ( can_spawn .eq. 0 ) then + call MTest_Finalize( errs ) + goto 300 + endif + call MPI_Comm_get_parent( parentcomm, ierr ) if (parentcomm .eq. MPI_COMM_NULL) then @@ -140,5 +147,6 @@ call MTest_Finalize( errs ) endif + 300 continue call MPI_Finalize( ierr ) end http://git.mpich.org/mpich.git/commitdiff/688689c3efe2701c1789d95ffb03c952dc... commit 688689c3efe2701c1789d95ffb03c952dc447202 Author: Wesley Bland <[email protected]> Date: Tue Jan 21 15:56:33 2014 -0600 Adds universe check to C spawn tests The test suite assumes that it is running on a system where MPI_COMM_SPAWN(_MULTIPLE) is possible. This isn't true on all systems and thus prevents the test suite from being useful everywhere. This check (contributed by Jeff H. - [email protected]) looks to see if the MPI_COMM_WORLD attribute MPI_UNIVERSE_SIZE is available and actually greater than the size of MPI_COMM_WORLD. If the spawn tests will fail because spawning is not possible on the system (whether because the universe size is too small or spawning is not supported), the tests will return success (unless there was some error in the detection process). Signed-off-by: Ken Raffenetti <[email protected]> diff --git a/test/mpi/include/mpitest.h b/test/mpi/include/mpitest.h index 056e333..292033a 100644 --- a/test/mpi/include/mpitest.h +++ b/test/mpi/include/mpitest.h @@ -68,6 +68,8 @@ const char *MTestGetIntracommName( void ); const char *MTestGetIntercommName( void ); void MTestFreeComm( MPI_Comm * ); +int MTestSpawnPossible( int * ); + #ifdef HAVE_MPI_WIN_CREATE int MTestGetWin( MPI_Win *, int ); const char *MTestGetWinName( void ); diff --git a/test/mpi/include/mpitestcxx.h b/test/mpi/include/mpitestcxx.h index 57d15c2..32d3131 100644 --- a/test/mpi/include/mpitestcxx.h +++ b/test/mpi/include/mpitestcxx.h @@ -56,6 +56,8 @@ const char *MTestGetIntracommName( void ); const char *MTestGetIntercommName( void ); void MTestFreeComm( MPI::Comm &comm ); +int MTestSpawnPossible( int * ); + #ifdef HAVE_MPI_WIN_CREATE int MTestGetWin( MPI::Win &, bool ); const char *MTestGetWinName( void ); diff --git a/test/mpi/spawn/concurrent_spawns.c b/test/mpi/spawn/concurrent_spawns.c index df82b13..389e517 100644 --- a/test/mpi/spawn/concurrent_spawns.c +++ b/test/mpi/spawn/concurrent_spawns.c @@ -47,6 +47,7 @@ int main(int argc, char *argv[]) MPI_Status status; int verbose = 0; char *env; + int can_spawn; env = getenv("MPITEST_VERBOSE"); if (env) @@ -57,75 +58,81 @@ int main(int argc, char *argv[]) MTest_Init( &argc, &argv ); - /* Set the num_spawns for the first process to MAX_NUM_SPAWNS */ - MPI_Comm_get_parent( &parentcomm ); - if (parentcomm == MPI_COMM_NULL) - { - num_spawns = MAX_NUM_SPAWNS; - } - - /* If an argument is passed in use it for num_spawns */ - /* This is the case for all spawned processes and optionally the first - process as well */ - if (argc > 1) - { - num_spawns = atoi(argv[1]); - if (num_spawns < 0) - num_spawns = 0; - if (num_spawns > MAX_NUM_SPAWNS) - num_spawns = MAX_NUM_SPAWNS; - } - - /* Send num_spawns - 1 on the command line to the spawned children */ - sprintf(child_spawns, "%d", num_spawns-1 > 0 ? num_spawns-1 : 0); - - /* Spawn the children */ - IF_VERBOSE(("spawning %d\n", num_spawns)); - for (i=0; i<num_spawns; i++) - { - if (argc > 2) - { - sprintf(description, "%s:%d", argv[2], i); - } - else - { - sprintf(description, "%d", i); - } - IF_VERBOSE(("spawning %s\n", description)); - MPI_Comm_spawn((char*)"./concurrent_spawns", argv1, 1, - MPI_INFO_NULL, 0, MPI_COMM_WORLD, - &intercomm[i], MPI_ERRCODES_IGNORE); - - MPI_Comm_remote_size(intercomm[i], &rsize); - MPI_Comm_size(intercomm[i], &size); - if (rsize != 1) - { - errs++; - printf("Did not create 1 process (got %d)\n", rsize); - fflush(stdout); - } - } - - /* Receive the error count from each of your children and add it to your - error count */ - for (i=0; i<num_spawns; i++) - { - MPI_Recv(&child_errs, 1, MPI_INT, 0, 0, intercomm[i], &status); - errs += child_errs; - MPI_Comm_disconnect( &intercomm[i] ); - } - - /* If you are a spawned process send your errors to your parent */ - if (parentcomm != MPI_COMM_NULL) - { - MPI_Send(&errs, 1, MPI_INT, 0, 0, parentcomm); - MPI_Comm_disconnect( &parentcomm ); - } - else { - /* Note that the MTest_Finalize get errs only over COMM_WORLD */ - /* Note also that both the parent and child will generate "No Errors" - if both call MTest_Finalize */ - MTest_Finalize( errs ); + errs += MTestSpawnPossible(&can_spawn); + + if (can_spawn) { + /* Set the num_spawns for the first process to MAX_NUM_SPAWNS */ + MPI_Comm_get_parent( &parentcomm ); + if (parentcomm == MPI_COMM_NULL) + { + num_spawns = MAX_NUM_SPAWNS; + } + + /* If an argument is passed in use it for num_spawns */ + /* This is the case for all spawned processes and optionally the first + process as well */ + if (argc > 1) + { + num_spawns = atoi(argv[1]); + if (num_spawns < 0) + num_spawns = 0; + if (num_spawns > MAX_NUM_SPAWNS) + num_spawns = MAX_NUM_SPAWNS; + } + + /* Send num_spawns - 1 on the command line to the spawned children */ + sprintf(child_spawns, "%d", num_spawns-1 > 0 ? num_spawns-1 : 0); + + /* Spawn the children */ + IF_VERBOSE(("spawning %d\n", num_spawns)); + for (i=0; i<num_spawns; i++) + { + if (argc > 2) + { + sprintf(description, "%s:%d", argv[2], i); + } + else + { + sprintf(description, "%d", i); + } + IF_VERBOSE(("spawning %s\n", description)); + MPI_Comm_spawn((char*)"./concurrent_spawns", argv1, 1, + MPI_INFO_NULL, 0, MPI_COMM_WORLD, + &intercomm[i], MPI_ERRCODES_IGNORE); + + MPI_Comm_remote_size(intercomm[i], &rsize); + MPI_Comm_size(intercomm[i], &size); + if (rsize != 1) + { + errs++; + printf("Did not create 1 process (got %d)\n", rsize); + fflush(stdout); + } + } + + /* Receive the error count from each of your children and add it to your + error count */ + for (i=0; i<num_spawns; i++) + { + MPI_Recv(&child_errs, 1, MPI_INT, 0, 0, intercomm[i], &status); + errs += child_errs; + MPI_Comm_disconnect( &intercomm[i] ); + } + + /* If you are a spawned process send your errors to your parent */ + if (parentcomm != MPI_COMM_NULL) + { + MPI_Send(&errs, 1, MPI_INT, 0, 0, parentcomm); + MPI_Comm_disconnect( &parentcomm ); + } + else { + /* Note that the MTest_Finalize get errs only over COMM_WORLD */ + /* Note also that both the parent and child will generate "No Errors" + if both call MTest_Finalize */ + MTest_Finalize( errs ); + } + } else { + MTest_Finalize( errs ); } IF_VERBOSE(("calling finalize\n")); diff --git a/test/mpi/spawn/disconnect.c b/test/mpi/spawn/disconnect.c index 64682f6..47aadc7 100644 --- a/test/mpi/spawn/disconnect.c +++ b/test/mpi/spawn/disconnect.c @@ -29,6 +29,7 @@ int main(int argc, char *argv[]) MPI_Comm parentcomm, intercomm; int verbose = 0; char *env; + int can_spawn; env = getenv("MPITEST_VERBOSE"); if (env) @@ -39,75 +40,81 @@ int main(int argc, char *argv[]) MTest_Init( &argc, &argv ); - MPI_Comm_get_parent( &parentcomm ); + errs += MTestSpawnPossible(&can_spawn); - if (parentcomm == MPI_COMM_NULL) - { - IF_VERBOSE(("spawning %d processes\n", np)); - /* Create 3 more processes */ - MPI_Comm_spawn((char*)"./disconnect", MPI_ARGV_NULL, np, - MPI_INFO_NULL, 0, MPI_COMM_WORLD, - &intercomm, MPI_ERRCODES_IGNORE); - } - else - { - intercomm = parentcomm; - } + if (can_spawn) { + MPI_Comm_get_parent( &parentcomm ); - /* We now have a valid intercomm */ + if (parentcomm == MPI_COMM_NULL) + { + IF_VERBOSE(("spawning %d processes\n", np)); + /* Create 3 more processes */ + MPI_Comm_spawn((char*)"./disconnect", MPI_ARGV_NULL, np, + MPI_INFO_NULL, 0, MPI_COMM_WORLD, + &intercomm, MPI_ERRCODES_IGNORE); + } + else + { + intercomm = parentcomm; + } - MPI_Comm_remote_size(intercomm, &rsize); - MPI_Comm_size(intercomm, &size); - MPI_Comm_rank(intercomm, &rank); + /* We now have a valid intercomm */ - if (parentcomm == MPI_COMM_NULL) - { - IF_VERBOSE(("parent rank %d alive.\n", rank)); - /* Parent */ - if (rsize != np) - { - errs++; - printf("Did not create %d processes (got %d)\n", np, rsize); - fflush(stdout); - } - IF_VERBOSE(("disconnecting child communicator\n")); - MPI_Comm_disconnect(&intercomm); - - /* Errors cannot be sent back to the parent because there is no - communicator connected to the children - for (i=0; i<rsize; i++) - { - MPI_Recv( &err, 1, MPI_INT, i, 1, intercomm, MPI_STATUS_IGNORE ); - errs += err; - } - */ - } - else - { - IF_VERBOSE(("child rank %d alive.\n", rank)); - /* Child */ - if (size != np) - { - errs++; - printf("(Child) Did not create %d processes (got %d)\n", np, size); - fflush(stdout); - } - - IF_VERBOSE(("disconnecting communicator\n")); - MPI_Comm_disconnect(&intercomm); - - /* Send the errs back to the master process */ - /* Errors cannot be sent back to the parent because there is no - communicator connected to the parent */ - /*MPI_Ssend( &errs, 1, MPI_INT, 0, 1, intercomm );*/ - } + MPI_Comm_remote_size(intercomm, &rsize); + MPI_Comm_size(intercomm, &size); + MPI_Comm_rank(intercomm, &rank); - /* Note that the MTest_Finalize get errs only over COMM_WORLD */ - /* Note also that both the parent and child will generate "No Errors" - if both call MTest_Finalize */ - if (parentcomm == MPI_COMM_NULL) - { - MTest_Finalize( errs ); + if (parentcomm == MPI_COMM_NULL) + { + IF_VERBOSE(("parent rank %d alive.\n", rank)); + /* Parent */ + if (rsize != np) + { + errs++; + printf("Did not create %d processes (got %d)\n", np, rsize); + fflush(stdout); + } + IF_VERBOSE(("disconnecting child communicator\n")); + MPI_Comm_disconnect(&intercomm); + + /* Errors cannot be sent back to the parent because there is no + communicator connected to the children + for (i=0; i<rsize; i++) + { + MPI_Recv( &err, 1, MPI_INT, i, 1, intercomm, MPI_STATUS_IGNORE ); + errs += err; + } + */ + } + else + { + IF_VERBOSE(("child rank %d alive.\n", rank)); + /* Child */ + if (size != np) + { + errs++; + printf("(Child) Did not create %d processes (got %d)\n", np, size); + fflush(stdout); + } + + IF_VERBOSE(("disconnecting communicator\n")); + MPI_Comm_disconnect(&intercomm); + + /* Send the errs back to the master process */ + /* Errors cannot be sent back to the parent because there is no + communicator connected to the parent */ + /*MPI_Ssend( &errs, 1, MPI_INT, 0, 1, intercomm );*/ + } + + /* Note that the MTest_Finalize get errs only over COMM_WORLD */ + /* Note also that both the parent and child will generate "No Errors" + if both call MTest_Finalize */ + if (parentcomm == MPI_COMM_NULL) + { + MTest_Finalize( errs ); + } + } else { + MTest_Finalize( errs ); } IF_VERBOSE(("calling finalize\n")); diff --git a/test/mpi/spawn/disconnect2.c b/test/mpi/spawn/disconnect2.c index 55a289c..d8259c4 100644 --- a/test/mpi/spawn/disconnect2.c +++ b/test/mpi/spawn/disconnect2.c @@ -34,6 +34,7 @@ int main(int argc, char *argv[]) MPI_Status status; int verbose = 0; char *env; + int can_spawn; env = getenv("MPITEST_VERBOSE"); if (env) @@ -44,102 +45,108 @@ int main(int argc, char *argv[]) MTest_Init( &argc, &argv ); - MPI_Comm_get_parent( &parentcomm ); - - if (parentcomm == MPI_COMM_NULL) - { - IF_VERBOSE(("spawning %d processes\n", np)); - /* Create 3 more processes */ - MPI_Comm_spawn((char*)"./disconnect2", MPI_ARGV_NULL, np, - MPI_INFO_NULL, 0, MPI_COMM_WORLD, - &intercomm, MPI_ERRCODES_IGNORE); - } - else - { - intercomm = parentcomm; - } - - /* We now have a valid intercomm */ - - MPI_Comm_remote_size(intercomm, &rsize); - MPI_Comm_size(intercomm, &size); - MPI_Comm_rank(intercomm, &rank); - - if (parentcomm == MPI_COMM_NULL) - { - IF_VERBOSE(("parent rank %d alive.\n", rank)); - /* Parent */ - if (rsize != np) - { - errs++; - printf("Did not create %d processes (got %d)\n", np, rsize); - fflush(stdout); - } - if (rank == SENDER_RANK) - { - IF_VERBOSE(("sending int\n")); - i = DATA_VALUE; - MPI_Send(&i, 1, MPI_INT, RECEIVER_RANK, DATA_TAG, intercomm); - MPI_Recv(&data, 1, MPI_INT, RECEIVER_RANK, DATA_TAG, intercomm, - &status); - if (data != i) - { - errs++; - } - } - IF_VERBOSE(("disconnecting child communicator\n")); - MPI_Comm_disconnect(&intercomm); - - /* Errors cannot be sent back to the parent because there is no - communicator connected to the children - for (i=0; i<rsize; i++) - { - MPI_Recv( &err, 1, MPI_INT, i, 1, intercomm, MPI_STATUS_IGNORE ); - errs += err; - } - */ - } - else - { - IF_VERBOSE(("child rank %d alive.\n", rank)); - /* Child */ - if (size != np) - { - errs++; - printf("(Child) Did not create %d processes (got %d)\n", np, size); - fflush(stdout); - } - - if (rank == RECEIVER_RANK) - { - IF_VERBOSE(("receiving int\n")); - i = -1; - MPI_Recv(&i, 1, MPI_INT, SENDER_RANK, DATA_TAG, intercomm, &status); - if (i != DATA_VALUE) - { - errs++; - printf("expected %d but received %d\n", DATA_VALUE, i); - fflush(stdout); - MPI_Abort(intercomm, 1); - } - MPI_Send(&i, 1, MPI_INT, SENDER_RANK, DATA_TAG, intercomm); - } - - IF_VERBOSE(("disconnecting communicator\n")); - MPI_Comm_disconnect(&intercomm); - - /* Send the errs back to the master process */ - /* Errors cannot be sent back to the parent because there is no - communicator connected to the parent */ - /*MPI_Ssend( &errs, 1, MPI_INT, 0, 1, intercomm );*/ - } - - /* Note that the MTest_Finalize get errs only over COMM_WORLD */ - /* Note also that both the parent and child will generate "No Errors" - if both call MTest_Finalize */ - if (parentcomm == MPI_COMM_NULL) - { - MTest_Finalize( errs ); + errs += MTestSpawnPossible(&can_spawn); + + if (can_spawn) { + MPI_Comm_get_parent( &parentcomm ); + + if (parentcomm == MPI_COMM_NULL) + { + IF_VERBOSE(("spawning %d processes\n", np)); + /* Create 3 more processes */ + MPI_Comm_spawn((char*)"./disconnect2", MPI_ARGV_NULL, np, + MPI_INFO_NULL, 0, MPI_COMM_WORLD, + &intercomm, MPI_ERRCODES_IGNORE); + } + else + { + intercomm = parentcomm; + } + + /* We now have a valid intercomm */ + + MPI_Comm_remote_size(intercomm, &rsize); + MPI_Comm_size(intercomm, &size); + MPI_Comm_rank(intercomm, &rank); + + if (parentcomm == MPI_COMM_NULL) + { + IF_VERBOSE(("parent rank %d alive.\n", rank)); + /* Parent */ + if (rsize != np) + { + errs++; + printf("Did not create %d processes (got %d)\n", np, rsize); + fflush(stdout); + } + if (rank == SENDER_RANK) + { + IF_VERBOSE(("sending int\n")); + i = DATA_VALUE; + MPI_Send(&i, 1, MPI_INT, RECEIVER_RANK, DATA_TAG, intercomm); + MPI_Recv(&data, 1, MPI_INT, RECEIVER_RANK, DATA_TAG, intercomm, + &status); + if (data != i) + { + errs++; + } + } + IF_VERBOSE(("disconnecting child communicator\n")); + MPI_Comm_disconnect(&intercomm); + + /* Errors cannot be sent back to the parent because there is no + communicator connected to the children + for (i=0; i<rsize; i++) + { + MPI_Recv( &err, 1, MPI_INT, i, 1, intercomm, MPI_STATUS_IGNORE ); + errs += err; + } + */ + } + else + { + IF_VERBOSE(("child rank %d alive.\n", rank)); + /* Child */ + if (size != np) + { + errs++; + printf("(Child) Did not create %d processes (got %d)\n", np, size); + fflush(stdout); + } + + if (rank == RECEIVER_RANK) + { + IF_VERBOSE(("receiving int\n")); + i = -1; + MPI_Recv(&i, 1, MPI_INT, SENDER_RANK, DATA_TAG, intercomm, &status); + if (i != DATA_VALUE) + { + errs++; + printf("expected %d but received %d\n", DATA_VALUE, i); + fflush(stdout); + MPI_Abort(intercomm, 1); + } + MPI_Send(&i, 1, MPI_INT, SENDER_RANK, DATA_TAG, intercomm); + } + + IF_VERBOSE(("disconnecting communicator\n")); + MPI_Comm_disconnect(&intercomm); + + /* Send the errs back to the master process */ + /* Errors cannot be sent back to the parent because there is no + communicator connected to the parent */ + /*MPI_Ssend( &errs, 1, MPI_INT, 0, 1, intercomm );*/ + } + + /* Note that the MTest_Finalize get errs only over COMM_WORLD */ + /* Note also that both the parent and child will generate "No Errors" + if both call MTest_Finalize */ + if (parentcomm == MPI_COMM_NULL) + { + MTest_Finalize( errs ); + } + } else { + MTest_Finalize( errs ); } IF_VERBOSE(("calling finalize\n")); diff --git a/test/mpi/spawn/disconnect3.c b/test/mpi/spawn/disconnect3.c index 7025d33..c4d6c92 100644 --- a/test/mpi/spawn/disconnect3.c +++ b/test/mpi/spawn/disconnect3.c @@ -34,6 +34,7 @@ int main(int argc, char *argv[]) MPI_Status status; int verbose = 0; char *env; + int can_spawn; env = getenv("MPITEST_VERBOSE"); if (env) @@ -44,102 +45,108 @@ int main(int argc, char *argv[]) MTest_Init( &argc, &argv ); - MPI_Comm_get_parent( &parentcomm ); - - if (parentcomm == MPI_COMM_NULL) - { - IF_VERBOSE(("spawning %d processes\n", np)); - /* Create 3 more processes */ - MPI_Comm_spawn((char*)"./disconnect3", MPI_ARGV_NULL, np, - MPI_INFO_NULL, 0, MPI_COMM_WORLD, - &intercomm, MPI_ERRCODES_IGNORE); - } - else - { - intercomm = parentcomm; - } - - /* We now have a valid intercomm */ - - MPI_Comm_remote_size(intercomm, &rsize); - MPI_Comm_size(intercomm, &size); - MPI_Comm_rank(intercomm, &rank); - - if (parentcomm == MPI_COMM_NULL) - { - IF_VERBOSE(("parent rank %d alive.\n", rank)); - /* Parent */ - if (rsize != np) - { - errs++; - printf("Did not create %d processes (got %d)\n", np, rsize); - fflush(stdout); - } - if (rank == SENDER_RANK) - { - IF_VERBOSE(("sending int\n")); - i = DATA_VALUE; - MPI_Send(&i, 1, MPI_INT, RECEIVER_RANK, DATA_TAG, intercomm); - MPI_Recv(&data, 1, MPI_INT, RECEIVER_RANK, DATA_TAG, intercomm, - &status); - if (data != i) - { - errs++; - } - } - IF_VERBOSE(("disconnecting child communicator\n")); - MPI_Comm_disconnect(&intercomm); - - /* Errors cannot be sent back to the parent because there is no - communicator connected to the children - for (i=0; i<rsize; i++) - { - MPI_Recv( &err, 1, MPI_INT, i, 1, intercomm, MPI_STATUS_IGNORE ); - errs += err; - } - */ - } - else - { - IF_VERBOSE(("child rank %d alive.\n", rank)); - /* Child */ - if (size != np) - { - errs++; - printf("(Child) Did not create %d processes (got %d)\n", np, size); - fflush(stdout); - } - - if (rank == RECEIVER_RANK) - { - IF_VERBOSE(("receiving int\n")); - i = -1; - MPI_Recv(&i, 1, MPI_INT, SENDER_RANK, DATA_TAG, intercomm, &status); - if (i != DATA_VALUE) - { - errs++; - printf("expected %d but received %d\n", DATA_VALUE, i); - fflush(stdout); - MPI_Abort(intercomm, 1); - } - MPI_Send(&i, 1, MPI_INT, SENDER_RANK, DATA_TAG, intercomm); - } - - IF_VERBOSE(("disconnecting communicator\n")); - MPI_Comm_disconnect(&intercomm); - - /* Send the errs back to the master process */ - /* Errors cannot be sent back to the parent because there is no - communicator connected to the parent */ - /*MPI_Ssend( &errs, 1, MPI_INT, 0, 1, intercomm );*/ - } - - /* Note that the MTest_Finalize get errs only over COMM_WORLD */ - /* Note also that both the parent and child will generate "No Errors" - if both call MTest_Finalize */ - if (parentcomm == MPI_COMM_NULL) - { - MTest_Finalize( errs ); + errs += MTestSpawnPossible(&can_spawn); + + if (can_spawn) { + MPI_Comm_get_parent( &parentcomm ); + + if (parentcomm == MPI_COMM_NULL) + { + IF_VERBOSE(("spawning %d processes\n", np)); + /* Create 3 more processes */ + MPI_Comm_spawn((char*)"./disconnect3", MPI_ARGV_NULL, np, + MPI_INFO_NULL, 0, MPI_COMM_WORLD, + &intercomm, MPI_ERRCODES_IGNORE); + } + else + { + intercomm = parentcomm; + } + + /* We now have a valid intercomm */ + + MPI_Comm_remote_size(intercomm, &rsize); + MPI_Comm_size(intercomm, &size); + MPI_Comm_rank(intercomm, &rank); + + if (parentcomm == MPI_COMM_NULL) + { + IF_VERBOSE(("parent rank %d alive.\n", rank)); + /* Parent */ + if (rsize != np) + { + errs++; + printf("Did not create %d processes (got %d)\n", np, rsize); + fflush(stdout); + } + if (rank == SENDER_RANK) + { + IF_VERBOSE(("sending int\n")); + i = DATA_VALUE; + MPI_Send(&i, 1, MPI_INT, RECEIVER_RANK, DATA_TAG, intercomm); + MPI_Recv(&data, 1, MPI_INT, RECEIVER_RANK, DATA_TAG, intercomm, + &status); + if (data != i) + { + errs++; + } + } + IF_VERBOSE(("disconnecting child communicator\n")); + MPI_Comm_disconnect(&intercomm); + + /* Errors cannot be sent back to the parent because there is no + communicator connected to the children + for (i=0; i<rsize; i++) + { + MPI_Recv( &err, 1, MPI_INT, i, 1, intercomm, MPI_STATUS_IGNORE ); + errs += err; + } + */ + } + else + { + IF_VERBOSE(("child rank %d alive.\n", rank)); + /* Child */ + if (size != np) + { + errs++; + printf("(Child) Did not create %d processes (got %d)\n", np, size); + fflush(stdout); + } + + if (rank == RECEIVER_RANK) + { + IF_VERBOSE(("receiving int\n")); + i = -1; + MPI_Recv(&i, 1, MPI_INT, SENDER_RANK, DATA_TAG, intercomm, &status); + if (i != DATA_VALUE) + { + errs++; + printf("expected %d but received %d\n", DATA_VALUE, i); + fflush(stdout); + MPI_Abort(intercomm, 1); + } + MPI_Send(&i, 1, MPI_INT, SENDER_RANK, DATA_TAG, intercomm); + } + + IF_VERBOSE(("disconnecting communicator\n")); + MPI_Comm_disconnect(&intercomm); + + /* Send the errs back to the master process */ + /* Errors cannot be sent back to the parent because there is no + communicator connected to the parent */ + /*MPI_Ssend( &errs, 1, MPI_INT, 0, 1, intercomm );*/ + } + + /* Note that the MTest_Finalize get errs only over COMM_WORLD */ + /* Note also that both the parent and child will generate "No Errors" + if both call MTest_Finalize */ + if (parentcomm == MPI_COMM_NULL) + { + MTest_Finalize( errs ); + } + } else { + MTest_Finalize( errs ); } IF_VERBOSE(("calling finalize\n")); diff --git a/test/mpi/spawn/disconnect_reconnect.c b/test/mpi/spawn/disconnect_reconnect.c index eafe841..c827563 100644 --- a/test/mpi/spawn/disconnect_reconnect.c +++ b/test/mpi/spawn/disconnect_reconnect.c @@ -32,6 +32,7 @@ int main(int argc, char *argv[]) int verbose = 0; int do_messages = 1; char *env; + int can_spawn; env = getenv("MPITEST_VERBOSE"); if (env) @@ -42,146 +43,152 @@ int main(int argc, char *argv[]) MTest_Init( &argc, &argv ); - /* FIXME: Document arguments */ - if (argc > 1) { - num_loops = atoi(argv[1]); - if (num_loops < 0) - num_loops = 0; - if (num_loops > 100) - num_loops = 100; - } - if (argc > 2) - { - do_messages = atoi(argv[2]); - } - MPI_Comm_get_parent( &parentcomm ); - - if (parentcomm == MPI_COMM_NULL) - { - MPI_Comm_rank( MPI_COMM_WORLD, &rank ); /* Get rank for verbose msg */ - IF_VERBOSE(("[%d] spawning %d processes\n", rank, np)); - /* Create 3 more processes */ - MPI_Comm_spawn((char*)"./disconnect_reconnect", - /*MPI_ARGV_NULL*/&argv[1], np, - MPI_INFO_NULL, 0, MPI_COMM_WORLD, - &intercomm, MPI_ERRCODES_IGNORE); - } - else - { - intercomm = parentcomm; - } - - /* We now have a valid intercomm */ - - MPI_Comm_remote_size(intercomm, &rsize); - MPI_Comm_size(intercomm, &size); - MPI_Comm_rank(intercomm, &rank); - - if (parentcomm == MPI_COMM_NULL) - { - IF_VERBOSE(("[%d] parent rank %d alive.\n", rank, rank)); - /* Parent */ - if (rsize != np) - { - errs++; - printf("Did not create %d processes (got %d)\n", np, rsize); - fflush(stdout); - } - if (rank == 0 && num_loops > 0) - { - MPI_Open_port(MPI_INFO_NULL, port); - IF_VERBOSE(("[%d] port = %s\n", rank, port)); - MPI_Send(port, MPI_MAX_PORT_NAME, MPI_CHAR, 0, 0, intercomm); - } - IF_VERBOSE(("[%d] disconnecting child communicator\n",rank)); - MPI_Comm_disconnect(&intercomm); - for (i=0; i<num_loops; i++) - { - IF_VERBOSE(("[%d] accepting connection\n",rank)); - MPI_Comm_accept(port, MPI_INFO_NULL, 0, MPI_COMM_WORLD, &intercomm); - MPI_Comm_remote_size(intercomm, &rsize); - if (do_messages && (rank == 0)) - { - j = 0; - for (j=0; j<rsize; j++) - { - data = i; - IF_VERBOSE(("[%d]sending int to child process %d\n", rank, j)); - MPI_Send(&data, 1, MPI_INT, j, 100, intercomm); - IF_VERBOSE(("[%d] receiving int from child process %d\n", rank, j)); - data = i-1; - MPI_Recv(&data, 1, MPI_INT, j, 100, intercomm, &status); - if (data != i) - { - errs++; - } - } - } - IF_VERBOSE(("[%d] disconnecting communicator\n", rank)); - MPI_Comm_disconnect(&intercomm); - } - - /* Errors cannot be sent back to the parent because there is no - communicator connected to the children - for (i=0; i<rsize; i++) - { - MPI_Recv( &err, 1, MPI_INT, i, 1, intercomm, MPI_STATUS_IGNORE ); - errs += err; - } - */ - } - else - { - IF_VERBOSE(("[%d] child rank %d alive.\n", rank, rank)); - /* Child */ - if (size != np) - { - errs++; - printf("(Child) Did not create %d processes (got %d)\n", np, size); - fflush(stdout); - } - - if (rank == 0 && num_loops > 0) - { - IF_VERBOSE(("[%d] receiving port\n", rank)); - MPI_Recv(port, MPI_MAX_PORT_NAME, MPI_CHAR, 0, 0, intercomm, &status); - } - - IF_VERBOSE(("[%d] disconnecting communicator\n", rank)); - MPI_Comm_disconnect(&intercomm); - for (i=0; i<num_loops; i++) - { - IF_VERBOSE(("[%d] connecting to port (loop %d)\n",rank,i)); - MPI_Comm_connect(port, MPI_INFO_NULL, 0, MPI_COMM_WORLD, &intercomm); - if (do_messages) - { - IF_VERBOSE(("[%d] receiving int from parent process 0\n",rank)); - MPI_Recv(&data, 1, MPI_INT, 0, 100, intercomm, &status); - if (data != i) - { - printf("expected %d but received %d\n", i, data); - fflush(stdout); - MPI_Abort(MPI_COMM_WORLD, 1); - } - IF_VERBOSE(("[%d] sending int back to parent process 1\n",rank)); - MPI_Send(&data, 1, MPI_INT, 0, 100, intercomm); - } - IF_VERBOSE(("[%d] disconnecting communicator\n",rank)); - MPI_Comm_disconnect(&intercomm); - } - - /* Send the errs back to the master process */ - /* Errors cannot be sent back to the parent because there is no - communicator connected to the parent */ - /*MPI_Ssend( &errs, 1, MPI_INT, 0, 1, intercomm );*/ - } - - /* Note that the MTest_Finalize get errs only over COMM_WORLD */ - /* Note also that both the parent and child will generate "No Errors" - if both call MTest_Finalize */ - if (parentcomm == MPI_COMM_NULL) - { - MTest_Finalize( errs ); + errs += MTestSpawnPossible(&can_spawn); + + if (can_spawn) { + /* FIXME: Document arguments */ + if (argc > 1) { + num_loops = atoi(argv[1]); + if (num_loops < 0) + num_loops = 0; + if (num_loops > 100) + num_loops = 100; + } + if (argc > 2) + { + do_messages = atoi(argv[2]); + } + MPI_Comm_get_parent( &parentcomm ); + + if (parentcomm == MPI_COMM_NULL) + { + MPI_Comm_rank( MPI_COMM_WORLD, &rank ); /* Get rank for verbose msg */ + IF_VERBOSE(("[%d] spawning %d processes\n", rank, np)); + /* Create 3 more processes */ + MPI_Comm_spawn((char*)"./disconnect_reconnect", + /*MPI_ARGV_NULL*/&argv[1], np, + MPI_INFO_NULL, 0, MPI_COMM_WORLD, + &intercomm, MPI_ERRCODES_IGNORE); + } + else + { + intercomm = parentcomm; + } + + /* We now have a valid intercomm */ + + MPI_Comm_remote_size(intercomm, &rsize); + MPI_Comm_size(intercomm, &size); + MPI_Comm_rank(intercomm, &rank); + + if (parentcomm == MPI_COMM_NULL) + { + IF_VERBOSE(("[%d] parent rank %d alive.\n", rank, rank)); + /* Parent */ + if (rsize != np) + { + errs++; + printf("Did not create %d processes (got %d)\n", np, rsize); + fflush(stdout); + } + if (rank == 0 && num_loops > 0) + { + MPI_Open_port(MPI_INFO_NULL, port); + IF_VERBOSE(("[%d] port = %s\n", rank, port)); + MPI_Send(port, MPI_MAX_PORT_NAME, MPI_CHAR, 0, 0, intercomm); + } + IF_VERBOSE(("[%d] disconnecting child communicator\n",rank)); + MPI_Comm_disconnect(&intercomm); + for (i=0; i<num_loops; i++) + { + IF_VERBOSE(("[%d] accepting connection\n",rank)); + MPI_Comm_accept(port, MPI_INFO_NULL, 0, MPI_COMM_WORLD, &intercomm); + MPI_Comm_remote_size(intercomm, &rsize); + if (do_messages && (rank == 0)) + { + j = 0; + for (j=0; j<rsize; j++) + { + data = i; + IF_VERBOSE(("[%d]sending int to child process %d\n", rank, j)); + MPI_Send(&data, 1, MPI_INT, j, 100, intercomm); + IF_VERBOSE(("[%d] receiving int from child process %d\n", rank, j)); + data = i-1; + MPI_Recv(&data, 1, MPI_INT, j, 100, intercomm, &status); + if (data != i) + { + errs++; + } + } + } + IF_VERBOSE(("[%d] disconnecting communicator\n", rank)); + MPI_Comm_disconnect(&intercomm); + } + + /* Errors cannot be sent back to the parent because there is no + communicator connected to the children + for (i=0; i<rsize; i++) + { + MPI_Recv( &err, 1, MPI_INT, i, 1, intercomm, MPI_STATUS_IGNORE ); + errs += err; + } + */ + } + else + { + IF_VERBOSE(("[%d] child rank %d alive.\n", rank, rank)); + /* Child */ + if (size != np) + { + errs++; + printf("(Child) Did not create %d processes (got %d)\n", np, size); + fflush(stdout); + } + + if (rank == 0 && num_loops > 0) + { + IF_VERBOSE(("[%d] receiving port\n", rank)); + MPI_Recv(port, MPI_MAX_PORT_NAME, MPI_CHAR, 0, 0, intercomm, &status); + } + + IF_VERBOSE(("[%d] disconnecting communicator\n", rank)); + MPI_Comm_disconnect(&intercomm); + for (i=0; i<num_loops; i++) + { + IF_VERBOSE(("[%d] connecting to port (loop %d)\n",rank,i)); + MPI_Comm_connect(port, MPI_INFO_NULL, 0, MPI_COMM_WORLD, &intercomm); + if (do_messages) + { + IF_VERBOSE(("[%d] receiving int from parent process 0\n",rank)); + MPI_Recv(&data, 1, MPI_INT, 0, 100, intercomm, &status); + if (data != i) + { + printf("expected %d but received %d\n", i, data); + fflush(stdout); + MPI_Abort(MPI_COMM_WORLD, 1); + } + IF_VERBOSE(("[%d] sending int back to parent process 1\n",rank)); + MPI_Send(&data, 1, MPI_INT, 0, 100, intercomm); + } + IF_VERBOSE(("[%d] disconnecting communicator\n",rank)); + MPI_Comm_disconnect(&intercomm); + } + + /* Send the errs back to the master process */ + /* Errors cannot be sent back to the parent because there is no + communicator connected to the parent */ + /*MPI_Ssend( &errs, 1, MPI_INT, 0, 1, intercomm );*/ + } + + /* Note that the MTest_Finalize get errs only over COMM_WORLD */ + /* Note also that both the parent and child will generate "No Errors" + if both call MTest_Finalize */ + if (parentcomm == MPI_COMM_NULL) + { + MTest_Finalize( errs ); + } + } else { + MTest_Finalize( errs ); } IF_VERBOSE(("[%d] calling finalize\n",rank)); diff --git a/test/mpi/spawn/disconnect_reconnect2.c b/test/mpi/spawn/disconnect_reconnect2.c index 7a98909..c23d667 100644 --- a/test/mpi/spawn/disconnect_reconnect2.c +++ b/test/mpi/spawn/disconnect_reconnect2.c @@ -7,6 +7,7 @@ #include <stdio.h> #include <stdlib.h> #include <string.h> +#include "mpitest.h" /* Note: In this program, the return codes from the MPI routines are checked. Since the error handlers for the communicators are not set to @@ -49,6 +50,7 @@ int main(int argc, char *argv[]) int i, num_loops = 100; int data; int verbose = 0; + int can_spawn, errs = 0; if (getenv("MPITEST_VERBOSE")) { @@ -59,197 +61,206 @@ int main(int argc, char *argv[]) error = MPI_Init(&argc, &argv); check_error(error, "MPI_Init"); - IF_VERBOSE(("size.\n")); - error = MPI_Comm_size(MPI_COMM_WORLD, &size); - check_error(error, "MPI_Comm_size"); + errs += MTestSpawnPossible(&can_spawn); + if (!can_spawn) { + if (errs) + printf( " Found %d errors\n", errs ); + else + printf( " No Errors\n" ); + fflush(stdout); + } else { + IF_VERBOSE(("size.\n")); + error = MPI_Comm_size(MPI_COMM_WORLD, &size); + check_error(error, "MPI_Comm_size"); - IF_VERBOSE(("rank.\n")); - error = MPI_Comm_rank(MPI_COMM_WORLD, &rank); - check_error(error, "MPI_Comm_rank"); + IF_VERBOSE(("rank.\n")); + error = MPI_Comm_rank(MPI_COMM_WORLD, &rank); + check_error(error, "MPI_Comm_rank"); - if (argc == 1) - { - /* Make sure that the current directory is in the path. - Not all implementations may honor or understand this, but - it is highly recommended as it gives users a clean way - to specify the location of the executable without - specifying a particular directory format (e.g., this - should work with both Windows and Unix implementations) */ - MPI_Info_create( &spawn_path ); - MPI_Info_set( spawn_path, (char*)"path", (char*)"." ); + if (argc == 1) + { + /* Make sure that the current directory is in the path. + Not all implementations may honor or understand this, but + it is highly recommended as it gives users a clean way + to specify the location of the executable without + specifying a particular directory format (e.g., this + should work with both Windows and Unix implementations) */ + MPI_Info_create( &spawn_path ); + MPI_Info_set( spawn_path, (char*)"path", (char*)"." ); - IF_VERBOSE(("spawn connector.\n")); - error = MPI_Comm_spawn((char*)"disconnect_reconnect2", - argv1, numprocs, spawn_path, 0, - MPI_COMM_WORLD, &comm_connector, - MPI_ERRCODES_IGNORE); - check_error(error, "MPI_Comm_spawn"); + IF_VERBOSE(("spawn connector.\n")); + error = MPI_Comm_spawn((char*)"disconnect_reconnect2", + argv1, numprocs, spawn_path, 0, + MPI_COMM_WORLD, &comm_connector, + MPI_ERRCODES_IGNORE); + check_error(error, "MPI_Comm_spawn"); - IF_VERBOSE(("spawn acceptor.\n")); - error = MPI_Comm_spawn((char*)"disconnect_reconnect2", - argv2, numprocs, spawn_path, 0, - MPI_COMM_WORLD, &comm_acceptor, - MPI_ERRCODES_IGNORE); - check_error(error, "MPI_Comm_spawn"); - MPI_Info_free( &spawn_path ); + IF_VERBOSE(("spawn acceptor.\n")); + error = MPI_Comm_spawn((char*)"disconnect_reconnect2", + argv2, numprocs, spawn_path, 0, + MPI_COMM_WORLD, &comm_acceptor, + MPI_ERRCODES_IGNORE); + check_error(error, "MPI_Comm_spawn"); + MPI_Info_free( &spawn_path ); - if (rank == 0) - { - IF_VERBOSE(("recv port.\n")); - error = MPI_Recv(port, MPI_MAX_PORT_NAME, MPI_CHAR, 0, 0, - comm_acceptor, &status); - check_error(error, "MPI_Recv"); + if (rank == 0) + { + IF_VERBOSE(("recv port.\n")); + error = MPI_Recv(port, MPI_MAX_PORT_NAME, MPI_CHAR, 0, 0, + comm_acceptor, &status); + check_error(error, "MPI_Recv"); - IF_VERBOSE(("send port.\n")); - error = MPI_Send(port, MPI_MAX_PORT_NAME, MPI_CHAR, 0, 0, - comm_connector); - check_error(error, "MPI_Send"); - } + IF_VERBOSE(("send port.\n")); + error = MPI_Send(port, MPI_MAX_PORT_NAME, MPI_CHAR, 0, 0, + comm_connector); + check_error(error, "MPI_Send"); + } - IF_VERBOSE(("barrier acceptor.\n")); - error = MPI_Barrier(comm_acceptor); - check_error(error, "MPI_Barrier"); + IF_VERBOSE(("barrier acceptor.\n")); + error = MPI_Barrier(comm_acceptor); + check_error(error, "MPI_Barrier"); - IF_VERBOSE(("barrier connector.\n")); - error = MPI_Barrier(comm_connector); - check_error(error, "MPI_Barrier"); + IF_VERBOSE(("barrier connector.\n")); + error = MPI_Barrier(comm_connector); + check_error(error, "MPI_Barrier"); - error = MPI_Comm_free(&comm_acceptor); - check_error(error, "MPI_Comm_free"); - error = MPI_Comm_free(&comm_connector); - check_error(error, "MPI_Comm_free"); + error = MPI_Comm_free(&comm_acceptor); + check_error(error, "MPI_Comm_free"); + error = MPI_Comm_free(&comm_connector); + check_error(error, "MPI_Comm_free"); - if (rank == 0) - { - printf(" No Errors\n"); - fflush(stdout); - } - } - else if ((argc == 2) && (strcmp(argv[1], "acceptor") == 0)) - { - IF_VERBOSE(("get_parent.\n")); - error = MPI_Comm_get_parent(&comm_parent); - check_error(error, "MPI_Comm_get_parent"); - if (comm_parent == MPI_COMM_NULL) - { - printf("acceptor's parent is NULL.\n");fflush(stdout); - MPI_Abort(MPI_COMM_WORLD, -1); - } - if (rank == 0) - { - IF_VERBOSE(("open_port.\n")); - error = MPI_Open_port(MPI_INFO_NULL, port); - check_error(error, "MPI_Open_port"); + if (rank == 0) + { + printf(" No Errors\n"); + fflush(stdout); + } + } + else if ((argc == 2) && (strcmp(argv[1], "acceptor") == 0)) + { + IF_VERBOSE(("get_parent.\n")); + error = MPI_Comm_get_parent(&comm_parent); + check_error(error, "MPI_Comm_get_parent"); + if (comm_parent == MPI_COMM_NULL) + { + printf("acceptor's parent is NULL.\n");fflush(stdout); + MPI_Abort(MPI_COMM_WORLD, -1); + } + if (rank == 0) + { + IF_VERBOSE(("open_port.\n")); + error = MPI_Open_port(MPI_INFO_NULL, port); + check_error(error, "MPI_Open_port"); - IF_VERBOSE(("0: opened port: <%s>\n", port)); - IF_VERBOSE(("send.\n")); - error = MPI_Send(port, MPI_MAX_PORT_NAME, MPI_CHAR, 0, 0, comm_parent); - check_error(error, "MPI_Send"); - } + IF_VERBOSE(("0: opened port: <%s>\n", port)); + IF_VERBOSE(("send.\n")); + error = MPI_Send(port, MPI_MAX_PORT_NAME, MPI_CHAR, 0, 0, comm_parent); + check_error(error, "MPI_Send"); + } - for (i=0; i<num_loops; i++) - { - IF_VERBOSE(("accept.\n")); - error = MPI_Comm_accept(port, MPI_INFO_NULL, 0, MPI_COMM_WORLD, &comm); - check_error(error, "MPI_Comm_accept"); + for (i=0; i<num_loops; i++) + { + IF_VERBOSE(("accept.\n")); + error = MPI_Comm_accept(port, MPI_INFO_NULL, 0, MPI_COMM_WORLD, &comm); + check_error(error, "MPI_Comm_accept"); - if (rank == 0) - { - data = i; - error = MPI_Send(&data, 1, MPI_INT, 0, 0, comm); - check_error(error, "MPI_Send"); - error = MPI_Recv(&data, 1, MPI_INT, 0, 0, comm, &status); - check_error(error, "MPI_Recv"); - if (data != i) - { - printf("expected %d but received %d\n", i, data); - fflush(stdout); - MPI_Abort(MPI_COMM_WORLD, 1); - } - } + if (rank == 0) + { + data = i; + error = MPI_Send(&data, 1, MPI_INT, 0, 0, comm); + check_error(error, "MPI_Send"); + error = MPI_Recv(&data, 1, MPI_INT, 0, 0, comm, &status); + check_error(error, "MPI_Recv"); + if (data != i) + { + printf("expected %d but received %d\n", i, data); + fflush(stdout); + MPI_Abort(MPI_COMM_WORLD, 1); + } + } - IF_VERBOSE(("disconnect.\n")); - error = MPI_Comm_disconnect(&comm); - check_error(error, "MPI_Comm_disconnect"); - } + IF_VERBOSE(("disconnect.\n")); + error = MPI_Comm_disconnect(&comm); + check_error(error, "MPI_Comm_disconnect"); + } - if (rank == 0) - { - IF_VERBOSE(("close_port.\n")); - error = MPI_Close_port(port); - check_error(error, "MPI_Close_port"); - } + if (rank == 0) + { + IF_VERBOSE(("close_port.\n")); + error = MPI_Close_port(port); + check_error(error, "MPI_Close_port"); + } - IF_VERBOSE(("barrier.\n")); - error = MPI_Barrier(comm_parent); - check_error(error, "MPI_Barrier"); + IF_VERBOSE(("barrier.\n")); + error = MPI_Barrier(comm_parent); + check_error(error, "MPI_Barrier"); - MPI_Comm_free( &comm_parent ); - } - else if ((argc == 2) && (strcmp(argv[1], "connector") == 0)) - { - IF_VERBOSE(("get_parent.\n")); - error = MPI_Comm_get_parent(&comm_parent); - check_error(error, "MPI_Comm_get_parent"); - if (comm_parent == MPI_COMM_NULL) - { - printf("acceptor's parent is NULL.\n");fflush(stdout); - MPI_Abort(MPI_COMM_WORLD, -1); - } + MPI_Comm_free( &comm_parent ); + } + else if ((argc == 2) && (strcmp(argv[1], "connector") == 0)) + { + IF_VERBOSE(("get_parent.\n")); + error = MPI_Comm_get_parent(&comm_parent); + check_error(error, "MPI_Comm_get_parent"); + if (comm_parent == MPI_COMM_NULL) + { + printf("acceptor's parent is NULL.\n");fflush(stdout); + MPI_Abort(MPI_COMM_WORLD, -1); + } - if (rank == 0) - { - IF_VERBOSE(("recv.\n")); - error = MPI_Recv(port, MPI_MAX_PORT_NAME, MPI_CHAR, 0, 0, - comm_parent, &status); - check_error(error, "MPI_Recv"); - IF_VERBOSE(("1: received port: <%s>\n", port)); - } + if (rank == 0) + { + IF_VERBOSE(("recv.\n")); + error = MPI_Recv(port, MPI_MAX_PORT_NAME, MPI_CHAR, 0, 0, + comm_parent, &status); + check_error(error, "MPI_Recv"); + IF_VERBOSE(("1: received port: <%s>\n", port)); + } - for (i=0; i<num_loops; i++) - { - IF_VERBOSE(("connect.\n")); - error = MPI_Comm_connect(port, MPI_INFO_NULL, 0, MPI_COMM_WORLD, &comm); - check_error(error, "MPI_Comm_connect"); + for (i=0; i<num_loops; i++) + { + IF_VERBOSE(("connect.\n")); + error = MPI_Comm_connect(port, MPI_INFO_NULL, 0, MPI_COMM_WORLD, &comm); + check_error(error, "MPI_Comm_connect"); - if (rank == 0) - { - data = -1; - error = MPI_Recv(&data, 1, MPI_INT, 0, 0, comm, &status); - check_error(error, "MPI_Recv"); - if (data != i) - { - printf("expected %d but received %d\n", i, data); - fflush(stdout); - MPI_Abort(MPI_COMM_WORLD, 1); - } - error = MPI_Send(&data, 1, MPI_INT, 0, 0, comm); - check_error(error, "MPI_Send"); - } + if (rank == 0) + { + data = -1; + error = MPI_Recv(&data, 1, MPI_INT, 0, 0, comm, &status); + check_error(error, "MPI_Recv"); + if (data != i) + { + printf("expected %d but received %d\n", i, data); + fflush(stdout); + MPI_Abort(MPI_COMM_WORLD, 1); + } + error = MPI_Send(&data, 1, MPI_INT, 0, 0, comm); + check_error(error, "MPI_Send"); + } - IF_VERBOSE(("disconnect.\n")); - error = MPI_Comm_disconnect(&comm); - check_error(error, "MPI_Comm_disconnect"); - } + IF_VERBOSE(("disconnect.\n")); + error = MPI_Comm_disconnect(&comm); + check_error(error, "MPI_Comm_disconnect"); + } - IF_VERBOSE(("barrier.\n")); - error = MPI_Barrier(comm_parent); - check_error(error, "MPI_Barrier"); + IF_VERBOSE(("barrier.\n")); + error = MPI_Barrier(comm_parent); + check_error(error, "MPI_Barrier"); - MPI_Comm_free( &comm_parent ); - } - else - { - printf("invalid command line.\n");fflush(stdout); - { - int ii; - for (ii=0; ii<argc; ii++) - { - printf("argv[%d] = <%s>\n", ii, argv[ii]); - } - } - fflush(stdout); - MPI_Abort(MPI_COMM_WORLD, -2); + MPI_Comm_free( &comm_parent ); + } + else + { + printf("invalid command line.\n");fflush(stdout); + { + int ii; + for (ii=0; ii<argc; ii++) + { + printf("argv[%d] = <%s>\n", ii, argv[ii]); + } + } + fflush(stdout); + MPI_Abort(MPI_COMM_WORLD, -2); + } } MPI_Finalize(); diff --git a/test/mpi/spawn/disconnect_reconnect3.c b/test/mpi/spawn/disconnect_reconnect3.c index dcf44bd..6ef155c 100644 --- a/test/mpi/spawn/disconnect_reconnect3.c +++ b/test/mpi/spawn/disconnect_reconnect3.c @@ -88,6 +88,7 @@ int main(int argc, char *argv[]) int verbose = 0; int do_messages = 1; char *env; + int can_spawn; env = getenv("MPITEST_VERBOSE"); if (env) @@ -98,143 +99,148 @@ int main(int argc, char *argv[]) MTest_Init( &argc, &argv ); - /* command line arguments can change the number of loop iterations and - whether or not messages are sent over the new communicators */ - if (argc > 1) - { - num_loops = atoi(argv[1]); - if (num_loops < 0) - num_loops = 0; - if (num_loops > 100) - num_loops = 100; - } - if (argc > 2) - { - do_messages = atoi(argv[2]); - } - - /* Spawn the child processes and merge them into a single communicator */ - MPI_Comm_get_parent( &parentcomm ); - if (parentcomm == MPI_COMM_NULL) - { - IF_VERBOSE(("spawning %d processes\n", np)); - /* Create 4 more processes */ - MPI_Comm_spawn((char*)"./disconnect_reconnect3", - /*MPI_ARGV_NULL*/&argv[1], np, - MPI_INFO_NULL, 0, MPI_COMM_WORLD, - &intercomm, MPI_ERRCODES_IGNORE); - MPI_Intercomm_merge(intercomm, 0, &intracomm); - } - else - { - intercomm = parentcomm; - MPI_Intercomm_merge(intercomm, 1, &intracomm); - } - - checkReverseMergedComm(intracomm); - - /* We now have a valid intracomm containing all processes */ - - MPI_Comm_rank(intracomm, &rank); - - /* Split the communicator so that the even ranks are in one communicator - and the odd ranks are in another */ - even_odd = rank % 2; - MPI_Comm_split(intracomm, even_odd, rank, &comm); - - /* Open a port on rank zero of the even communicator */ - /* rank 0 on intracomm == rank 0 on even communicator */ - if (rank == 0) - { - MPI_Open_port(MPI_INFO_NULL, port); - IF_VERBOSE(("port = %s\n", port)); - } - /* Broadcast the port to everyone. This makes the logic easier than - trying to figure out which process in the odd communicator to send it - to */ - MPI_Bcast(port, MPI_MAX_PORT_NAME, MPI_CHAR, 0, intracomm); - - IF_VERBOSE(("disconnecting parent/child communicator\n")); - MPI_Comm_disconnect(&intercomm); - MPI_Comm_disconnect(&intracomm); - - MPI_Comm_rank(comm, &rank); - - if (!even_odd) - { - /* The even group does the accepting */ - for (i=0; i<num_loops; i++) - { - IF_VERBOSE(("accepting connection\n")); - MPI_Comm_accept(port, MPI_INFO_NULL, 0, comm, &intercomm); - MPI_Comm_remote_size(intercomm, &rsize); - if (do_messages && (rank == 0)) - { - j = 0; - for (j=0; j<rsize; j++) - { - data = i; - IF_VERBOSE(("sending int to odd_communicator process %d\n", j)); - MPI_Send(&data, 1, MPI_INT, j, 100, intercomm); - IF_VERBOSE(("receiving int from odd_communicator process %d\n", j)); - data = i-1; - MPI_Recv(&data, 1, MPI_INT, j, 100, intercomm, &status); - if (data != i) - { - errs++; - } - } - } - IF_VERBOSE(("disconnecting communicator\n")); - MPI_Comm_disconnect(&intercomm); - } - - /* Errors cannot be sent back to the parent because there is no - communicator connected to the children - for (i=0; i<rsize; i++) - { - MPI_Recv( &err, 1, MPI_INT, i, 1, intercomm, MPI_STATUS_IGNORE ); - errs += err; - } - */ - } - else - { - /* The odd group does the connecting */ - for (i=0; i<num_loops; i++) - { - IF_VERBOSE(("connecting to port\n")); - MPI_Comm_connect(port, MPI_INFO_NULL, 0, comm, &intercomm); - if (do_messages) - { - IF_VERBOSE(("receiving int from even_communicator process 0\n")); - MPI_Recv(&data, 1, MPI_INT, 0, 100, intercomm, &status); - if (data != i) - { - printf("expected %d but received %d\n", i, data); - fflush(stdout); - MPI_Abort(MPI_COMM_WORLD, 1); - } - IF_VERBOSE(("sending int back to even_communicator process 0\n")); - MPI_Send(&data, 1, MPI_INT, 0, 100, intercomm); - } - IF_VERBOSE(("disconnecting communicator\n")); - MPI_Comm_disconnect(&intercomm); - } - - /* Send the errs back to the master process */ - /* Errors cannot be sent back to the parent because there is no - communicator connected to the parent */ - /*MPI_Ssend( &errs, 1, MPI_INT, 0, 1, intercomm );*/ - } - - MPI_Comm_free( &comm ); - /* Note that the MTest_Finalize get errs only over COMM_WORLD */ - /* Note also that both the parent and child will generate "No Errors" - if both call MTest_Finalize */ - if (parentcomm == MPI_COMM_NULL) - { - MTest_Finalize( errs ); + errs += MTestSpawnPossible(&can_spawn); + if (can_spawn) { + /* command line arguments can change the number of loop iterations and + whether or not messages are sent over the new communicators */ + if (argc > 1) + { + num_loops = atoi(argv[1]); + if (num_loops < 0) + num_loops = 0; + if (num_loops > 100) + num_loops = 100; + } + if (argc > 2) + { + do_messages = atoi(argv[2]); + } + + /* Spawn the child processes and merge them into a single communicator */ + MPI_Comm_get_parent( &parentcomm ); + if (parentcomm == MPI_COMM_NULL) + { + IF_VERBOSE(("spawning %d processes\n", np)); + /* Create 4 more processes */ + MPI_Comm_spawn((char*)"./disconnect_reconnect3", + /*MPI_ARGV_NULL*/&argv[1], np, + MPI_INFO_NULL, 0, MPI_COMM_WORLD, + &intercomm, MPI_ERRCODES_IGNORE); + MPI_Intercomm_merge(intercomm, 0, &intracomm); + } + else + { + intercomm = parentcomm; + MPI_Intercomm_merge(intercomm, 1, &intracomm); + } + + checkReverseMergedComm(intracomm); + + /* We now have a valid intracomm containing all processes */ + + MPI_Comm_rank(intracomm, &rank); + + /* Split the communicator so that the even ranks are in one communicator + and the odd ranks are in another */ + even_odd = rank % 2; + MPI_Comm_split(intracomm, even_odd, rank, &comm); + + /* Open a port on rank zero of the even communicator */ + /* rank 0 on intracomm == rank 0 on even communicator */ + if (rank == 0) + { + MPI_Open_port(MPI_INFO_NULL, port); + IF_VERBOSE(("port = %s\n", port)); + } + /* Broadcast the port to everyone. This makes the logic easier than + trying to figure out which process in the odd communicator to send it + to */ + MPI_Bcast(port, MPI_MAX_PORT_NAME, MPI_CHAR, 0, intracomm); + + IF_VERBOSE(("disconnecting parent/child communicator\n")); + MPI_Comm_disconnect(&intercomm); + MPI_Comm_disconnect(&intracomm); + + MPI_Comm_rank(comm, &rank); + + if (!even_odd) + { + /* The even group does the accepting */ + for (i=0; i<num_loops; i++) + { + IF_VERBOSE(("accepting connection\n")); + MPI_Comm_accept(port, MPI_INFO_NULL, 0, comm, &intercomm); + MPI_Comm_remote_size(intercomm, &rsize); + if (do_messages && (rank == 0)) + { + j = 0; + for (j=0; j<rsize; j++) + { + data = i; + IF_VERBOSE(("sending int to odd_communicator process %d\n", j)); + MPI_Send(&data, 1, MPI_INT, j, 100, intercomm); + IF_VERBOSE(("receiving int from odd_communicator process %d\n", j)); + data = i-1; + MPI_Recv(&data, 1, MPI_INT, j, 100, intercomm, &status); + if (data != i) + { + errs++; + } + } + } + IF_VERBOSE(("disconnecting communicator\n")); + MPI_Comm_disconnect(&intercomm); + } + + /* Errors cannot be sent back to the parent because there is no + communicator connected to the children + for (i=0; i<rsize; i++) + { + MPI_Recv( &err, 1, MPI_INT, i, 1, intercomm, MPI_STATUS_IGNORE ); + errs += err; + } + */ + } + else + { + /* The odd group does the connecting */ + for (i=0; i<num_loops; i++) + { + IF_VERBOSE(("connecting to port\n")); + MPI_Comm_connect(port, MPI_INFO_NULL, 0, comm, &intercomm); + if (do_messages) + { + IF_VERBOSE(("receiving int from even_communicator process 0\n")); + MPI_Recv(&data, 1, MPI_INT, 0, 100, intercomm, &status); + if (data != i) + { + printf("expected %d but received %d\n", i, data); + fflush(stdout); + MPI_Abort(MPI_COMM_WORLD, 1); + } + IF_VERBOSE(("sending int back to even_communicator process 0\n")); + MPI_Send(&data, 1, MPI_INT, 0, 100, intercomm); + } + IF_VERBOSE(("disconnecting communicator\n")); + MPI_Comm_disconnect(&intercomm); + } + + /* Send the errs back to the master process */ + /* Errors cannot be sent back to the parent because there is no + communicator connected to the parent */ + /*MPI_Ssend( &errs, 1, MPI_INT, 0, 1, intercomm );*/ + } + + MPI_Comm_free( &comm ); + /* Note that the MTest_Finalize get errs only over COMM_WORLD */ + /* Note also that both the parent and child will generate "No Errors" + if both call MTest_Finalize */ + if (parentcomm == MPI_COMM_NULL) + { + MTest_Finalize( errs ); + } + } else { + MTest_Finalize( errs ); } IF_VERBOSE(("calling finalize\n")); diff --git a/test/mpi/spawn/spaconacc.c b/test/mpi/spawn/spaconacc.c index 2763fa4..8fe6078 100644 --- a/test/mpi/spawn/spaconacc.c +++ b/test/mpi/spawn/spaconacc.c @@ -7,6 +7,7 @@ #include <stdio.h> #include <stdlib.h> #include <string.h> +#include "mpitest.h" #define IF_VERBOSE(a) if (verbose) { printf a ; fflush(stdout); } @@ -35,6 +36,7 @@ int main(int argc, char *argv[]) MPI_Status status; MPI_Info spawn_path = MPI_INFO_NULL; int verbose = 0; + int can_spawn, errs = 0; if (getenv("MPITEST_VERBOSE")) { @@ -45,158 +47,167 @@ int main(int argc, char *argv[]) error = MPI_Init(&argc, &argv); check_error(error, "MPI_Init"); - /* 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 ); - MPI_Comm_set_errhandler( MPI_COMM_SELF, MPI_ERRORS_RETURN ); - - IF_VERBOSE(("size.\n")); - error = MPI_Comm_size(MPI_COMM_WORLD, &size); - check_error(error, "MPI_Comm_size"); - - IF_VERBOSE(("rank.\n")); - error = MPI_Comm_rank(MPI_COMM_WORLD, &rank); - check_error(error, "MPI_Comm_rank"); - - if (argc == 1) - { - /* Make sure that the current directory is in the path. - Not all implementations may honor or understand this, but - it is highly recommended as it gives users a clean way - to specify the location of the executable without - specifying a particular directory format (e.g., this - should work with both Windows and Unix implementations) */ - error = MPI_Info_create( &spawn_path ); - check_error( error, "MPI_Info_create" ); - error = MPI_Info_set( spawn_path, (char*)"path", (char*)"." ); - check_error( error, "MPI_Info_set" ); - - IF_VERBOSE(("spawn connector.\n")); - error = MPI_Comm_spawn((char*)"spaconacc", argv1, 1, spawn_path, 0, - MPI_COMM_SELF, &comm_connector, - MPI_ERRCODES_IGNORE); - check_error(error, "MPI_Comm_spawn"); - - IF_VERBOSE(("spawn acceptor.\n")); - error = MPI_Comm_spawn((char*)"spaconacc", argv2, 1, spawn_path, 0, - MPI_COMM_SELF, &comm_acceptor, - MPI_ERRCODES_IGNORE); - check_error(error, "MPI_Comm_spawn"); - error = MPI_Info_free( &spawn_path ); - check_error( error, "MPI_Info_free" ); - - MPI_Comm_set_errhandler( comm_connector, MPI_ERRORS_RETURN ); - MPI_Comm_set_errhandler( comm_acceptor, MPI_ERRORS_RETURN ); - - IF_VERBOSE(("recv port.\n")); - error = MPI_Recv(port, MPI_MAX_PORT_NAME, MPI_CHAR, 0, 0, - comm_acceptor, &status); - check_error(error, "MPI_Recv"); - - IF_VERBOSE(("send port.\n")); - error = MPI_Send(port, MPI_MAX_PORT_NAME, MPI_CHAR, 0, 0, - comm_connector); - check_error(error, "MPI_Send"); - - IF_VERBOSE(("barrier acceptor.\n")); - error = MPI_Barrier(comm_acceptor); - check_error(error, "MPI_Barrier"); - - IF_VERBOSE(("barrier connector.\n")); - error = MPI_Barrier(comm_connector); - check_error(error, "MPI_Barrier"); - - error = MPI_Comm_free(&comm_acceptor); - check_error(error, "MPI_Comm_free"); - error = MPI_Comm_free(&comm_connector); - check_error(error, "MPI_Comm_free"); - - printf(" No Errors\n"); - } - else if ((argc == 2) && (strcmp(argv[1], "acceptor") == 0)) - { - IF_VERBOSE(("get_parent.\n")); - error = MPI_Comm_get_parent(&comm_parent); - check_error(error, "MPI_Comm_get_parent"); - if (comm_parent == MPI_COMM_NULL) - { - printf("acceptor's parent is NULL.\n");fflush(stdout); - MPI_Abort(MPI_COMM_WORLD, -1); - } - IF_VERBOSE(("open_port.\n")); - error = MPI_Open_port(MPI_INFO_NULL, port); - check_error(error, "MPI_Open_port"); - - MPI_Comm_set_errhandler( comm_parent, MPI_ERRORS_RETURN ); - - IF_VERBOSE(("0: opened port: <%s>\n", port)); - IF_VERBOSE(("send.\n")); - error = MPI_Send(port, MPI_MAX_PORT_NAME, MPI_CHAR, 0, 0, comm_parent); - check_error(error, "MPI_Send"); - - IF_VERBOSE(("accept.\n")); - error = MPI_Comm_accept(port, MPI_INFO_NULL, 0, MPI_COMM_SELF, &comm); - check_error(error, "MPI_Comm_accept"); - - IF_VERBOSE(("close_port.\n")); - error = MPI_Close_port(port); - check_error(error, "MPI_Close_port"); - - IF_VERBOSE(("disconnect.\n")); - error = MPI_Comm_disconnect(&comm); - check_error(error, "MPI_Comm_disconnect"); - - IF_VERBOSE(("barrier.\n")); - error = MPI_Barrier(comm_parent); - check_error(error, "MPI_Barrier"); - - MPI_Comm_free( &comm_parent ); - } - else if ((argc == 2) && (strcmp(argv[1], "connector") == 0)) - { - IF_VERBOSE(("get_parent.\n")); - error = MPI_Comm_get_parent(&comm_parent); - check_error(error, "MPI_Comm_get_parent"); - if (comm_parent == MPI_COMM_NULL) - { - printf("acceptor's parent is NULL.\n");fflush(stdout); - MPI_Abort(MPI_COMM_WORLD, -1); - } - - MPI_Comm_set_errhandler( comm_parent, MPI_ERRORS_RETURN ); - IF_VERBOSE(("recv.\n")); - error = MPI_Recv(port, MPI_MAX_PORT_NAME, MPI_CHAR, 0, 0, - comm_parent, &status); - check_error(error, "MPI_Recv"); - - IF_VERBOSE(("1: received port: <%s>\n", port)); - IF_VERBOSE(("connect.\n")); - error = MPI_Comm_connect(port, MPI_INFO_NULL, 0, MPI_COMM_SELF, &comm); - check_error(error, "MPI_Comm_connect"); - - MPI_Comm_set_errhandler( comm, MPI_ERRORS_RETURN ); - IF_VERBOSE(("disconnect.\n")); - error = MPI_Comm_disconnect(&comm); - check_error(error, "MPI_Comm_disconnect"); - - IF_VERBOSE(("barrier.\n")); - error = MPI_Barrier(comm_parent); - check_error(error, "MPI_Barrier"); - - MPI_Comm_free( &comm_parent ); - } - else - { - printf("invalid command line.\n");fflush(stdout); - { - int i; - for (i=0; i<argc; i++) - { - printf("argv[%d] = <%s>\n", i, argv[i]); - } - } - fflush(stdout); - MPI_Abort(MPI_COMM_WORLD, -2); + errs += MTestSpawnPossible(&can_spawn); + if (!can_spawn) { + if (errs) + printf( " Found %d errors\n", errs ); + else + printf( " No Errors\n" ); + fflush( stdout ); + } else { + /* 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 ); + MPI_Comm_set_errhandler( MPI_COMM_SELF, MPI_ERRORS_RETURN ); + + IF_VERBOSE(("size.\n")); + error = MPI_Comm_size(MPI_COMM_WORLD, &size); + check_error(error, "MPI_Comm_size"); + + IF_VERBOSE(("rank.\n")); + error = MPI_Comm_rank(MPI_COMM_WORLD, &rank); + check_error(error, "MPI_Comm_rank"); + + if (argc == 1) + { + /* Make sure that the current directory is in the path. + Not all implementations may honor or understand this, but + it is highly recommended as it gives users a clean way + to specify the location of the executable without + specifying a particular directory format (e.g., this + should work with both Windows and Unix implementations) */ + error = MPI_Info_create( &spawn_path ); + check_error( error, "MPI_Info_create" ); + error = MPI_Info_set( spawn_path, (char*)"path", (char*)"." ); + check_error( error, "MPI_Info_set" ); + + IF_VERBOSE(("spawn connector.\n")); + error = MPI_Comm_spawn((char*)"spaconacc", argv1, 1, spawn_path, 0, + MPI_COMM_SELF, &comm_connector, + MPI_ERRCODES_IGNORE); + check_error(error, "MPI_Comm_spawn"); + + IF_VERBOSE(("spawn acceptor.\n")); + error = MPI_Comm_spawn((char*)"spaconacc", argv2, 1, spawn_path, 0, + MPI_COMM_SELF, &comm_acceptor, + MPI_ERRCODES_IGNORE); + check_error(error, "MPI_Comm_spawn"); + error = MPI_Info_free( &spawn_path ); + check_error( error, "MPI_Info_free" ); + + MPI_Comm_set_errhandler( comm_connector, MPI_ERRORS_RETURN ); + MPI_Comm_set_errhandler( comm_acceptor, MPI_ERRORS_RETURN ); + + IF_VERBOSE(("recv port.\n")); + error = MPI_Recv(port, MPI_MAX_PORT_NAME, MPI_CHAR, 0, 0, + comm_acceptor, &status); + check_error(error, "MPI_Recv"); + + IF_VERBOSE(("send port.\n")); + error = MPI_Send(port, MPI_MAX_PORT_NAME, MPI_CHAR, 0, 0, + comm_connector); + check_error(error, "MPI_Send"); + + IF_VERBOSE(("barrier acceptor.\n")); + error = MPI_Barrier(comm_acceptor); + check_error(error, "MPI_Barrier"); + + IF_VERBOSE(("barrier connector.\n")); + error = MPI_Barrier(comm_connector); + check_error(error, "MPI_Barrier"); + + error = MPI_Comm_free(&comm_acceptor); + check_error(error, "MPI_Comm_free"); + error = MPI_Comm_free(&comm_connector); + check_error(error, "MPI_Comm_free"); + + printf(" No Errors\n"); + } + else if ((argc == 2) && (strcmp(argv[1], "acceptor") == 0)) + { + IF_VERBOSE(("get_parent.\n")); + error = MPI_Comm_get_parent(&comm_parent); + check_error(error, "MPI_Comm_get_parent"); + if (comm_parent == MPI_COMM_NULL) + { + printf("acceptor's parent is NULL.\n");fflush(stdout); + MPI_Abort(MPI_COMM_WORLD, -1); + } + IF_VERBOSE(("open_port.\n")); + error = MPI_Open_port(MPI_INFO_NULL, port); + check_error(error, "MPI_Open_port"); + + MPI_Comm_set_errhandler( comm_parent, MPI_ERRORS_RETURN ); + + IF_VERBOSE(("0: opened port: <%s>\n", port)); + IF_VERBOSE(("send.\n")); + error = MPI_Send(port, MPI_MAX_PORT_NAME, MPI_CHAR, 0, 0, comm_parent); + check_error(error, "MPI_Send"); + + IF_VERBOSE(("accept.\n")); + error = MPI_Comm_accept(port, MPI_INFO_NULL, 0, MPI_COMM_SELF, &comm); + check_error(error, "MPI_Comm_accept"); + + IF_VERBOSE(("close_port.\n")); + error = MPI_Close_port(port); + check_error(error, "MPI_Close_port"); + + IF_VERBOSE(("disconnect.\n")); + error = MPI_Comm_disconnect(&comm); + check_error(error, "MPI_Comm_disconnect"); + + IF_VERBOSE(("barrier.\n")); + error = MPI_Barrier(comm_parent); + check_error(error, "MPI_Barrier"); + + MPI_Comm_free( &comm_parent ); + } + else if ((argc == 2) && (strcmp(argv[1], "connector") == 0)) + { + IF_VERBOSE(("get_parent.\n")); + error = MPI_Comm_get_parent(&comm_parent); + check_error(error, "MPI_Comm_get_parent"); + if (comm_parent == MPI_COMM_NULL) + { + printf("acceptor's parent is NULL.\n");fflush(stdout); + MPI_Abort(MPI_COMM_WORLD, -1); + } + + MPI_Comm_set_errhandler( comm_parent, MPI_ERRORS_RETURN ); + IF_VERBOSE(("recv.\n")); + error = MPI_Recv(port, MPI_MAX_PORT_NAME, MPI_CHAR, 0, 0, + comm_parent, &status); + check_error(error, "MPI_Recv"); + + IF_VERBOSE(("1: received port: <%s>\n", port)); + IF_VERBOSE(("connect.\n")); + error = MPI_Comm_connect(port, MPI_INFO_NULL, 0, MPI_COMM_SELF, &comm); + check_error(error, "MPI_Comm_connect"); + + MPI_Comm_set_errhandler( comm, MPI_ERRORS_RETURN ); + IF_VERBOSE(("disconnect.\n")); + error = MPI_Comm_disconnect(&comm); + check_error(error, "MPI_Comm_disconnect"); + + IF_VERBOSE(("barrier.\n")); + error = MPI_Barrier(comm_parent); + check_error(error, "MPI_Barrier"); + + MPI_Comm_free( &comm_parent ); + } + else + { + printf("invalid command line.\n");fflush(stdout); + { + int i; + for (i=0; i<argc; i++) + { + printf("argv[%d] = <%s>\n", i, argv[i]); + } + } + fflush(stdout); + MPI_Abort(MPI_COMM_WORLD, -2); + } } MPI_Finalize(); diff --git a/test/mpi/spawn/spaconacc2.c b/test/mpi/spawn/spaconacc2.c index bc4a05b..d084c22 100644 --- a/test/mpi/spawn/spaconacc2.c +++ b/test/mpi/spawn/spaconacc2.c @@ -7,6 +7,7 @@ #include <stdio.h> #include <stdlib.h> #include <string.h> +#include "mpitest.h" /* Note: In this program, the return codes from the MPI routines are checked. Since the error handlers for the communicators are not set to @@ -42,6 +43,7 @@ int main(int argc, char *argv[]) MPI_Status status; MPI_Info spawn_path = MPI_INFO_NULL; int verbose = 0; + int can_spawn, errs = 0; if (getenv("MPITEST_VERBOSE")) { @@ -52,161 +54,170 @@ int main(int argc, char *argv[]) error = MPI_Init(&argc, &argv); check_error(error, "MPI_Init"); - IF_VERBOSE(("size.\n")); - error = MPI_Comm_size(MPI_COMM_WORLD, &size); - check_error(error, "MPI_Comm_size"); - - IF_VERBOSE(("rank.\n")); - error = MPI_Comm_rank(MPI_COMM_WORLD, &rank); - check_error(error, "MPI_Comm_rank"); - - if (argc == 1) - { - /* Make sure that the current directory is in the path. - Not all implementations may honor or understand this, but - it is highly recommended as it gives users a clean way - to specify the location of the executable without - specifying a particular directory format (e.g., this - should work with both Windows and Unix implementations) */ - MPI_Info_create( &spawn_path ); - MPI_Info_set( spawn_path, (char*)"path", (char*)"." ); - - IF_VERBOSE(("spawn connector.\n")); - error = MPI_Comm_spawn((char*)"spaconacc2", argv1, 1, spawn_path, 0, - MPI_COMM_SELF, &comm_connector, - MPI_ERRCODES_IGNORE); - check_error(error, "MPI_Comm_spawn"); - - IF_VERBOSE(("spawn acceptor.\n")); - error = MPI_Comm_spawn((char*)"spaconacc2", argv2, 1, spawn_path, 0, - MPI_COMM_SELF, &comm_acceptor, - MPI_ERRCODES_IGNORE); - check_error(error, "MPI_Comm_spawn"); - MPI_Info_free( &spawn_path ); - - IF_VERBOSE(("recv port.\n")); - error = MPI_Recv(port, MPI_MAX_PORT_NAME, MPI_CHAR, 0, 0, - comm_acceptor, &status); - check_error(error, "MPI_Recv"); - - IF_VERBOSE(("send port.\n")); - error = MPI_Send(port, MPI_MAX_PORT_NAME, MPI_CHAR, 0, 0, - comm_connector); - check_error(error, "MPI_Send"); - - IF_VERBOSE(("barrier acceptor.\n")); - error = MPI_Barrier(comm_acceptor); - check_error(error, "MPI_Barrier"); - - IF_VERBOSE(("barrier connector.\n")); - error = MPI_Barrier(comm_connector); - check_error(error, "MPI_Barrier"); - - error = MPI_Comm_free(&comm_acceptor); - check_error(error, "MPI_Comm_free"); - error = MPI_Comm_free(&comm_connector); - check_error(error, "MPI_Comm_free"); - - printf(" No Errors\n"); - } - else if ((argc == 2) && (strcmp(argv[1], "acceptor") == 0)) - { - IF_VERBOSE(("get_parent.\n")); - error = MPI_Comm_get_parent(&comm_parent); - check_error(error, "MPI_Comm_get_parent"); - if (comm_parent == MPI_COMM_NULL) - { - printf("acceptor's parent is NULL.\n");fflush(stdout); - MPI_Abort(MPI_COMM_WORLD, -1); - } - IF_VERBOSE(("open_port.\n")); - error = MPI_Open_port(MPI_INFO_NULL, port); - check_error(error, "MPI_Open_port"); - - IF_VERBOSE(("0: opened port: <%s>\n", port)); - IF_VERBOSE(("send.\n")); - error = MPI_Send(port, MPI_MAX_PORT_NAME, MPI_CHAR, 0, 0, comm_parent); - check_error(error, "MPI_Send"); - - IF_VERBOSE(("accept.\n")); - error = MPI_Comm_accept(port, MPI_INFO_NULL, 0, MPI_COMM_SELF, &comm); - check_error(error, "MPI_Comm_accept"); - - IF_VERBOSE(("close_port.\n")); - error = MPI_Close_port(port); - check_error(error, "MPI_Close_port"); - - /* Send some data before disconnecting */ - IF_VERBOSE(("sending int.\n")); - i = 123; - error = MPI_Send(&i, 1, MPI_INT, 0, 0, comm); - check_error(error, "MPI_Send"); - - IF_VERBOSE(("disconnect.\n")); - error = MPI_Comm_disconnect(&comm); - check_error(error, "MPI_Comm_disconnect"); - - IF_VERBOSE(("barrier.\n")); - error = MPI_Barrier(comm_parent); - check_error(error, "MPI_Barrier"); - - MPI_Comm_free( &comm_parent ); - } - else if ((argc == 2) && (strcmp(argv[1], "connector") == 0)) - { - IF_VERBOSE(("get_parent.\n")); - error = MPI_Comm_get_parent(&comm_parent); - check_error(error, "MPI_Comm_get_parent"); - if (comm_parent == MPI_COMM_NULL) - { - printf("acceptor's parent is NULL.\n");fflush(stdout); - MPI_Abort(MPI_COMM_WORLD, -1); - } - - IF_VERBOSE(("recv.\n")); - error = MPI_Recv(port, MPI_MAX_PORT_NAME, MPI_CHAR, 0, 0, - comm_parent, &status); - check_error(error, "MPI_Recv"); - - IF_VERBOSE(("1: received port: <%s>\n", port)); - IF_VERBOSE(("connect.\n")); - error = MPI_Comm_connect(port, MPI_INFO_NULL, 0, MPI_COMM_SELF, &comm); - check_error(error, "MPI_Comm_connect"); - - /* Receive some data before disconnecting */ - IF_VERBOSE(("receiving int\n")); - i = -1; - error = MPI_Recv(&i, 1, MPI_INT, 0, 0, comm, &status); - check_error(error, "MPI_Recv"); - if (i != 123) - { - printf("expected 123 but received %d\n", i); - fflush(stdout); - MPI_Abort(MPI_COMM_WORLD, 1); - } - - IF_VERBOSE(("disconnect.\n")); - error = MPI_Comm_disconnect(&comm); - check_error(error, "MPI_Comm_disconnect"); - - IF_VERBOSE(("barrier.\n")); - error = MPI_Barrier(comm_parent); - check_error(error, "MPI_Barrier"); - - MPI_Comm_free( &comm_parent ); - } - else - { - printf("invalid command line.\n");fflush(stdout); - { - int ii; - for (ii=0; ii<argc; ii++) - { - printf("argv[%d] = <%s>\n", ii, argv[ii]); - } - } - fflush(stdout); - MPI_Abort(MPI_COMM_WORLD, -2); + errs += MTestSpawnPossible(&can_spawn); + if (!can_spawn) { + if (errs) + printf( " Found %d errors\n", errs ); + else + printf( " No Errors\n" ); + fflush( stdout ); + } else { + IF_VERBOSE(("size.\n")); + error = MPI_Comm_size(MPI_COMM_WORLD, &size); + check_error(error, "MPI_Comm_size"); + + IF_VERBOSE(("rank.\n")); + error = MPI_Comm_rank(MPI_COMM_WORLD, &rank); + check_error(error, "MPI_Comm_rank"); + + if (argc == 1) + { + /* Make sure that the current directory is in the path. + Not all implementations may honor or understand this, but + it is highly recommended as it gives users a clean way + to specify the location of the executable without + specifying a particular directory format (e.g., this + should work with both Windows and Unix implementations) */ + MPI_Info_create( &spawn_path ); + MPI_Info_set( spawn_path, (char*)"path", (char*)"." ); + + IF_VERBOSE(("spawn connector.\n")); + error = MPI_Comm_spawn((char*)"spaconacc2", argv1, 1, spawn_path, 0, + MPI_COMM_SELF, &comm_connector, + MPI_ERRCODES_IGNORE); + check_error(error, "MPI_Comm_spawn"); + + IF_VERBOSE(("spawn acceptor.\n")); + error = MPI_Comm_spawn((char*)"spaconacc2", argv2, 1, spawn_path, 0, + MPI_COMM_SELF, &comm_acceptor, + MPI_ERRCODES_IGNORE); + check_error(error, "MPI_Comm_spawn"); + MPI_Info_free( &spawn_path ); + + IF_VERBOSE(("recv port.\n")); + error = MPI_Recv(port, MPI_MAX_PORT_NAME, MPI_CHAR, 0, 0, + comm_acceptor, &status); + check_error(error, "MPI_Recv"); + + IF_VERBOSE(("send port.\n")); + error = MPI_Send(port, MPI_MAX_PORT_NAME, MPI_CHAR, 0, 0, + comm_connector); + check_error(error, "MPI_Send"); + + IF_VERBOSE(("barrier acceptor.\n")); + error = MPI_Barrier(comm_acceptor); + check_error(error, "MPI_Barrier"); + + IF_VERBOSE(("barrier connector.\n")); + error = MPI_Barrier(comm_connector); + check_error(error, "MPI_Barrier"); + + error = MPI_Comm_free(&comm_acceptor); + check_error(error, "MPI_Comm_free"); + error = MPI_Comm_free(&comm_connector); + check_error(error, "MPI_Comm_free"); + + printf(" No Errors\n"); + } + else if ((argc == 2) && (strcmp(argv[1], "acceptor") == 0)) + { + IF_VERBOSE(("get_parent.\n")); + error = MPI_Comm_get_parent(&comm_parent); + check_error(error, "MPI_Comm_get_parent"); + if (comm_parent == MPI_COMM_NULL) + { + printf("acceptor's parent is NULL.\n");fflush(stdout); + MPI_Abort(MPI_COMM_WORLD, -1); + } + IF_VERBOSE(("open_port.\n")); + error = MPI_Open_port(MPI_INFO_NULL, port); + check_error(error, "MPI_Open_port"); + + IF_VERBOSE(("0: opened port: <%s>\n", port)); + IF_VERBOSE(("send.\n")); + error = MPI_Send(port, MPI_MAX_PORT_NAME, MPI_CHAR, 0, 0, comm_parent); + check_error(error, "MPI_Send"); + + IF_VERBOSE(("accept.\n")); + error = MPI_Comm_accept(port, MPI_INFO_NULL, 0, MPI_COMM_SELF, &comm); + check_error(error, "MPI_Comm_accept"); + + IF_VERBOSE(("close_port.\n")); + error = MPI_Close_port(port); + check_error(error, "MPI_Close_port"); + + /* Send some data before disconnecting */ + IF_VERBOSE(("sending int.\n")); + i = 123; + error = MPI_Send(&i, 1, MPI_INT, 0, 0, comm); + check_error(error, "MPI_Send"); + + IF_VERBOSE(("disconnect.\n")); + error = MPI_Comm_disconnect(&comm); + check_error(error, "MPI_Comm_disconnect"); + + IF_VERBOSE(("barrier.\n")); + error = MPI_Barrier(comm_parent); + check_error(error, "MPI_Barrier"); + + MPI_Comm_free( &comm_parent ); + } + else if ((argc == 2) && (strcmp(argv[1], "connector") == 0)) + { + IF_VERBOSE(("get_parent.\n")); + error = MPI_Comm_get_parent(&comm_parent); + check_error(error, "MPI_Comm_get_parent"); + if (comm_parent == MPI_COMM_NULL) + { + printf("acceptor's parent is NULL.\n");fflush(stdout); + MPI_Abort(MPI_COMM_WORLD, -1); + } + + IF_VERBOSE(("recv.\n")); + error = MPI_Recv(port, MPI_MAX_PORT_NAME, MPI_CHAR, 0, 0, + comm_parent, &status); + check_error(error, "MPI_Recv"); + + IF_VERBOSE(("1: received port: <%s>\n", port)); + IF_VERBOSE(("connect.\n")); + error = MPI_Comm_connect(port, MPI_INFO_NULL, 0, MPI_COMM_SELF, &comm); + check_error(error, "MPI_Comm_connect"); + + /* Receive some data before disconnecting */ + IF_VERBOSE(("receiving int\n")); + i = -1; + error = MPI_Recv(&i, 1, MPI_INT, 0, 0, comm, &status); + check_error(error, "MPI_Recv"); + if (i != 123) + { + printf("expected 123 but received %d\n", i); + fflush(stdout); + MPI_Abort(MPI_COMM_WORLD, 1); + } + + IF_VERBOSE(("disconnect.\n")); + error = MPI_Comm_disconnect(&comm); + check_error(error, "MPI_Comm_disconnect"); + + IF_VERBOSE(("barrier.\n")); + error = MPI_Barrier(comm_parent); + check_error(error, "MPI_Barrier"); + + MPI_Comm_free( &comm_parent ); + } + else + { + printf("invalid command line.\n");fflush(stdout); + { + int ii; + for (ii=0; ii<argc; ii++) + { + printf("argv[%d] = <%s>\n", ii, argv[ii]); + } + } + fflush(stdout); + MPI_Abort(MPI_COMM_WORLD, -2); + } } MPI_Finalize(); diff --git a/test/mpi/spawn/spaiccreate.c b/test/mpi/spawn/spaiccreate.c index 32967d8..873f613 100644 --- a/test/mpi/spawn/spaiccreate.c +++ b/test/mpi/spawn/spaiccreate.c @@ -24,70 +24,77 @@ int main( int argc, char *argv[] ) int np = 2; int errcodes[2]; MPI_Comm parentcomm, intercomm, intercomm2; + int can_spawn; MTest_Init( &argc, &argv ); - MPI_Comm_rank( MPI_COMM_WORLD, &wrank ); - MPI_Comm_size( MPI_COMM_WORLD, &wsize ); + errs += MTestSpawnPossible(&can_spawn); - MPI_Comm_get_parent( &parentcomm ); + if (can_spawn) { + MPI_Comm_rank( MPI_COMM_WORLD, &wrank ); + MPI_Comm_size( MPI_COMM_WORLD, &wsize ); - if (parentcomm == MPI_COMM_NULL) { - /* Create 2 more processes, from process 0 in the original - comm world */ - if (wrank == 0) { - MPI_Comm_spawn( (char*)"./spaiccreate", MPI_ARGV_NULL, np, - MPI_INFO_NULL, 0, MPI_COMM_SELF, - &intercomm, errcodes ); - } - else { - intercomm = MPI_COMM_NULL; - } - } - else - intercomm = parentcomm; + MPI_Comm_get_parent( &parentcomm ); - /* We now have a valid intercomm. Use it to create a NEW intercomm - that includes all processes */ - MPI_Intercomm_create( MPI_COMM_WORLD, 0, intercomm, 0, 123, &intercomm2 ); - - /* Have the spawned processes send to rank 1 in the comm world of the - parent */ - if (parentcomm == MPI_COMM_NULL) { - MPI_Send( &wrank, 1, MPI_INT, 1, wrank, intercomm2 ); - } - else { - if (wrank == 1) { - int i, rsize, rrank; - MPI_Status status; + if (parentcomm == MPI_COMM_NULL) { + /* Create 2 more processes, from process 0 in the original + comm world */ + if (wrank == 0) { + MPI_Comm_spawn( (char*)"./spaiccreate", MPI_ARGV_NULL, np, + MPI_INFO_NULL, 0, MPI_COMM_SELF, + &intercomm, errcodes ); + } + else { + intercomm = MPI_COMM_NULL; + } + } + else + intercomm = parentcomm; - MPI_Comm_remote_size( intercomm2, &rsize ); - for (i=0; i<rsize; i++) { - MPI_Recv( &rrank, 1, MPI_INT, i, i, intercomm2, &status ); - if (rrank != i) { - errs++; - printf( "Received %d from %d; expected %d\n", - rrank, i, i ); - } - } - } - } + /* We now have a valid intercomm. Use it to create a NEW intercomm + that includes all processes */ + MPI_Intercomm_create( MPI_COMM_WORLD, 0, intercomm, 0, 123, &intercomm2 ); + + /* Have the spawned processes send to rank 1 in the comm world of the + parent */ + if (parentcomm == MPI_COMM_NULL) { + MPI_Send( &wrank, 1, MPI_INT, 1, wrank, intercomm2 ); + } + else { + if (wrank == 1) { + int i, rsize, rrank; + MPI_Status status; + + MPI_Comm_remote_size( intercomm2, &rsize ); + for (i=0; i<rsize; i++) { + MPI_Recv( &rrank, 1, MPI_INT, i, i, intercomm2, &status ); + if (rrank != i) { + errs++; + printf( "Received %d from %d; expected %d\n", + rrank, i, i ); + } + } + } + } + + /* printf( "%sAbout to barrier on intercomm2\n", + (parentcomm == MPI_COMM_NULL) ? "<orig>" : "<spawned>" ); + fflush(stdout);*/ + MPI_Barrier( intercomm2 ); - /* printf( "%sAbout to barrier on intercomm2\n", - (parentcomm == MPI_COMM_NULL) ? "<orig>" : "<spawned>" ); - fflush(stdout);*/ - MPI_Barrier( intercomm2 ); - - /* It isn't necessary to free the intercomms, but it should not hurt */ - if (intercomm != MPI_COMM_NULL) - MPI_Comm_free( &intercomm ); - MPI_Comm_free( &intercomm2 ); + /* It isn't necessary to free the intercomms, but it should not hurt */ + if (intercomm != MPI_COMM_NULL) + MPI_Comm_free( &intercomm ); + MPI_Comm_free( &intercomm2 ); - /* Note that the MTest_Finalize get errs only over COMM_WORLD */ - /* Note also that both the parent and child will generate "No Errors" - if both call MTest_Finalize */ - if (parentcomm == MPI_COMM_NULL) { - MTest_Finalize( errs ); + /* Note that the MTest_Finalize get errs only over COMM_WORLD */ + /* Note also that both the parent and child will generate "No Errors" + if both call MTest_Finalize */ + if (parentcomm == MPI_COMM_NULL) { + MTest_Finalize( errs ); + } + } else { + MTest_Finalize( errs ); } MPI_Finalize(); diff --git a/test/mpi/spawn/spaiccreate2.c b/test/mpi/spawn/spaiccreate2.c index c56616c..20ca764 100644 --- a/test/mpi/spawn/spaiccreate2.c +++ b/test/mpi/spawn/spaiccreate2.c @@ -27,57 +27,64 @@ int main( int argc, char *argv[] ) int errcodes[2]; int rrank = -1; MPI_Comm parentcomm, intercomm, intercomm2, even_odd_comm, merged_world; + int can_spawn; MTest_Init( &argc, &argv ); - MPI_Comm_rank( MPI_COMM_WORLD, &wrank ); - MPI_Comm_size( MPI_COMM_WORLD, &wsize ); + errs += MTestSpawnPossible(&can_spawn); - if (wsize != 2) { - printf( "world size != 2, this test will not work correctly\n" ); - errs++; - } + if (can_spawn) { + MPI_Comm_rank( MPI_COMM_WORLD, &wrank ); + MPI_Comm_size( MPI_COMM_WORLD, &wsize ); - MPI_Comm_get_parent( &parentcomm ); + if (wsize != 2) { + printf( "world size != 2, this test will not work correctly\n" ); + errs++; + } - if (parentcomm == MPI_COMM_NULL) { - MPI_Comm_spawn( (char*)"./spaiccreate2", MPI_ARGV_NULL, np, - MPI_INFO_NULL, 0, MPI_COMM_WORLD, - &intercomm, errcodes ); - } - else { - intercomm = parentcomm; - } + MPI_Comm_get_parent( &parentcomm ); - MPI_Intercomm_merge( intercomm, (parentcomm == MPI_COMM_NULL ? 0 : 1), &merged_world ); - MPI_Comm_rank( merged_world, &mrank ); - MPI_Comm_size( merged_world, &msize ); - - MPI_Comm_split( merged_world, mrank % 2, wrank, &even_odd_comm ); - - MPI_Intercomm_create( even_odd_comm, 0, merged_world, (mrank + 1) % 2, 123, &intercomm2 ); - MPI_Comm_rank( intercomm2, &inter_rank ); - - /* odds receive from evens */ - MPI_Sendrecv( &inter_rank, 1, MPI_INT, inter_rank, 456, - &rrank, 1, MPI_INT, inter_rank, 456, intercomm2, MPI_STATUS_IGNORE ); - if (rrank != inter_rank) { - printf( "Received %d from %d; expected %d\n", - rrank, inter_rank, inter_rank ); - errs++; - } + if (parentcomm == MPI_COMM_NULL) { + MPI_Comm_spawn( (char*)"./spaiccreate2", MPI_ARGV_NULL, np, + MPI_INFO_NULL, 0, MPI_COMM_WORLD, + &intercomm, errcodes ); + } + else { + intercomm = parentcomm; + } + + MPI_Intercomm_merge( intercomm, (parentcomm == MPI_COMM_NULL ? 0 : 1), &merged_world ); + MPI_Comm_rank( merged_world, &mrank ); + MPI_Comm_size( merged_world, &msize ); + + MPI_Comm_split( merged_world, mrank % 2, wrank, &even_odd_comm ); + + MPI_Intercomm_create( even_odd_comm, 0, merged_world, (mrank + 1) % 2, 123, &intercomm2 ); + MPI_Comm_rank( intercomm2, &inter_rank ); + + /* odds receive from evens */ + MPI_Sendrecv( &inter_rank, 1, MPI_INT, inter_rank, 456, + &rrank, 1, MPI_INT, inter_rank, 456, intercomm2, MPI_STATUS_IGNORE ); + if (rrank != inter_rank) { + printf( "Received %d from %d; expected %d\n", + rrank, inter_rank, inter_rank ); + errs++; + } + + MPI_Barrier( intercomm2 ); + + MPI_Comm_free( &intercomm ); + MPI_Comm_free( &intercomm2 ); + MPI_Comm_free( &merged_world ); + MPI_Comm_free( &even_odd_comm ); - MPI_Barrier( intercomm2 ); - - MPI_Comm_free( &intercomm ); - MPI_Comm_free( &intercomm2 ); - MPI_Comm_free( &merged_world ); - MPI_Comm_free( &even_odd_comm ); - - /* Note that the MTest_Finalize get errs only over COMM_WORLD */ - /* Note also that both the parent and child will generate "No Errors" - if both call MTest_Finalize */ - if (parentcomm == MPI_COMM_NULL) { + /* Note that the MTest_Finalize get errs only over COMM_WORLD */ + /* Note also that both the parent and child will generate "No Errors" + if both call MTest_Finalize */ + if (parentcomm == MPI_COMM_NULL) { + MTest_Finalize( errs ); + } + } else { MTest_Finalize( errs ); } diff --git a/test/mpi/spawn/spawn1.c b/test/mpi/spawn/spawn1.c index 930002f..864f763 100644 --- a/test/mpi/spawn/spawn1.c +++ b/test/mpi/spawn/spawn1.c @@ -27,92 +27,98 @@ int main( int argc, char *argv[] ) int errcodes[2]; MPI_Comm parentcomm, intercomm; MPI_Status status; + int can_spawn; MTest_Init( &argc, &argv ); - MPI_Comm_get_parent( &parentcomm ); + errs += MTestSpawnPossible(&can_spawn); + if (can_spawn) { + MPI_Comm_get_parent( &parentcomm ); - if (parentcomm == MPI_COMM_NULL) { - /* Create 2 more processes */ - MPI_Comm_spawn( (char*)"./spawn1", MPI_ARGV_NULL, np, - MPI_INFO_NULL, 0, MPI_COMM_WORLD, - &intercomm, errcodes ); - } - else - intercomm = parentcomm; + if (parentcomm == MPI_COMM_NULL) { + /* Create 2 more processes */ + MPI_Comm_spawn( (char*)"./spawn1", MPI_ARGV_NULL, np, + MPI_INFO_NULL, 0, MPI_COMM_WORLD, + &intercomm, errcodes ); + } + else + intercomm = parentcomm; - /* We now have a valid intercomm */ + /* We now have a valid intercomm */ - MPI_Comm_remote_size( intercomm, &rsize ); - MPI_Comm_size( intercomm, &size ); - MPI_Comm_rank( intercomm, &rank ); + MPI_Comm_remote_size( intercomm, &rsize ); + MPI_Comm_size( intercomm, &size ); + MPI_Comm_rank( intercomm, &rank ); - if (parentcomm == MPI_COMM_NULL) { - /* Master */ - if (rsize != np) { - errs++; - printf( "Did not create %d processes (got %d)\n", np, rsize ); - } - if (rank == 0) { - for (i=0; i<rsize; i++) { - MPI_Send( &i, 1, MPI_INT, i, 0, intercomm ); - } - /* We could use intercomm reduce to get the errors from the - children, but we'll use a simpler loop to make sure that - we get valid data */ - for (i=0; i<rsize; i++) { - MPI_Recv( &err, 1, MPI_INT, i, 1, intercomm, MPI_STATUS_IGNORE ); - errs += err; - } - } - } - else { - /* Child */ - char cname[MPI_MAX_OBJECT_NAME]; - int rlen; + if (parentcomm == MPI_COMM_NULL) { + /* Master */ + if (rsize != np) { + errs++; + printf( "Did not create %d processes (got %d)\n", np, rsize ); + } + if (rank == 0) { + for (i=0; i<rsize; i++) { + MPI_Send( &i, 1, MPI_INT, i, 0, intercomm ); + } + /* We could use intercomm reduce to get the errors from the + children, but we'll use a simpler loop to make sure that + we get valid data */ + for (i=0; i<rsize; i++) { + MPI_Recv( &err, 1, MPI_INT, i, 1, intercomm, MPI_STATUS_IGNORE ); + errs += err; + } + } + } + else { + /* Child */ + char cname[MPI_MAX_OBJECT_NAME]; + int rlen; - if (size != np) { - errs++; - printf( "(Child) Did not create %d processes (got %d)\n", - np, size ); - } - /* Check the name of the parent */ - cname[0] = 0; - MPI_Comm_get_name( intercomm, cname, &rlen ); - /* MPI-2 section 8.4 requires that the parent have this - default name */ - if (strcmp( cname, "MPI_COMM_PARENT" ) != 0) { - errs++; - printf( "Name of parent is not correct\n" ); - if (rlen > 0 && cname[0]) { - printf( " Got %s but expected MPI_COMM_PARENT\n", cname ); - } - else { - printf( " Expected MPI_COMM_PARENT but no name set\n" ); - } - } - MPI_Recv( &i, 1, MPI_INT, 0, 0, intercomm, &status ); - if (i != rank) { - errs++; - printf( "Unexpected rank on child %d (%d)\n", rank, i ); - } - /* Send the errs back to the master process */ - MPI_Ssend( &errs, 1, MPI_INT, 0, 1, intercomm ); - } + if (size != np) { + errs++; + printf( "(Child) Did not create %d processes (got %d)\n", + np, size ); + } + /* Check the name of the parent */ + cname[0] = 0; + MPI_Comm_get_name( intercomm, cname, &rlen ); + /* MPI-2 section 8.4 requires that the parent have this + default name */ + if (strcmp( cname, "MPI_COMM_PARENT" ) != 0) { + errs++; + printf( "Name of parent is not correct\n" ); + if (rlen > 0 && cname[0]) { + printf( " Got %s but expected MPI_COMM_PARENT\n", cname ); + } + else { + printf( " Expected MPI_COMM_PARENT but no name set\n" ); + } + } + MPI_Recv( &i, 1, MPI_INT, 0, 0, intercomm, &status ); + if (i != rank) { + errs++; + printf( "Unexpected rank on child %d (%d)\n", rank, i ); + } + /* Send the errs back to the master process */ + MPI_Ssend( &errs, 1, MPI_INT, 0, 1, intercomm ); + } - /* It isn't necessary to free the intercomm, but it should not hurt */ - /* Using Comm_disconnect instead of free should provide a stronger - * test, as a high-quality MPI implementation will be able to - * recover some resources that it should hold on to in the case - * of MPI_Comm_free */ - /* MPI_Comm_free( &intercomm ); */ - MPI_Comm_disconnect( &intercomm ); + /* It isn't necessary to free the intercomm, but it should not hurt */ + /* Using Comm_disconnect instead of free should provide a stronger + * test, as a high-quality MPI implementation will be able to + * recover some resources that it should hold on to in the case + * of MPI_Comm_free */ + /* MPI_Comm_free( &intercomm ); */ + MPI_Comm_disconnect( &intercomm ); - /* Note that the MTest_Finalize get errs only over COMM_WORLD */ - /* Note also that both the parent and child will generate "No Errors" - if both call MTest_Finalize */ - if (parentcomm == MPI_COMM_NULL) { - MTest_Finalize( errs ); + /* Note that the MTest_Finalize get errs only over COMM_WORLD */ + /* Note also that both the parent and child will generate "No Errors" + if both call MTest_Finalize */ + if (parentcomm == MPI_COMM_NULL) { + MTest_Finalize( errs ); + } + } else { + MTest_Finalize( errs ); } MPI_Finalize(); diff --git a/test/mpi/spawn/spawn2.c b/test/mpi/spawn/spawn2.c index 88364f4..2f310d3 100644 --- a/test/mpi/spawn/spawn2.c +++ b/test/mpi/spawn/spawn2.c @@ -27,132 +27,139 @@ int main( int argc, char *argv[] ) int errcodes[2]; MPI_Comm parentcomm, intercomm, intercomm2; MPI_Status status; + int can_spawn; MTest_Init( &argc, &argv ); - MPI_Comm_get_parent( &parentcomm ); - - if (parentcomm == MPI_COMM_NULL) { - /* Create 2 more processes */ - /* This uses a Unix name for the program; - Windows applications may need to use just spawn2 or - spawn2.exe. We can't rely on using info to place . in the - path, since info is not required to be followed. */ - MPI_Comm_spawn( (char*)"./spawn2", MPI_ARGV_NULL, np, - MPI_INFO_NULL, 0, MPI_COMM_WORLD, - &intercomm, errcodes ); - } - else - intercomm = parentcomm; - - /* We now have a valid intercomm */ - - MPI_Comm_remote_size( intercomm, &rsize ); - MPI_Comm_size( intercomm, &size ); - MPI_Comm_rank( intercomm, &rank ); - - if (parentcomm == MPI_COMM_NULL) { - /* Master */ - if (rsize != np) { - errs++; - printf( "Did not create %d processes (got %d)\n", np, rsize ); - } - if (rank == 0) { - for (i=0; i<rsize; i++) { - MPI_Send( &i, 1, MPI_INT, i, 0, intercomm ); - } - /* We could use intercomm reduce to get the errors from the - children, but we'll use a simpler loop to make sure that - we get valid data */ - for (i=0; i<rsize; i++) { - MPI_Recv( &err, 1, MPI_INT, i, 1, intercomm, MPI_STATUS_IGNORE ); - errs += err; - } - } - } - else { - /* Child */ - char cname[MPI_MAX_OBJECT_NAME]; - int rlen; - - if (size != np) { - errs++; - printf( "(Child) Did not create %d processes (got %d)\n", - np, size ); - } - /* Check the name of the parent */ - cname[0] = 0; - MPI_Comm_get_name( intercomm, cname, &rlen ); - /* MPI-2 section 8.4 requires that the parent have this - default name */ - if (strcmp( cname, "MPI_COMM_PARENT" ) != 0) { - errs++; - printf( "Name of parent is not correct\n" ); - if (rlen > 0 && cname[0]) { - printf( " Got %s but expected MPI_COMM_PARENT\n", cname ); - } - else { - printf( " Expected MPI_COMM_PARENT but no name set\n" ); - } - } - MPI_Recv( &i, 1, MPI_INT, 0, 0, intercomm, &status ); - if (i != rank) { - errs++; - printf( "Unexpected rank on child %d (%d)\n", rank, i ); - } - /* Send the errs back to the master process */ - MPI_Ssend( &errs, 1, MPI_INT, 0, 1, intercomm ); - } - - if (parentcomm == MPI_COMM_NULL) { - /* Create 2 more processes */ - /* This uses a Unix name for the program; - Windows applications may need to use just spawn2 or - spawn2.exe. We can't rely on using info to place . in the - path, since info is not required to be followed. */ - MPI_Comm_spawn( (char*)"./spawn2", MPI_ARGV_NULL, np, - MPI_INFO_NULL, 0, MPI_COMM_WORLD, - &intercomm2, MPI_ERRCODES_IGNORE ); - } - else - intercomm2 = parentcomm; - - /* We now have a valid intercomm */ - - MPI_Comm_remote_size( intercomm2, &rsize ); - MPI_Comm_size( intercomm2, &size ); - MPI_Comm_rank( intercomm2, &rank ); - - if (parentcomm == MPI_COMM_NULL) { - /* Master */ - if (rsize != np) { - errs++; - printf( "Did not create %d processes (got %d)\n", np, rsize ); - } - if (rank == 0) { - for (i=0; i<rsize; i++) { - MPI_Send( &i, 1, MPI_INT, i, 0, intercomm2 ); - } - /* We could use intercomm2 reduce to get the errors from the - children, but we'll use a simpler loop to make sure that - we get valid data */ - for (i=0; i<rsize; i++) { - MPI_Recv( &err, 1, MPI_INT, i, 1, intercomm2, MPI_STATUS_IGNORE ); - errs += err; - } - } - - MPI_Comm_free( &intercomm2 ); - } - - /* It isn't necessary to free the intercomm, but it should not hurt */ - MPI_Comm_free( &intercomm ); - - /* Note that the MTest_Finalize get errs only over COMM_WORLD */ - /* Note also that both the parent and child will generate "No Errors" - if both call MTest_Finalize */ - if (parentcomm == MPI_COMM_NULL) { - MTest_Finalize( errs ); + errs += MTestSpawnPossible(&can_spawn); + + if (can_spawn) { + MPI_Comm_get_parent( &parentcomm ); + + if (parentcomm == MPI_COMM_NULL) { + /* Create 2 more processes */ + /* This uses a Unix name for the program; + Windows applications may need to use just spawn2 or + spawn2.exe. We can't rely on using info to place . in the + path, since info is not required to be followed. */ + MPI_Comm_spawn( (char*)"./spawn2", MPI_ARGV_NULL, np, + MPI_INFO_NULL, 0, MPI_COMM_WORLD, + &intercomm, errcodes ); + } + else + intercomm = parentcomm; + + /* We now have a valid intercomm */ + + MPI_Comm_remote_size( intercomm, &rsize ); + MPI_Comm_size( intercomm, &size ); + MPI_Comm_rank( intercomm, &rank ); + + if (parentcomm == MPI_COMM_NULL) { + /* Master */ + if (rsize != np) { + errs++; + printf( "Did not create %d processes (got %d)\n", np, rsize ); + } + if (rank == 0) { + for (i=0; i<rsize; i++) { + MPI_Send( &i, 1, MPI_INT, i, 0, intercomm ); + } + /* We could use intercomm reduce to get the errors from the + children, but we'll use a simpler loop to make sure that + we get valid data */ + for (i=0; i<rsize; i++) { + MPI_Recv( &err, 1, MPI_INT, i, 1, intercomm, MPI_STATUS_IGNORE ); + errs += err; + } + } + } + else { + /* Child */ + char cname[MPI_MAX_OBJECT_NAME]; + int rlen; + + if (size != np) { + errs++; + printf( "(Child) Did not create %d processes (got %d)\n", + np, size ); + } + /* Check the name of the parent */ + cname[0] = 0; + MPI_Comm_get_name( intercomm, cname, &rlen ); + /* MPI-2 section 8.4 requires that the parent have this + default name */ + if (strcmp( cname, "MPI_COMM_PARENT" ) != 0) { + errs++; + printf( "Name of parent is not correct\n" ); + if (rlen > 0 && cname[0]) { + printf( " Got %s but expected MPI_COMM_PARENT\n", cname ); + } + else { + printf( " Expected MPI_COMM_PARENT but no name set\n" ); + } + } + MPI_Recv( &i, 1, MPI_INT, 0, 0, intercomm, &status ); + if (i != rank) { + errs++; + printf( "Unexpected rank on child %d (%d)\n", rank, i ); + } + /* Send the errs back to the master process */ + MPI_Ssend( &errs, 1, MPI_INT, 0, 1, intercomm ); + } + + if (parentcomm == MPI_COMM_NULL) { + /* Create 2 more processes */ + /* This uses a Unix name for the program; + Windows applications may need to use just spawn2 or + spawn2.exe. We can't rely on using info to place . in the + path, since info is not required to be followed. */ + MPI_Comm_spawn( (char*)"./spawn2", MPI_ARGV_NULL, np, + MPI_INFO_NULL, 0, MPI_COMM_WORLD, + &intercomm2, MPI_ERRCODES_IGNORE ); + } + else + intercomm2 = parentcomm; + + /* We now have a valid intercomm */ + + MPI_Comm_remote_size( intercomm2, &rsize ); + MPI_Comm_size( intercomm2, &size ); + MPI_Comm_rank( intercomm2, &rank ); + + if (parentcomm == MPI_COMM_NULL) { + /* Master */ + if (rsize != np) { + errs++; + printf( "Did not create %d processes (got %d)\n", np, rsize ); + } + if (rank == 0) { + for (i=0; i<rsize; i++) { + MPI_Send( &i, 1, MPI_INT, i, 0, intercomm2 ); + } + /* We could use intercomm2 reduce to get the errors from the + children, but we'll use a simpler loop to make sure that + we get valid data */ + for (i=0; i<rsize; i++) { + MPI_Recv( &err, 1, MPI_INT, i, 1, intercomm2, MPI_STATUS_IGNORE ); + errs += err; + } + } + + MPI_Comm_free( &intercomm2 ); + } + + /* It isn't necessary to free the intercomm, but it should not hurt */ + MPI_Comm_free( &intercomm ); + + /* Note that the MTest_Finalize get errs only over COMM_WORLD */ + /* Note also that both the parent and child will generate "No Errors" + if both call MTest_Finalize */ + if (parentcomm == MPI_COMM_NULL) { + MTest_Finalize( errs ); + } + } else { + MTest_Finalize( errs ); } MPI_Finalize(); diff --git a/test/mpi/spawn/spawnargv.c b/test/mpi/spawn/spawnargv.c index 5623934..95b52aa 100644 --- a/test/mpi/spawn/spawnargv.c +++ b/test/mpi/spawn/spawnargv.c @@ -27,88 +27,95 @@ int main( int argc, char *argv[] ) MPI_Status status; char * inargv[] = { (char*)"a", (char*)"b=c", (char*)"d e", (char*)"-pf", (char*)" Ss", 0 }; char * outargv[] = { (char*)"a", (char*)"b=c", (char*)"d e", (char*)"-pf", (char*)" Ss", 0 }; + int can_spawn; MTest_Init( &argc, &argv ); - MPI_Comm_get_parent( &parentcomm ); + errs += MTestSpawnPossible(&can_spawn); - if (parentcomm == MPI_COMM_NULL) { - /* Create 2 more processes */ - /* ./ is unix specific . - The more generic approach would be to specify "spawnargv" as the - executable and pass an info with ("path", ".") */ - MPI_Comm_spawn( (char*)"./spawnargv", inargv, np, - MPI_INFO_NULL, 0, MPI_COMM_WORLD, - &intercomm, errcodes ); - } - else - intercomm = parentcomm; + if (can_spawn) { + MPI_Comm_get_parent( &parentcomm ); - /* We now have a valid intercomm */ + if (parentcomm == MPI_COMM_NULL) { + /* Create 2 more processes */ + /* ./ is unix specific . + The more generic approach would be to specify "spawnargv" as the + executable and pass an info with ("path", ".") */ + MPI_Comm_spawn( (char*)"./spawnargv", inargv, np, + MPI_INFO_NULL, 0, MPI_COMM_WORLD, + &intercomm, errcodes ); + } + else + intercomm = parentcomm; - MPI_Comm_remote_size( intercomm, &rsize ); - MPI_Comm_size( intercomm, &size ); - MPI_Comm_rank( intercomm, &rank ); + /* We now have a valid intercomm */ - if (parentcomm == MPI_COMM_NULL) { - /* Master */ - if (rsize != np) { - errs++; - printf( "Did not create %d processes (got %d)\n", np, rsize ); - } - for (i=0; i<rsize; i++) { - MPI_Send( &i, 1, MPI_INT, i, 0, intercomm ); - } - /* We could use intercomm reduce to get the errors from the - children, but we'll use a simpler loop to make sure that - we get valid data */ - for (i=0; i<rsize; i++) { - MPI_Recv( &err, 1, MPI_INT, i, 1, intercomm, MPI_STATUS_IGNORE ); - errs += err; - } - } - else { - /* Child */ - /* FIXME: This assumes that stdout is handled for the children - (the error count will still be reported to the parent) */ - if (size != np) { - errs++; - printf( "(Child) Did not create %d processes (got %d)\n", - np, size ); - } - MPI_Recv( &i, 1, MPI_INT, 0, 0, intercomm, &status ); - if (i != rank) { - errs++; - printf( "Unexpected rank on child %d (%d)\n", rank, i ); - } - /* Check the command line */ - for (i=1; i<argc; i++) { - if (!outargv[i-1]) { - errs++; - printf( "Wrong number of arguments (%d)\n", argc ); - break; - } - if (strcmp( argv[i], outargv[i-1] ) != 0) { - errs++; - printf( "Found arg %s but expected %s\n", argv[i], - outargv[i-1] ); - } - } - if (outargv[i-1]) { - /* We had too few args in the spawned command */ - errs++; - printf( "Too few arguments to spawned command\n" ); - } - /* Send the errs back to the master process */ - MPI_Ssend( &errs, 1, MPI_INT, 0, 1, intercomm ); - } + MPI_Comm_remote_size( intercomm, &rsize ); + MPI_Comm_size( intercomm, &size ); + MPI_Comm_rank( intercomm, &rank ); + + if (parentcomm == MPI_COMM_NULL) { + /* Master */ + if (rsize != np) { + errs++; + printf( "Did not create %d processes (got %d)\n", np, rsize ); + } + for (i=0; i<rsize; i++) { + MPI_Send( &i, 1, MPI_INT, i, 0, intercomm ); + } + /* We could use intercomm reduce to get the errors from the + children, but we'll use a simpler loop to make sure that + we get valid data */ + for (i=0; i<rsize; i++) { + MPI_Recv( &err, 1, MPI_INT, i, 1, intercomm, MPI_STATUS_IGNORE ); + errs += err; + } + } + else { + /* Child */ + /* FIXME: This assumes that stdout is handled for the children + (the error count will still be reported to the parent) */ + if (size != np) { + errs++; + printf( "(Child) Did not create %d processes (got %d)\n", + np, size ); + } + MPI_Recv( &i, 1, MPI_INT, 0, 0, intercomm, &status ); + if (i != rank) { + errs++; + printf( "Unexpected rank on child %d (%d)\n", rank, i ); + } + /* Check the command line */ + for (i=1; i<argc; i++) { + if (!outargv[i-1]) { + errs++; + printf( "Wrong number of arguments (%d)\n", argc ); + break; + } + if (strcmp( argv[i], outargv[i-1] ) != 0) { + errs++; + printf( "Found arg %s but expected %s\n", argv[i], + outargv[i-1] ); + } + } + if (outargv[i-1]) { + /* We had too few args in the spawned command */ + errs++; + printf( "Too few arguments to spawned command\n" ); + } + /* Send the errs back to the master process */ + MPI_Ssend( &errs, 1, MPI_INT, 0, 1, intercomm ); + } - /* It isn't necessary to free the intercomm, but it should not hurt */ - MPI_Comm_free( &intercomm ); + /* It isn't necessary to free the intercomm, but it should not hurt */ + MPI_Comm_free( &intercomm ); - /* Note that the MTest_Finalize get errs only over COMM_WORLD */ - if (parentcomm == MPI_COMM_NULL) { - MTest_Finalize( errs ); + /* Note that the MTest_Finalize get errs only over COMM_WORLD */ + if (parentcomm == MPI_COMM_NULL) { + MTest_Finalize( errs ); + } + } else { + MTest_Finalize( errs ); } MPI_Finalize(); diff --git a/test/mpi/spawn/spawninfo1.c b/test/mpi/spawn/spawninfo1.c index 928ebac..abd2a12 100644 --- a/test/mpi/spawn/spawninfo1.c +++ b/test/mpi/spawn/spawninfo1.c @@ -34,113 +34,120 @@ int main( int argc, char *argv[] ) MPI_Info spawninfo; char curdir[1024], wd[1024], childwd[1024]; char *cerr; + int can_spawn; MTest_Init( &argc, &argv ); - cerr = getcwd( curdir, sizeof(curdir) ); - - MPI_Comm_get_parent( &parentcomm ); - - if (parentcomm == MPI_COMM_NULL) { - char *p; - /* Create 2 more processes. Make the working directory the - directory above the current running directory */ - strncpy( wd, curdir, sizeof(wd) ); - /* Lop off the last element of the directory */ - p = wd + strlen(wd) - 1; - while (p > wd && *p != '/' && *p != '\\') p--; - *p = 0; - - MPI_Info_create( &spawninfo ); - MPI_Info_set( spawninfo, (char*)"path", curdir ); - MPI_Info_set( spawninfo, (char*)"wdir", wd ); - MPI_Comm_spawn( (char*)"spawninfo1", MPI_ARGV_NULL, np, - spawninfo, 0, MPI_COMM_WORLD, - &intercomm, errcodes ); - MPI_Info_free( &spawninfo ); - } - else - intercomm = parentcomm; - - /* We now have a valid intercomm */ - - MPI_Comm_remote_size( intercomm, &rsize ); - MPI_Comm_size( intercomm, &size ); - MPI_Comm_rank( intercomm, &rank ); - - if (parentcomm == MPI_COMM_NULL) { - /* Master */ - if (rsize != np) { - errs++; - printf( "Did not create %d processes (got %d)\n", np, rsize ); - } - if (rank == 0) { - for (i=0; i<rsize; i++) { - MPI_Send( &i, 1, MPI_INT, i, 0, intercomm ); - } - /* We could use intercomm reduce to get the errors from the - children, but we'll use a simpler loop to make sure that - we get valid data */ - for (i=0; i<rsize; i++) { - MPI_Recv( &err, 1, MPI_INT, i, 1, intercomm, MPI_STATUS_IGNORE ); - errs += err; - } - for (i=0; i<rsize; i++) { - MPI_Recv( childwd, sizeof(childwd), MPI_CHAR, i, 2, intercomm, - MPI_STATUS_IGNORE ); - if (strcmp( childwd, wd ) != 0) { - printf( "Expected a working dir of %s but child is in %s\n", - wd, childwd ); - errs ++; - } - } - } - } - else { - /* Child */ - char cname[MPI_MAX_OBJECT_NAME]; - int rlen; - - if (size != np) { - errs++; - printf( "(Child) Did not create %d processes (got %d)\n", - np, size ); - } - /* Check the name of the parent */ - cname[0] = 0; - MPI_Comm_get_name( intercomm, cname, &rlen ); - /* MPI-2 section 8.4 requires that the parent have this - default name */ - if (strcmp( cname, "MPI_COMM_PARENT" ) != 0) { - errs++; - printf( "Name of parent is not correct\n" ); - if (rlen > 0 && cname[0]) { - printf( " Got %s but expected MPI_COMM_PARENT\n", cname ); - } - else { - printf( " Expected MPI_COMM_PARENT but no name set\n" ); - } - } - MPI_Recv( &i, 1, MPI_INT, 0, 0, intercomm, &status ); - if (i != rank) { - errs++; - printf( "Unexpected rank on child %d (%d)\n", rank, i ); - } - /* Send our notion of the current directory to the parent */ - MPI_Send( curdir, strlen(curdir)+1, MPI_CHAR, 0, 2, intercomm ); - - /* Send the errs back to the master process */ - MPI_Ssend( &errs, 1, MPI_INT, 0, 1, intercomm ); - } + errs += MTestSpawnPossible(&can_spawn); + + if (can_spawn) { + cerr = getcwd( curdir, sizeof(curdir) ); + + MPI_Comm_get_parent( &parentcomm ); + + if (parentcomm == MPI_COMM_NULL) { + char *p; + /* Create 2 more processes. Make the working directory the + directory above the current running directory */ + strncpy( wd, curdir, sizeof(wd) ); + /* Lop off the last element of the directory */ + p = wd + strlen(wd) - 1; + while (p > wd && *p != '/' && *p != '\\') p--; + *p = 0; + + MPI_Info_create( &spawninfo ); + MPI_Info_set( spawninfo, (char*)"path", curdir ); + MPI_Info_set( spawninfo, (char*)"wdir", wd ); + MPI_Comm_spawn( (char*)"spawninfo1", MPI_ARGV_NULL, np, + spawninfo, 0, MPI_COMM_WORLD, + &intercomm, errcodes ); + MPI_Info_free( &spawninfo ); + } + else + intercomm = parentcomm; + + /* We now have a valid intercomm */ + + MPI_Comm_remote_size( intercomm, &rsize ); + MPI_Comm_size( intercomm, &size ); + MPI_Comm_rank( intercomm, &rank ); + + if (parentcomm == MPI_COMM_NULL) { + /* Master */ + if (rsize != np) { + errs++; + printf( "Did not create %d processes (got %d)\n", np, rsize ); + } + if (rank == 0) { + for (i=0; i<rsize; i++) { + MPI_Send( &i, 1, MPI_INT, i, 0, intercomm ); + } + /* We could use intercomm reduce to get the errors from the + children, but we'll use a simpler loop to make sure that + we get valid data */ + for (i=0; i<rsize; i++) { + MPI_Recv( &err, 1, MPI_INT, i, 1, intercomm, MPI_STATUS_IGNORE ); + errs += err; + } + for (i=0; i<rsize; i++) { + MPI_Recv( childwd, sizeof(childwd), MPI_CHAR, i, 2, intercomm, + MPI_STATUS_IGNORE ); + if (strcmp( childwd, wd ) != 0) { + printf( "Expected a working dir of %s but child is in %s\n", + wd, childwd ); + errs ++; + } + } + } + } + else { + /* Child */ + char cname[MPI_MAX_OBJECT_NAME]; + int rlen; + + if (size != np) { + errs++; + printf( "(Child) Did not create %d processes (got %d)\n", + np, size ); + } + /* Check the name of the parent */ + cname[0] = 0; + MPI_Comm_get_name( intercomm, cname, &rlen ); + /* MPI-2 section 8.4 requires that the parent have this + default name */ + if (strcmp( cname, "MPI_COMM_PARENT" ) != 0) { + errs++; + printf( "Name of parent is not correct\n" ); + if (rlen > 0 && cname[0]) { + printf( " Got %s but expected MPI_COMM_PARENT\n", cname ); + } + else { + printf( " Expected MPI_COMM_PARENT but no name set\n" ); + } + } + MPI_Recv( &i, 1, MPI_INT, 0, 0, intercomm, &status ); + if (i != rank) { + errs++; + printf( "Unexpected rank on child %d (%d)\n", rank, i ); + } + /* Send our notion of the current directory to the parent */ + MPI_Send( curdir, strlen(curdir)+1, MPI_CHAR, 0, 2, intercomm ); + + /* Send the errs back to the master process */ + MPI_Ssend( &errs, 1, MPI_INT, 0, 1, intercomm ); + } - /* It isn't necessary to free the intercomm, but it should not hurt */ - MPI_Comm_free( &intercomm ); + /* It isn't necessary to free the intercomm, but it should not hurt */ + MPI_Comm_free( &intercomm ); - /* Note that the MTest_Finalize get errs only over COMM_WORLD */ - /* Note also that both the parent and child will generate "No Errors" - if both call MTest_Finalize */ - if (parentcomm == MPI_COMM_NULL) { - MTest_Finalize( errs ); + /* Note that the MTest_Finalize get errs only over COMM_WORLD */ + /* Note also that both the parent and child will generate "No Errors" + if both call MTest_Finalize */ + if (parentcomm == MPI_COMM_NULL) { + MTest_Finalize( errs ); + } + } else { + MTest_Finalize( errs ); } MPI_Finalize(); diff --git a/test/mpi/spawn/spawnintra.c b/test/mpi/spawn/spawnintra.c index bb9265e..41b6603 100644 --- a/test/mpi/spawn/spawnintra.c +++ b/test/mpi/spawn/spawnintra.c @@ -21,174 +21,181 @@ int main( int argc, char *argv[] ) MPI_Comm parentcomm, intercomm, intracomm, intracomm2, intracomm3; int isChild = 0; MPI_Status status; + int can_spawn; MTest_Init( &argc, &argv ); - MPI_Comm_get_parent( &parentcomm ); - - if (parentcomm == MPI_COMM_NULL) { - /* Create 2 more processes */ - MPI_Comm_spawn( (char*)"./spawnintra", MPI_ARGV_NULL, np, - MPI_INFO_NULL, 0, MPI_COMM_WORLD, - &intercomm, errcodes ); - } - else - intercomm = parentcomm; - - /* We now have a valid intercomm */ - - MPI_Comm_remote_size( intercomm, &rsize ); - MPI_Comm_size( intercomm, &size ); - MPI_Comm_rank( intercomm, &rank ); - - if (parentcomm == MPI_COMM_NULL) { - /* Master */ - if (rsize != np) { - errs++; - printf( "Did not create %d processes (got %d)\n", np, rsize ); - } - if (rank == 0) { - for (i=0; i<rsize; i++) { - MPI_Send( &i, 1, MPI_INT, i, 0, intercomm ); - } - } - } - else { - /* Child */ - isChild = 1; - if (size != np) { - errs++; - printf( "(Child) Did not create %d processes (got %d)\n", - np, size ); - } - MPI_Recv( &i, 1, MPI_INT, 0, 0, intercomm, &status ); - if (i != rank) { - errs++; - printf( "Unexpected rank on child %d (%d)\n", rank, i ); - } - } - - /* At this point, try to form the intracommunicator */ - MPI_Intercomm_merge( intercomm, isChild, &intracomm ); - - /* Check on the intra comm */ - { - int icsize, icrank, wrank; - - MPI_Comm_size( intracomm, &icsize ); - MPI_Comm_rank( intracomm, &icrank ); - MPI_Comm_rank( MPI_COMM_WORLD, &wrank ); - - if (icsize != rsize + size) { - errs++; - printf( "Intracomm rank %d thinks size is %d, not %d\n", - icrank, icsize, rsize + size ); - } - /* Make sure that the processes are ordered correctly */ - if (isChild) { - int psize; - MPI_Comm_remote_size( parentcomm, &psize ); - if (icrank != psize + wrank ) { - errs++; - printf( "Intracomm rank %d (from child) should have rank %d\n", - icrank, psize + wrank ); - } - } - else { - if (icrank != wrank) { - errs++; - printf( "Intracomm rank %d (from parent) should have rank %d\n", - icrank, wrank ); - } - } - } - - /* At this point, try to form the intracommunicator, with the other - processes first */ - MPI_Intercomm_merge( intercomm, !isChild, &intracomm2 ); - - /* Check on the intra comm */ - { - int icsize, icrank, wrank; - - MPI_Comm_size( intracomm2, &icsize ); - MPI_Comm_rank( intracomm2, &icrank ); - MPI_Comm_rank( MPI_COMM_WORLD, &wrank ); - - if (icsize != rsize + size) { - errs++; - printf( "(2)Intracomm rank %d thinks size is %d, not %d\n", - icrank, icsize, rsize + size ); - } - /* Make sure that the processes are ordered correctly */ - if (isChild) { - if (icrank != wrank ) { - errs++; - printf( "(2)Intracomm rank %d (from child) should have rank %d\n", - icrank, wrank ); - } - } - else { - int csize; - MPI_Comm_remote_size( intercomm, &csize ); - if (icrank != wrank + csize) { - errs++; - printf( "(2)Intracomm rank %d (from parent) should have rank %d\n", - icrank, wrank + csize ); - } - } - } - - /* At this point, try to form the intracommunicator, with an - arbitrary choice for the first group of processes */ - MPI_Intercomm_merge( intercomm, 0, &intracomm3 ); - /* Check on the intra comm */ - { - int icsize, icrank, wrank; - - MPI_Comm_size( intracomm3, &icsize ); - MPI_Comm_rank( intracomm3, &icrank ); - MPI_Comm_rank( MPI_COMM_WORLD, &wrank ); - - if (icsize != rsize + size) { - errs++; - printf( "(3)Intracomm rank %d thinks size is %d, not %d\n", - icrank, icsize, rsize + size ); - } - /* Eventually, we should test that the processes are ordered - correctly, by groups (must be one of the two cases above) */ - } - - /* Update error count */ - if (isChild) { - /* Send the errs back to the master process */ - MPI_Ssend( &errs, 1, MPI_INT, 0, 1, intercomm ); - } - else { - if (rank == 0) { - /* We could use intercomm reduce to get the errors from the - children, but we'll use a simpler loop to make sure that - we get valid data */ - for (i=0; i<rsize; i++) { - MPI_Recv( &err, 1, MPI_INT, i, 1, intercomm, MPI_STATUS_IGNORE ); - errs += err; - } - } - } - - /* It isn't necessary to free the intracomms, but it should not hurt */ - MPI_Comm_free( &intracomm ); - MPI_Comm_free( &intracomm2 ); - MPI_Comm_free( &intracomm3 ); - - /* It isn't necessary to free the intercomm, but it should not hurt */ - MPI_Comm_free( &intercomm ); - - /* Note that the MTest_Finalize get errs only over COMM_WORLD */ - /* Note also that both the parent and child will generate "No Errors" - if both call MTest_Finalize */ - if (parentcomm == MPI_COMM_NULL) { - MTest_Finalize( errs ); + errs += MTestSpawnPossible(&can_spawn); + + if (can_spawn) { + MPI_Comm_get_parent( &parentcomm ); + + if (parentcomm == MPI_COMM_NULL) { + /* Create 2 more processes */ + MPI_Comm_spawn( (char*)"./spawnintra", MPI_ARGV_NULL, np, + MPI_INFO_NULL, 0, MPI_COMM_WORLD, + &intercomm, errcodes ); + } + else + intercomm = parentcomm; + + /* We now have a valid intercomm */ + + MPI_Comm_remote_size( intercomm, &rsize ); + MPI_Comm_size( intercomm, &size ); + MPI_Comm_rank( intercomm, &rank ); + + if (parentcomm == MPI_COMM_NULL) { + /* Master */ + if (rsize != np) { + errs++; + printf( "Did not create %d processes (got %d)\n", np, rsize ); + } + if (rank == 0) { + for (i=0; i<rsize; i++) { + MPI_Send( &i, 1, MPI_INT, i, 0, intercomm ); + } + } + } + else { + /* Child */ + isChild = 1; + if (size != np) { + errs++; + printf( "(Child) Did not create %d processes (got %d)\n", + np, size ); + } + MPI_Recv( &i, 1, MPI_INT, 0, 0, intercomm, &status ); + if (i != rank) { + errs++; + printf( "Unexpected rank on child %d (%d)\n", rank, i ); + } + } + + /* At this point, try to form the intracommunicator */ + MPI_Intercomm_merge( intercomm, isChild, &intracomm ); + + /* Check on the intra comm */ + { + int icsize, icrank, wrank; + + MPI_Comm_size( intracomm, &icsize ); + MPI_Comm_rank( intracomm, &icrank ); + MPI_Comm_rank( MPI_COMM_WORLD, &wrank ); + + if (icsize != rsize + size) { + errs++; + printf( "Intracomm rank %d thinks size is %d, not %d\n", + icrank, icsize, rsize + size ); + } + /* Make sure that the processes are ordered correctly */ + if (isChild) { + int psize; + MPI_Comm_remote_size( parentcomm, &psize ); + if (icrank != psize + wrank ) { + errs++; + printf( "Intracomm rank %d (from child) should have rank %d\n", + icrank, psize + wrank ); + } + } + else { + if (icrank != wrank) { + errs++; + printf( "Intracomm rank %d (from parent) should have rank %d\n", + icrank, wrank ); + } + } + } + + /* At this point, try to form the intracommunicator, with the other + processes first */ + MPI_Intercomm_merge( intercomm, !isChild, &intracomm2 ); + + /* Check on the intra comm */ + { + int icsize, icrank, wrank; + + MPI_Comm_size( intracomm2, &icsize ); + MPI_Comm_rank( intracomm2, &icrank ); + MPI_Comm_rank( MPI_COMM_WORLD, &wrank ); + + if (icsize != rsize + size) { + errs++; + printf( "(2)Intracomm rank %d thinks size is %d, not %d\n", + icrank, icsize, rsize + size ); + } + /* Make sure that the processes are ordered correctly */ + if (isChild) { + if (icrank != wrank ) { + errs++; + printf( "(2)Intracomm rank %d (from child) should have rank %d\n", + icrank, wrank ); + } + } + else { + int csize; + MPI_Comm_remote_size( intercomm, &csize ); + if (icrank != wrank + csize) { + errs++; + printf( "(2)Intracomm rank %d (from parent) should have rank %d\n", + icrank, wrank + csize ); + } + } + } + + /* At this point, try to form the intracommunicator, with an + arbitrary choice for the first group of processes */ + MPI_Intercomm_merge( intercomm, 0, &intracomm3 ); + /* Check on the intra comm */ + { + int icsize, icrank, wrank; + + MPI_Comm_size( intracomm3, &icsize ); + MPI_Comm_rank( intracomm3, &icrank ); + MPI_Comm_rank( MPI_COMM_WORLD, &wrank ); + + if (icsize != rsize + size) { + errs++; + printf( "(3)Intracomm rank %d thinks size is %d, not %d\n", + icrank, icsize, rsize + size ); + } + /* Eventually, we should test that the processes are ordered + correctly, by groups (must be one of the two cases above) */ + } + + /* Update error count */ + if (isChild) { + /* Send the errs back to the master process */ + MPI_Ssend( &errs, 1, MPI_INT, 0, 1, intercomm ); + } + else { + if (rank == 0) { + /* We could use intercomm reduce to get the errors from the + children, but we'll use a simpler loop to make sure that + we get valid data */ + for (i=0; i<rsize; i++) { + MPI_Recv( &err, 1, MPI_INT, i, 1, intercomm, MPI_STATUS_IGNORE ); + errs += err; + } + } + } + + /* It isn't necessary to free the intracomms, but it should not hurt */ + MPI_Comm_free( &intracomm ); + MPI_Comm_free( &intracomm2 ); + MPI_Comm_free( &intracomm3 ); + + /* It isn't necessary to free the intercomm, but it should not hurt */ + MPI_Comm_free( &intercomm ); + + /* Note that the MTest_Finalize get errs only over COMM_WORLD */ + /* Note also that both the parent and child will generate "No Errors" + if both call MTest_Finalize */ + if (parentcomm == MPI_COMM_NULL) { + MTest_Finalize( errs ); + } + } else { + MTest_Finalize( errs ); } MPI_Finalize(); diff --git a/test/mpi/spawn/spawnmanyarg.c b/test/mpi/spawn/spawnmanyarg.c index 1e69996..68d6c4e 100644 --- a/test/mpi/spawn/spawnmanyarg.c +++ b/test/mpi/spawn/spawnmanyarg.c @@ -32,85 +32,92 @@ int main( int argc, char *argv[] ) char *outargv[MAX_ARGV]; int narg = 40; char *saveArgp = 0; + int can_spawn; MTest_Init( &argc, &argv ); - /* Initialize the argument vectors */ - for (i=0; i<MAX_ARGV; i++) { - char *p; - p = (char *)malloc( 9 ); - if (!p) { - fprintf( stderr, "Unable to allocated memory\n" ); - MPI_Abort( MPI_COMM_WORLD, 1 ); - } - strcpy( p, "01234567" ); - inargv[i] = p; - p = (char *)malloc( 9 ); - if (!p) { - fprintf( stderr, "Unable to allocated memory\n" ); - MPI_Abort( MPI_COMM_WORLD, 1 ); - } - strcpy( p, "01234567" ); - outargv[i] = p; - } + errs += MTestSpawnPossible(&can_spawn); - MPI_Comm_get_parent( &parentcomm ); - - if (parentcomm == MPI_COMM_NULL) { - for (narg=16; narg < 512; narg += narg) { - /* Create 2 more processes */ - /* Set a null at argument length narg */ - saveArgp = inargv[narg]; - inargv[narg] = 0; - /* ./ is unix specific . - The more generic approach would be to specify "spawnmanyarg" as - the executable and pass an info with ("path", ".") */ - MPI_Comm_spawn( (char*)"./spawnmanyarg", inargv, np, - MPI_INFO_NULL, 0, MPI_COMM_WORLD, - &intercomm, errcodes ); - inargv[narg] = saveArgp; - /* We now have a valid intercomm */ - - /* Master */ - MPI_Comm_remote_size( intercomm, &rsize ); - MPI_Comm_size( intercomm, &size ); - MPI_Comm_rank( intercomm, &rank ); - - if (rsize != np) { - errs++; - printf( "Did not create %d processes (got %d)\n", np, rsize ); - } - /* Send the expected rank */ - for (i=0; i<rsize; i++) { - MPI_Send( &i, 1, MPI_INT, i, 0, intercomm ); - } - /* Send the number of arguments */ - for (i=0; i<rsize; i++) { - MPI_Send( &narg, 1, MPI_INT, i, 0, intercomm ); - } - /* We could use intercomm reduce to get the errors from the - children, but we'll use a simpler loop to make sure that - we get valid data */ - for (i=0; i<rsize; i++) { - MPI_Recv( &err, 1, MPI_INT, i, 1, intercomm, MPI_STATUS_IGNORE ); - errs += err; - } - - /* Free the intercomm before the next round of spawns */ - MPI_Comm_free( &intercomm ); - } - } - else { - /* Note that worker also send errs to the parent */ - errs += worker( argc, argv, parentcomm, outargv, np ); - MPI_Comm_free( &parentcomm ); - MPI_Finalize(); - return 0; - } + if (can_spawn) { + /* Initialize the argument vectors */ + for (i=0; i<MAX_ARGV; i++) { + char *p; + p = (char *)malloc( 9 ); + if (!p) { + fprintf( stderr, "Unable to allocated memory\n" ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + strcpy( p, "01234567" ); + inargv[i] = p; + p = (char *)malloc( 9 ); + if (!p) { + fprintf( stderr, "Unable to allocated memory\n" ); + MPI_Abort( MPI_COMM_WORLD, 1 ); + } + strcpy( p, "01234567" ); + outargv[i] = p; + } + + MPI_Comm_get_parent( &parentcomm ); + + if (parentcomm == MPI_COMM_NULL) { + for (narg=16; narg < 512; narg += narg) { + /* Create 2 more processes */ + /* Set a null at argument length narg */ + saveArgp = inargv[narg]; + inargv[narg] = 0; + /* ./ is unix specific . + The more generic approach would be to specify "spawnmanyarg" as + the executable and pass an info with ("path", ".") */ + MPI_Comm_spawn( (char*)"./spawnmanyarg", inargv, np, + MPI_INFO_NULL, 0, MPI_COMM_WORLD, + &intercomm, errcodes ); + inargv[narg] = saveArgp; + /* We now have a valid intercomm */ + + /* Master */ + MPI_Comm_remote_size( intercomm, &rsize ); + MPI_Comm_size( intercomm, &size ); + MPI_Comm_rank( intercomm, &rank ); + + if (rsize != np) { + errs++; + printf( "Did not create %d processes (got %d)\n", np, rsize ); + } + /* Send the expected rank */ + for (i=0; i<rsize; i++) { + MPI_Send( &i, 1, MPI_INT, i, 0, intercomm ); + } + /* Send the number of arguments */ + for (i=0; i<rsize; i++) { + MPI_Send( &narg, 1, MPI_INT, i, 0, intercomm ); + } + /* We could use intercomm reduce to get the errors from the + children, but we'll use a simpler loop to make sure that + we get valid data */ + for (i=0; i<rsize; i++) { + MPI_Recv( &err, 1, MPI_INT, i, 1, intercomm, MPI_STATUS_IGNORE ); + errs += err; + } + + /* Free the intercomm before the next round of spawns */ + MPI_Comm_free( &intercomm ); + } + } + else { + /* Note that worker also send errs to the parent */ + errs += worker( argc, argv, parentcomm, outargv, np ); + MPI_Comm_free( &parentcomm ); + MPI_Finalize(); + return 0; + } - /* Note that the MTest_Finalize get errs only over COMM_WORLD */ - if (parentcomm == MPI_COMM_NULL) { - MTest_Finalize( errs ); + /* Note that the MTest_Finalize get errs only over COMM_WORLD */ + if (parentcomm == MPI_COMM_NULL) { + MTest_Finalize( errs ); + } + } else { + MTest_Finalize( errs ); } MPI_Finalize(); diff --git a/test/mpi/spawn/spawnminfo1.c b/test/mpi/spawn/spawnminfo1.c index 0b6abc8..11c27d2 100644 --- a/test/mpi/spawn/spawnminfo1.c +++ b/test/mpi/spawn/spawnminfo1.c @@ -35,121 +35,128 @@ int main( int argc, char *argv[] ) char curdir[1024], wd[1024], childwd[1024]; char *commands[2] = { (char*)"spawnminfo1", (char*)"spawnminfo1" }; char *cerr; + int can_spawn; MTest_Init( &argc, &argv ); - cerr = getcwd( curdir, sizeof(curdir) ); - - MPI_Comm_get_parent( &parentcomm ); - - if (parentcomm == MPI_COMM_NULL) { - char *p; - /* Create 2 more processes. Make the working directory the - directory above the current running directory */ - strncpy( wd, curdir, sizeof(wd) ); - /* Lop off the last element of the directory */ - p = wd + strlen(wd) - 1; - while (p > wd && *p != '/' && *p != '\\') p--; - *p = 0; - - MPI_Info_create( &spawninfos[0] ); - MPI_Info_set( spawninfos[0], (char*)"path", curdir ); - MPI_Info_set( spawninfos[0], (char*)"wdir", wd ); - MPI_Info_create( &spawninfos[1] ); - MPI_Info_set( spawninfos[1], (char*)"path", curdir ); - MPI_Info_set( spawninfos[1], (char*)"wdir", curdir ); - MPI_Comm_spawn_multiple( 2, commands, MPI_ARGVS_NULL, np, - spawninfos, 0, MPI_COMM_WORLD, - &intercomm, errcodes ); - MPI_Info_free( &spawninfos[0] ); - MPI_Info_free( &spawninfos[1] ); - } - else - intercomm = parentcomm; - - /* We now have a valid intercomm */ - - MPI_Comm_remote_size( intercomm, &rsize ); - MPI_Comm_size( intercomm, &size ); - MPI_Comm_rank( intercomm, &rank ); - - if (parentcomm == MPI_COMM_NULL) { - /* Master */ - if (rsize != sumnp) { - errs++; - printf( "Did not create %d processes (got %d)\n", sumnp, rsize ); - } - if (rank == 0) { - for (i=0; i<rsize; i++) { - MPI_Send( &i, 1, MPI_INT, i, 0, intercomm ); - } - /* We could use intercomm reduce to get the errors from the - children, but we'll use a simpler loop to make sure that - we get valid data */ - for (i=0; i<rsize; i++) { - MPI_Recv( &err, 1, MPI_INT, i, 1, intercomm, MPI_STATUS_IGNORE ); - errs += err; - } - for (i=0; i<rsize; i++) { - char *expected = 0; - MPI_Recv( childwd, sizeof(childwd), MPI_CHAR, i, 2, intercomm, - MPI_STATUS_IGNORE ); - /* The first set uses wd the second set curdir */ - if (i <np[0]) expected = wd; - else expected = curdir; - if (strcmp( childwd, expected ) != 0) { - printf( "Expected a working dir of %s but child is in %s for child rank %d\n", - expected, childwd, i ); - errs ++; - } - } - } - } - else { - /* Child */ - char cname[MPI_MAX_OBJECT_NAME]; - int rlen; - - if (size != sumnp) { - errs++; - printf( "(Child) Did not create %d processes (got %d)\n", - sumnp, size ); - } - /* Check the name of the parent */ - cname[0] = 0; - MPI_Comm_get_name( intercomm, cname, &rlen ); - /* MPI-2 section 8.4 requires that the parent have this - default name */ - if (strcmp( cname, "MPI_COMM_PARENT" ) != 0) { - errs++; - printf( "Name of parent is not correct\n" ); - if (rlen > 0 && cname[0]) { - printf( " Got %s but expected MPI_COMM_PARENT\n", cname ); - } - else { - printf( " Expected MPI_COMM_PARENT but no name set\n" ); - } - } - MPI_Recv( &i, 1, MPI_INT, 0, 0, intercomm, &status ); - if (i != rank) { - errs++; - printf( "Unexpected rank on child %d (%d)\n", rank, i ); - } - /* Send our notion of the current directory to the parent */ - MPI_Send( curdir, strlen(curdir)+1, MPI_CHAR, 0, 2, intercomm ); - - /* Send the errs back to the master process */ - MPI_Ssend( &errs, 1, MPI_INT, 0, 1, intercomm ); - } + errs += MTestSpawnPossible(&can_spawn); + + if (can_spawn) { + cerr = getcwd( curdir, sizeof(curdir) ); + + MPI_Comm_get_parent( &parentcomm ); + + if (parentcomm == MPI_COMM_NULL) { + char *p; + /* Create 2 more processes. Make the working directory the + directory above the current running directory */ + strncpy( wd, curdir, sizeof(wd) ); + /* Lop off the last element of the directory */ + p = wd + strlen(wd) - 1; + while (p > wd && *p != '/' && *p != '\\') p--; + *p = 0; + + MPI_Info_create( &spawninfos[0] ); + MPI_Info_set( spawninfos[0], (char*)"path", curdir ); + MPI_Info_set( spawninfos[0], (char*)"wdir", wd ); + MPI_Info_create( &spawninfos[1] ); + MPI_Info_set( spawninfos[1], (char*)"path", curdir ); + MPI_Info_set( spawninfos[1], (char*)"wdir", curdir ); + MPI_Comm_spawn_multiple( 2, commands, MPI_ARGVS_NULL, np, + spawninfos, 0, MPI_COMM_WORLD, + &intercomm, errcodes ); + MPI_Info_free( &spawninfos[0] ); + MPI_Info_free( &spawninfos[1] ); + } + else + intercomm = parentcomm; + + /* We now have a valid intercomm */ + + MPI_Comm_remote_size( intercomm, &rsize ); + MPI_Comm_size( intercomm, &size ); + MPI_Comm_rank( intercomm, &rank ); + + if (parentcomm == MPI_COMM_NULL) { + /* Master */ + if (rsize != sumnp) { + errs++; + printf( "Did not create %d processes (got %d)\n", sumnp, rsize ); + } + if (rank == 0) { + for (i=0; i<rsize; i++) { + MPI_Send( &i, 1, MPI_INT, i, 0, intercomm ); + } + /* We could use intercomm reduce to get the errors from the + children, but we'll use a simpler loop to make sure that + we get valid data */ + for (i=0; i<rsize; i++) { + MPI_Recv( &err, 1, MPI_INT, i, 1, intercomm, MPI_STATUS_IGNORE ); + errs += err; + } + for (i=0; i<rsize; i++) { + char *expected = 0; + MPI_Recv( childwd, sizeof(childwd), MPI_CHAR, i, 2, intercomm, + MPI_STATUS_IGNORE ); + /* The first set uses wd the second set curdir */ + if (i <np[0]) expected = wd; + else expected = curdir; + if (strcmp( childwd, expected ) != 0) { + printf( "Expected a working dir of %s but child is in %s for child rank %d\n", + expected, childwd, i ); + errs ++; + } + } + } + } + else { + /* Child */ + char cname[MPI_MAX_OBJECT_NAME]; + int rlen; + + if (size != sumnp) { + errs++; + printf( "(Child) Did not create %d processes (got %d)\n", + sumnp, size ); + } + /* Check the name of the parent */ + cname[0] = 0; + MPI_Comm_get_name( intercomm, cname, &rlen ); + /* MPI-2 section 8.4 requires that the parent have this + default name */ + if (strcmp( cname, "MPI_COMM_PARENT" ) != 0) { + errs++; + printf( "Name of parent is not correct\n" ); + if (rlen > 0 && cname[0]) { + printf( " Got %s but expected MPI_COMM_PARENT\n", cname ); + } + else { + printf( " Expected MPI_COMM_PARENT but no name set\n" ); + } + } + MPI_Recv( &i, 1, MPI_INT, 0, 0, intercomm, &status ); + if (i != rank) { + errs++; + printf( "Unexpected rank on child %d (%d)\n", rank, i ); + } + /* Send our notion of the current directory to the parent */ + MPI_Send( curdir, strlen(curdir)+1, MPI_CHAR, 0, 2, intercomm ); + + /* Send the errs back to the master process */ + MPI_Ssend( &errs, 1, MPI_INT, 0, 1, intercomm ); + } - /* It isn't necessary to free the intercomm, but it should not hurt */ - MPI_Comm_free( &intercomm ); + /* It isn't necessary to free the intercomm, but it should not hurt */ + MPI_Comm_free( &intercomm ); - /* Note that the MTest_Finalize get errs only over COMM_WORLD */ - /* Note also that both the parent and child will generate "No Errors" - if both call MTest_Finalize */ - if (parentcomm == MPI_COMM_NULL) { - MTest_Finalize( errs ); + /* Note that the MTest_Finalize get errs only over COMM_WORLD */ + /* Note also that both the parent and child will generate "No Errors" + if both call MTest_Finalize */ + if (parentcomm == MPI_COMM_NULL) { + MTest_Finalize( errs ); + } + } else { + MTest_Finalize( errs ); } MPI_Finalize(); diff --git a/test/mpi/spawn/spawnmult2.c b/test/mpi/spawn/spawnmult2.c index 107403a..ab5b5a1 100644 --- a/test/mpi/spawn/spawnmult2.c +++ b/test/mpi/spawn/spawnmult2.c @@ -24,96 +24,103 @@ int main( int argc, char *argv[] ) int flag; static int np[2] = { 1, 1 }; int *appnum_ptr; + int can_spawn; MTest_Init( &argc, &argv ); - MPI_Comm_get_parent( &parentcomm ); - if (parentcomm == MPI_COMM_NULL) { - /* Create 2 more processes */ - static char *cmds[2] = { (char*)"./spawnmult2", (char*)"./spawnmult2" }; - static MPI_Info infos[2] = { MPI_INFO_NULL, MPI_INFO_NULL }; - int errcodes[2]; + MTestSpawnPossible(&can_spawn); - MPI_Comm_spawn_multiple( 2, cmds, MPI_ARGVS_NULL, np, infos, 0, - MPI_COMM_WORLD, &intercomm, errcodes ); + if (can_spawn) { + MPI_Comm_get_parent( &parentcomm ); + if (parentcomm == MPI_COMM_NULL) { + /* Create 2 more processes */ + static char *cmds[2] = { (char*)"./spawnmult2", (char*)"./spawnmult2" }; + static MPI_Info infos[2] = { MPI_INFO_NULL, MPI_INFO_NULL }; + int errcodes[2]; - } - else { - intercomm = parentcomm; - } + MPI_Comm_spawn_multiple( 2, cmds, MPI_ARGVS_NULL, np, infos, 0, + MPI_COMM_WORLD, &intercomm, errcodes ); - /* We now have a valid intercomm */ - MPI_Comm_remote_size( intercomm, &rsize ); - MPI_Comm_size( intercomm, &size ); - MPI_Comm_rank( intercomm, &rank ); + } + else { + intercomm = parentcomm; + } - if (parentcomm == MPI_COMM_NULL) { - /* This is the master process */ - if (rsize != np[0] + np[1]) { - errs++; - printf( "Did not create %d processes (got %d)\n", - np[0] + np[1], rsize ); - } - if (rank == 0) { - /* Tell each child process what rank we think they are */ - for (i=0; i<rsize; i++) { - MPI_Send( &i, 1, MPI_INT, i, 0, intercomm ); - } - /* We could use intercomm reduce to get the errors from the - * children, but we'll use a simpler loop to make sure that - * we get valid data */ - for (i=0; i<rsize; i++) { - MPI_Recv( &err, 1, MPI_INT, i, 1, intercomm, - MPI_STATUS_IGNORE ); - errs += err; - } - } - } - else { - /* Child process */ - /* FIXME: This assumes that stdout is handled for the children - * (the error count will still be reported to the parent) */ - if (size != 2) { - int wsize; - errs++; - printf( "(Child) Did not create 2 processes (got %d)\n", size); - MPI_Comm_size( MPI_COMM_WORLD, &wsize ); - if (wsize == 2) { - errs++; - printf( "(Child) world size is 2 but local intercomm size is not 2\n" ); - } - } - - MPI_Recv( &i, 1, MPI_INT, 0, 0, intercomm, &status ); - if (i != rank) { - errs++; - printf( "Unexpected rank on child %d (%d)\n", rank, i ); - } + /* We now have a valid intercomm */ + MPI_Comm_remote_size( intercomm, &rsize ); + MPI_Comm_size( intercomm, &size ); + MPI_Comm_rank( intercomm, &rank ); - /* Check for correct APPNUM */ - MPI_Comm_get_attr( MPI_COMM_WORLD, MPI_APPNUM, &appnum_ptr, &flag ); - /* My appnum should be my rank in comm world */ - if (flag) { - if (*appnum_ptr != rank) { + if (parentcomm == MPI_COMM_NULL) { + /* This is the master process */ + if (rsize != np[0] + np[1]) { errs++; - printf( "appnum is %d but should be %d\n", *appnum_ptr, rank ); - } - } - else { - errs++; - printf( "appnum was not set\n" ); - } + printf( "Did not create %d processes (got %d)\n", + np[0] + np[1], rsize ); + } + if (rank == 0) { + /* Tell each child process what rank we think they are */ + for (i=0; i<rsize; i++) { + MPI_Send( &i, 1, MPI_INT, i, 0, intercomm ); + } + /* We could use intercomm reduce to get the errors from the + * children, but we'll use a simpler loop to make sure that + * we get valid data */ + for (i=0; i<rsize; i++) { + MPI_Recv( &err, 1, MPI_INT, i, 1, intercomm, + MPI_STATUS_IGNORE ); + errs += err; + } + } + } + else { + /* Child process */ + /* FIXME: This assumes that stdout is handled for the children + * (the error count will still be reported to the parent) */ + if (size != 2) { + int wsize; + errs++; + printf( "(Child) Did not create 2 processes (got %d)\n", size); + MPI_Comm_size( MPI_COMM_WORLD, &wsize ); + if (wsize == 2) { + errs++; + printf( "(Child) world size is 2 but local intercomm size is not 2\n" ); + } + } - /* Send the errs back to the master process */ - MPI_Ssend( &errs, 1, MPI_INT, 0, 1, intercomm ); - } + MPI_Recv( &i, 1, MPI_INT, 0, 0, intercomm, &status ); + if (i != rank) { + errs++; + printf( "Unexpected rank on child %d (%d)\n", rank, i ); + } + + /* Check for correct APPNUM */ + MPI_Comm_get_attr( MPI_COMM_WORLD, MPI_APPNUM, &appnum_ptr, &flag ); + /* My appnum should be my rank in comm world */ + if (flag) { + if (*appnum_ptr != rank) { + errs++; + printf( "appnum is %d but should be %d\n", *appnum_ptr, rank ); + } + } + else { + errs++; + printf( "appnum was not set\n" ); + } + + /* Send the errs back to the master process */ + MPI_Ssend( &errs, 1, MPI_INT, 0, 1, intercomm ); + } - /* It isn't necessary to free the intercomm, but it should not hurt */ - MPI_Comm_free( &intercomm ); + /* It isn't necessary to free the intercomm, but it should not hurt */ + MPI_Comm_free( &intercomm ); - /* Note that the MTest_Finalize get errs only over COMM_WORLD */ - if (parentcomm == MPI_COMM_NULL) { - MTest_Finalize( errs ); + /* Note that the MTest_Finalize get errs only over COMM_WORLD */ + if (parentcomm == MPI_COMM_NULL) { + MTest_Finalize( errs ); + } + } else { + MTest_Finalize( errs ); } MPI_Finalize(); diff --git a/test/mpi/spawn/taskmaster.c b/test/mpi/spawn/taskmaster.c index a68aab3..4a06629 100644 --- a/test/mpi/spawn/taskmaster.c +++ b/test/mpi/spawn/taskmaster.c @@ -7,6 +7,7 @@ #include <stdlib.h> #include <pthread.h> #include <mpi.h> +#include "mpitest.h" #define DEFAULT_TASKS 128 #define DEFAULT_TASK_WINDOW 2 @@ -65,6 +66,7 @@ int main(int argc, char *argv[]) #else MPI_Comm * child; #endif /* USE_THREADS */ + int can_spawn, errs = 0; #ifdef USE_THREADS CHECK_SUCCESS(MPI_Init_thread(&argc, &argv, MPI_THREAD_MULTIPLE, &provided)); @@ -76,6 +78,17 @@ int main(int argc, char *argv[]) CHECK_SUCCESS(MPI_Init(&argc, &argv)); #endif + errs += MTestSpawnPossible(&can_spawn); + + if (!can_spawn) { + if (errs) + printf( " Found %d errors\n", errs ); + else + printf( " No Errors\n" ); + fflush( stdout ); + goto fn_exit; + } + CHECK_SUCCESS(MPI_Comm_get_parent(&parent)); if (parent == MPI_COMM_NULL) { /* Parent communicator */ diff --git a/test/mpi/util/mtest.c b/test/mpi/util/mtest.c index 553e533..43a1590 100644 --- a/test/mpi/util/mtest.c +++ b/test/mpi/util/mtest.c @@ -1711,3 +1711,59 @@ static void MTestRMACleanup( void ) #else static void MTestRMACleanup( void ) {} #endif + +/* ------------------------------------------------------------------------ */ +/* This function determines if it is possible to spawn addition MPI + * processes using MPI_COMM_SPAWN and MPI_COMM_SPAWN_MULTIPLE. + * + * It sets the can_spawn value to one of the following: + * 1 = yes, additional processes can be spawned + * 0 = no, MPI_UNIVERSE_SIZE <= the size of MPI_COMM_WORLD + * -1 = it is unknown whether or not processes can be spawned + * due to errors in the necessary query functions + * + */ +int MTestSpawnPossible(int * can_spawn) +{ + int errs = 0; + + void * v = NULL; + int flag = -1; + int vval = -1; + int rc; + + rc = MPI_Comm_get_attr( MPI_COMM_WORLD, MPI_UNIVERSE_SIZE, &v, &flag ); + if (rc!=MPI_SUCCESS) { + /* MPI_UNIVERSE_SIZE keyval missing from MPI_COMM_WORLD attributes */ + *can_spawn = -1; + errs++; + } + else { + /* MPI_UNIVERSE_SIZE need not be set */ + if (flag) { + + int size = -1; + rc = MPI_Comm_size(MPI_COMM_WORLD, &size); + if (rc!=MPI_SUCCESS) { + /* MPI_Comm_size failed for MPI_COMM_WORLD */ + *can_spawn = -1; + errs++; + } + + vval = *(int *)v; + if (vval <= size) { + /* no additional processes can be spawned */ + *can_spawn = 0; + } + else { + *can_spawn = 1; + } + } + else { + /* No attribute associated with key MPI_UNIVERSE_SIZE of MPI_COMM_WORLD */ + *can_spawn = -1; + } + } + return errs; +} +/* ------------------------------------------------------------------------ */ ----------------------------------------------------------------------- Summary of changes: test/mpi/f77/spawn/spawnargvf.f | 8 + test/mpi/f77/spawn/spawnf.f | 8 + test/mpi/f77/spawn/spawnmult2f.f | 9 + test/mpi/f77/spawn/spawnmultf.f | 8 + test/mpi/f77/util/mtestf.f | 40 ++++ test/mpi/f90/spawn/spawnargvf03.f90 | 9 + test/mpi/f90/spawn/spawnmultf03.f90 | 8 + test/mpi/include/mpitest.h | 2 + test/mpi/include/mpitestcxx.h | 2 + test/mpi/spawn/concurrent_spawns.c | 145 +++++++------- test/mpi/spawn/disconnect.c | 135 +++++++------ test/mpi/spawn/disconnect2.c | 199 ++++++++++--------- test/mpi/spawn/disconnect3.c | 199 ++++++++++--------- test/mpi/spawn/disconnect_reconnect.c | 287 ++++++++++++++------------- test/mpi/spawn/disconnect_reconnect2.c | 347 ++++++++++++++++--------------- test/mpi/spawn/disconnect_reconnect3.c | 280 +++++++++++++------------- test/mpi/spawn/spaconacc.c | 315 +++++++++++++++-------------- test/mpi/spawn/spaconacc2.c | 321 +++++++++++++++-------------- test/mpi/spawn/spaiccreate.c | 117 ++++++----- test/mpi/spawn/spaiccreate2.c | 93 +++++---- test/mpi/spawn/spawn1.c | 158 ++++++++------- test/mpi/spawn/spawn2.c | 253 ++++++++++++----------- test/mpi/spawn/spawnargv.c | 153 ++++++++------- test/mpi/spawn/spawninfo1.c | 211 ++++++++++---------- test/mpi/spawn/spawnintra.c | 337 ++++++++++++++++--------------- test/mpi/spawn/spawnmanyarg.c | 155 ++++++++------- test/mpi/spawn/spawnminfo1.c | 227 +++++++++++---------- test/mpi/spawn/spawnmult2.c | 163 ++++++++------- test/mpi/spawn/taskmaster.c | 13 ++ test/mpi/util/mtest.c | 56 +++++ 30 files changed, 2282 insertions(+), 1976 deletions(-) hooks/post-receive -- MPICH primary repository