2 /* Modifier: Bronis R. de Supinski (bronis@llnl.gov) Wed Nov 29 2000 */
3 /* lost-request2.c -- create requests that are never completed */
4 /* Derived directly from comm-split.c by John Gyllenhaal (see below) */
5 /* Written by John Gyllenhaal 10/25/02 to reproduce Gary Kerbel
6 * request leak that caused:
7 * 0:ERROR: 0032-160 Too many communicators (2046) in
8 * MPI_Comm_split, task 0
9 * when run for too many cycles.
12 * mpxlc comm_split.c -o comm_split
13 * Run with a multiple of two tasks, even tasks have the problem:
14 * comm_split -nodes 1 -procs 4
25 (int argc, char **argv)
27 int numtasks, rank, rc, split_rank, recv_int;
29 char processor_name[128];
36 rc = MPI_Init(&argc,&argv);
37 if (rc != MPI_SUCCESS)
39 printf ("Error starting MPI program. Terminating.\n");
40 MPI_Abort(MPI_COMM_WORLD, rc);
43 MPI_Comm_size(MPI_COMM_WORLD,&numtasks);
44 MPI_Comm_rank(MPI_COMM_WORLD,&rank);
45 MPI_Get_processor_name (processor_name, &namelen);
46 printf ("(%d) is alive on %s\n", rank, processor_name);
49 /* Must be multiple of two for this test */
50 if ((numtasks & 1) != 0)
52 printf ("Tasks must be multiple of two for this test. Terminating.\n");
53 MPI_Abort(MPI_COMM_WORLD, rc);
56 MPI_Barrier (MPI_COMM_WORLD);
58 /* CYCLE_COUNT = 2500 causes IBM implementation to die from request leak */
59 /* Can see problem with only a few (5) cycles */
60 for (cycle = 0; cycle < CYCLE_COUNT; cycle ++)
62 /* Split adjacent pairs into their own communicator group */
63 rc = MPI_Comm_split (MPI_COMM_WORLD, rank/2, rank, &split_comm);
64 if (rc != MPI_SUCCESS)
66 printf ("Error (rc %i) cycle %i doing MPI_Comm_split!\n",
68 MPI_Abort(MPI_COMM_WORLD, rc);
72 printf ("Split_comm handle %i in cycle %i\n", split_comm, cycle);
74 MPI_Comm_rank(split_comm, &split_rank);
78 rc = MPI_Issend (&cycle, 1, MPI_INT, 1, 0, split_comm, &request);
79 if (rc != MPI_SUCCESS)
81 printf ("Error (rc %i) cycle %i doing MPI_Isend!\n",
83 MPI_Abort(MPI_COMM_WORLD, rc);
85 /* HERE IS THE PROBLEM! Request not waited on, memory leak! */
87 else if (split_rank == 1)
89 rc = MPI_Irecv (&recv_int, 1, MPI_INT, 0, 0, split_comm,
91 if (rc != MPI_SUCCESS)
93 printf ("Error (rc %i) cycle %i doing MPI_Irecv!\n",
95 MPI_Abort(MPI_COMM_WORLD, rc);
100 rc = MPI_Test (&request, &done, &status);
101 if (rc != MPI_SUCCESS)
103 printf ("Error (rc %i) cycle %i doing MPI_Test!\n",
105 MPI_Abort(MPI_COMM_WORLD, rc);
110 printf ("Received %i in recv_int\n", recv_int);
114 /* Free the communicator */
115 rc = MPI_Comm_free (&split_comm);
116 if (rc != MPI_SUCCESS)
118 printf ("Error (rc %i) cycle %i doing MPI_Comm_free!\n",
120 MPI_Abort(MPI_COMM_WORLD, rc);
124 MPI_Barrier (MPI_COMM_WORLD);
127 printf ("(%d) Finished normally\n", rank);