teshsuite/smpi/mpich3-test/comm/iccreate.c

   1 /* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */
   2 /*
   3  *
   4  *  (C) 2007 by Argonne National Laboratory.
   5  *      See COPYRIGHT in top-level directory.
   6  */
   7 #include "mpi.h"
   8 #include <stdio.h>
   9 #include <stdlib.h>
  10 #include "mpitest.h"
  11
  12 /*
  13  * This program tests that MPI_Comm_create applies to intercommunicators;
  14  * this is an extension added in MPI-2
  15  */
  16
  17 int TestIntercomm( MPI_Comm );
  18
  19 int main( int argc, char *argv[] )
  20 {
  21     int errs = 0;
  22     int size, isLeft, wrank;
  23     MPI_Comm intercomm, newcomm;
  24     MPI_Group oldgroup, newgroup;
  25
  26     MTest_Init( &argc, &argv );
  27
  28     MPI_Comm_size( MPI_COMM_WORLD, &size );
  29     if (size < 4) {
  30         printf( "This test requires at least 4 processes\n" );
  31         MPI_Abort( MPI_COMM_WORLD, 1 );
  32         exit(1);
  33     }
  34     MPI_Comm_rank( MPI_COMM_WORLD, &wrank );
  35
  36     while (MTestGetIntercomm( &intercomm, &isLeft, 2 )) {
  37         int ranks[10], nranks, result;
  38
  39         if (intercomm == MPI_COMM_NULL) continue;
  40
  41         MPI_Comm_group( intercomm, &oldgroup );
  42         ranks[0] = 0;
  43         nranks   = 1;
  44         MTestPrintfMsg( 1, "Creating a new intercomm 0-0\n" );
  45         MPI_Group_incl( oldgroup, nranks, ranks, &newgroup );
  46         MPI_Comm_create( intercomm, newgroup, &newcomm );
  47
  48         /* Make sure that the new communicator has the appropriate pieces */
  49         if (newcomm != MPI_COMM_NULL) {
  50             int new_rsize, new_size, flag, commok = 1;
  51
  52             MPI_Comm_set_name( newcomm, (char*)"Single rank in each group" );
  53             MPI_Comm_test_inter( intercomm, &flag );
  54             if (!flag) {
  55                 errs++;
  56                 printf( "[%d] Output communicator is not an intercomm\n",
  57                         wrank );
  58                 commok = 0;
  59             }
  60
  61             MPI_Comm_remote_size( newcomm, &new_rsize );
  62             MPI_Comm_size( newcomm, &new_size );
  63             /* The new communicator has 1 process in each group */
  64             if (new_rsize != 1) {
  65                 errs++;
  66                 printf( "[%d] Remote size is %d, should be one\n",
  67                         wrank, new_rsize );
  68                 commok = 0;
  69             }
  70             if (new_size != 1) {
  71                 errs++;
  72                 printf( "[%d] Local size is %d, should be one\n",
  73                         wrank, new_size );
  74                 commok = 0;
  75             }
  76             /* ... more to do */
  77             if (commok) {
  78                 errs += TestIntercomm( newcomm );
  79             }
  80         }
  81         MPI_Group_free( &newgroup );
  82         if (newcomm != MPI_COMM_NULL) {
  83             MPI_Comm_free( &newcomm );
  84         }
  85
  86         /* Now, do a sort of dup, using the original group */
  87         MTestPrintfMsg( 1, "Creating a new intercomm (manual dup)\n" );
  88         MPI_Comm_create( intercomm, oldgroup, &newcomm );
  89         MPI_Comm_set_name( newcomm, (char*)"Dup of original" );
  90         MTestPrintfMsg( 1, "Creating a new intercomm (manual dup (done))\n" );
  91
  92         MPI_Comm_compare( intercomm, newcomm, &result );
  93         MTestPrintfMsg( 1, "Result of comm/intercomm compare is %d\n", result );
  94         if (result != MPI_CONGRUENT) {
  95             const char *rname=0;
  96             errs++;
  97             switch (result) {
  98             case MPI_IDENT:     rname = "IDENT"; break;
  99             case MPI_CONGRUENT: rname = "CONGRUENT"; break;
 100             case MPI_SIMILAR:   rname = "SIMILAR"; break;
 101             case MPI_UNEQUAL:   rname = "UNEQUAL"; break;
 102             printf( "[%d] Expected MPI_CONGRUENT but saw %d (%s)",
 103                     wrank, result, rname ); fflush(stdout);
 104             }
 105         }
 106         else {
 107             /* Try to communication between each member of intercomm */
 108             errs += TestIntercomm( newcomm );
 109         }
 110
 111         if (newcomm != MPI_COMM_NULL) {
 112             MPI_Comm_free(&newcomm);
 113         }
 114         /* test that an empty group in either side of the intercomm results in
 115          * MPI_COMM_NULL for all members of the comm */
 116         if (isLeft) {
 117             /* left side reuses oldgroup, our local group in intercomm */
 118             MPI_Comm_create(intercomm, oldgroup, &newcomm);
 119         }
 120         else {
 121             /* right side passes MPI_GROUP_EMPTY */
 122             MPI_Comm_create(intercomm, MPI_GROUP_EMPTY, &newcomm);
 123         }
 124         if (newcomm != MPI_COMM_NULL) {
 125             printf("[%d] expected MPI_COMM_NULL, but got a different communicator\n", wrank); fflush(stdout);
 126             errs++;
 127         }
 128
 129         if (newcomm != MPI_COMM_NULL) {
 130             MPI_Comm_free(&newcomm);
 131         }
 132         MPI_Group_free( &oldgroup );
 133         MPI_Comm_free( &intercomm );
 134     }
 135
 136     MTest_Finalize(errs);
 137
 138     MPI_Finalize();
 139
 140     return 0;
 141 }
 142
 143 int TestIntercomm( MPI_Comm comm )
 144 {
 145     int local_size, remote_size, rank, **bufs, *bufmem, rbuf[2], j;
 146     int errs = 0, wrank, nsize;
 147     char commname[MPI_MAX_OBJECT_NAME+1];
 148     MPI_Request *reqs;
 149
 150     MPI_Comm_rank( MPI_COMM_WORLD, &wrank );
 151     MPI_Comm_size( comm, &local_size );
 152     MPI_Comm_remote_size( comm, &remote_size );
 153     MPI_Comm_rank( comm, &rank );
 154     MPI_Comm_get_name( comm, commname, &nsize );
 155
 156     MTestPrintfMsg( 1, "Testing communication on intercomm '%s', remote_size=%d\n",
 157                     commname, remote_size );
 158
 159     reqs = (MPI_Request *)malloc( remote_size * sizeof(MPI_Request) );
 160     if (!reqs) {
 161         printf( "[%d] Unable to allocated %d requests for testing intercomm %s\n",
 162                 wrank, remote_size, commname );
 163         errs++;
 164         return errs;
 165     }
 166     bufs = (int **) malloc( remote_size * sizeof(int *) );
 167     if (!bufs) {
 168         printf( "[%d] Unable to allocated %d int pointers for testing intercomm %s\n",
 169                 wrank, remote_size, commname );
 170         errs++;
 171         return errs;
 172     }
 173     bufmem = (int *) malloc( remote_size * 2 * sizeof(int) );
 174     if (!bufmem) {
 175         printf( "[%d] Unable to allocated %d int data for testing intercomm %s\n",
 176                 wrank, 2*remote_size, commname );
 177         errs++;
 178         return errs;
 179     }
 180
 181     /* Each process sends a message containing its own rank and the
 182        rank of the destination with a nonblocking send.  Because we're using
 183        nonblocking sends, we need to use different buffers for each isend */
 184     /* NOTE: the send buffer access restriction was relaxed in MPI-2.2, although
 185        it doesn't really hurt to keep separate buffers for our purposes */
 186     for (j=0; j<remote_size; j++) {
 187         bufs[j]    = &bufmem[2*j];
 188         bufs[j][0] = rank;
 189         bufs[j][1] = j;
 190         MPI_Isend( bufs[j], 2, MPI_INT, j, 0, comm, &reqs[j] );
 191     }
 192     MTestPrintfMsg( 2, "isends posted, about to recv\n" );
 193
 194     for (j=0; j<remote_size; j++) {
 195         MPI_Recv( rbuf, 2, MPI_INT, j, 0, comm, MPI_STATUS_IGNORE );
 196         if (rbuf[0] != j) {
 197             printf( "[%d] Expected rank %d but saw %d in %s\n",
 198                     wrank, j, rbuf[0], commname );
 199             errs++;
 200         }
 201         if (rbuf[1] != rank) {
 202             printf( "[%d] Expected target rank %d but saw %d from %d in %s\n",
 203                     wrank, rank, rbuf[1], j, commname );
 204             errs++;
 205         }
 206     }
 207     if (errs)
 208         fflush(stdout);
 209     MTestPrintfMsg( 2, "my recvs completed, about to waitall\n" );
 210     MPI_Waitall( remote_size, reqs, MPI_STATUSES_IGNORE );
 211
 212     free( reqs );
 213     free( bufs );
 214     free( bufmem );
 215
 216     return errs;
 217 }