1 /* -*- Mode: C; c-basic-offset:4 ; -*- */
2 /*
3 * (C) 2007 by Argonne National Laboratory.
4 * See COPYRIGHT in top-level directory.
5 */
6
7 /* a test to exercise very large extents: on most platforms with 32 bit
8 * integers, we'd expect these tests to give unexpected values. On platforms
9 * with 64 bit integers, these tests will be fine. On BlueGene we're not sure
10 * yet :>
11 */
12
13
14 #include <mpi.h>
15 #include <stdint.h>
16 #include <math.h>
17 #include <stdio.h>
18
19 #define CHECK(fn) {int errcode; errcode = (fn); if (errcode != MPI_SUCCESS) handle_error(errcode, NULL); }
20
21
handle_error(int errcode,char * str)22 static void handle_error(int errcode, char *str)
23 {
24 char msg[MPI_MAX_ERROR_STRING];
25 int resultlen;
26 MPI_Error_string(errcode, msg, &resultlen);
27 fprintf(stderr, "%s: %s\n", str, msg);
28 MPI_Abort(MPI_COMM_WORLD, 1);
29 }
30
typestats(MPI_Datatype type)31 static void typestats(MPI_Datatype type)
32 {
33 MPI_Aint lb, extent;
34 int size;
35
36 MPI_Type_get_extent(type, &lb, &extent);
37 MPI_Type_size(type, &size);
38
39 printf("dtype %d: lb = %ld extent = %ld size = %d...",
40 type, (long)lb, (long)extent, size);
41
42 }
43
verify_type(char * filename,MPI_Datatype type,int64_t expected_extent,int do_coll)44 static int verify_type(char *filename, MPI_Datatype type,
45 int64_t expected_extent, int do_coll)
46 {
47 int rank, canary, tsize;
48 int compare=-1;
49 int errs=0, toterrs=0;
50 MPI_Status status;
51 MPI_File fh;
52
53 MPI_Comm_rank(MPI_COMM_WORLD, &rank);
54
55 CHECK( MPI_File_open(MPI_COMM_WORLD, filename,
56 MPI_MODE_CREATE|MPI_MODE_RDWR, MPI_INFO_NULL, &fh));
57 CHECK( MPI_File_set_view(fh, rank*sizeof(int),
58 MPI_BYTE, type, "native", MPI_INFO_NULL));
59
60 MPI_Type_size(type, &tsize);
61
62 canary=rank+1000000;
63
64 /* skip over first instance of type */
65 if (do_coll) {
66 CHECK( MPI_File_write_at_all(fh, tsize, &canary, 1, MPI_INT, &status));
67 } else {
68 CHECK( MPI_File_write_at(fh, tsize, &canary, 1, MPI_INT, &status));
69 }
70
71 CHECK( MPI_File_set_view(fh, 0, MPI_INT, MPI_INT, "native",
72 MPI_INFO_NULL));
73
74 if (do_coll) {
75 CHECK( MPI_File_read_at_all(fh, expected_extent/sizeof(int)+rank,
76 &compare, 1, MPI_INT, &status));
77 } else {
78 CHECK( MPI_File_read_at(fh, expected_extent/sizeof(int)+rank,
79 &compare, 1, MPI_INT, &status));
80 }
81
82 if (compare != canary)
83 errs=1;
84 MPI_Allreduce(&errs, &toterrs, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD);
85
86 MPI_File_close(&fh);
87
88 if (toterrs) {
89 printf("%d: got %d expected %d\n", rank, compare, canary);
90 /* keep file if there's an error */
91 } else {
92 if (rank == 0) MPI_File_delete(filename, MPI_INFO_NULL);
93 }
94
95 return (toterrs);
96
97 }
98
testtype(char * filename,MPI_Datatype type,int64_t expected_extent)99 static int testtype(char *filename, MPI_Datatype type, int64_t expected_extent)
100 {
101 int rank, ret, errs=0;
102 int collective=1, nocollective=0;
103
104 MPI_Comm_rank(MPI_COMM_WORLD, &rank);
105 if (!rank) typestats(type);
106
107 ret = verify_type(filename, type, expected_extent, nocollective);
108 if (ret) {
109 errs++;
110 fprintf(stderr, "type %d failed indep\n", type);
111 } else
112 if (!rank) printf("indep: OK ");
113
114 ret = verify_type(filename, type, expected_extent, collective);
115 if (ret) {
116 errs++;
117 fprintf(stderr, "type %d failed collective\n", type);
118 } else
119 if (!rank) printf("coll: OK\n");
120
121 return errs;
122 }
123
main(int argc,char ** argv)124 int main(int argc, char **argv)
125 {
126 int count=2;
127 int blocks[2];
128 int disps[2];
129
130 int ndims=2;
131 int sizes[2];
132 int subs[2];
133 int starts[2];
134
135 MPI_Datatype baseindex, indexed1G, indexed3G, indexed6G;
136 MPI_Datatype subarray1G, subarray3G, subarray6G;
137 int ret, rank;
138
139 MPI_Init(&argc, &argv);
140
141 if (argc != 2) {
142 fprintf(stderr, "usage: %s <filename>\n", argv[0]);
143 MPI_Abort(MPI_COMM_WORLD, 1);
144 }
145
146 MPI_Comm_rank(MPI_COMM_WORLD, &rank);
147
148 /* base type: 1MB indexed type of ints*/
149 count = 2;
150 blocks[0] = 1;
151 disps[0] = 0;
152 blocks[1] = 1;
153 disps[1] = 1024*256-1;
154
155 MPI_Type_indexed(count, blocks, disps, MPI_INT, &baseindex);
156 /* simple case: 1GB extent */
157 MPI_Type_contiguous(1024, baseindex, &indexed1G);
158 MPI_Type_commit(&indexed1G);
159
160 /* a little trickier: 3Gb extent */
161 MPI_Type_contiguous(3072, baseindex, &indexed3G);
162 MPI_Type_commit(&indexed3G);
163
164 /* and finally 6GB extent */
165 MPI_Type_contiguous(6144, baseindex, &indexed6G);
166 MPI_Type_commit(&indexed6G);
167
168 /* TODO:
169 * - add a darray test
170 * - add a test with crazy extents */
171 sizes[0] = 1024*16;
172 sizes[1] = 1024*16;
173 subs[0] = subs[1] = 256;
174 starts[0] = starts[1] = 0;
175
176 MPI_Type_create_subarray(ndims, sizes, subs, starts,
177 MPI_ORDER_C, MPI_INT, &subarray1G);
178 MPI_Type_commit(&subarray1G);
179
180 sizes[1] = 1024*16*3;
181 MPI_Type_create_subarray(ndims, sizes, subs, starts,
182 MPI_ORDER_C, MPI_INT, &subarray3G);
183 MPI_Type_commit(&subarray3G);
184
185 sizes[1] = 1024*16*6;
186 MPI_Type_create_subarray(ndims, sizes, subs, starts,
187 MPI_ORDER_C, MPI_INT, &subarray6G);
188 MPI_Type_commit(&subarray6G);
189
190 /* assume command line arguments make it out to all processes */
191 ret = testtype(argv[1], indexed1G, (int64_t)1024*1024*1024);
192
193 ret = testtype(argv[1], indexed3G, (int64_t)1024*1024*1024*3);
194
195 ret = testtype(argv[1], indexed6G, (int64_t)1024*1024*1024*6);
196
197 ret = testtype(argv[1], subarray1G, (int64_t)1024*1024*1024);
198
199 ret = testtype(argv[1], subarray3G, (int64_t)1024*1024*1024*3);
200
201 ret = testtype(argv[1], subarray6G, (int64_t)1024*1024*1024*6);
202
203 if(!ret && !rank) fprintf(stderr, " No Errors\n");
204
205 MPI_Finalize();
206 return (-ret);
207
208 }
209 /*
210 * vim: ts=8 sts=4 sw=4 noexpandtab
211 */
212