1dnl
2dnl Contains common m4 macros used in testing routines.
3dnl
4dnl
5dnl standard precision combination to generate various testing procedures
6define(`PREC_ARGS',
7  ``s, s, s', `d, d, d', `c, c, c', `z, z, z',
8   `c, s, s', `c, s, c', `c, c, s',
9   `z, d, d', `z, d, z', `z, z, d',
10   `d, s, s', `d, s, d', `d, d, s',
11   `z, c, c', `z, c, z', `z, z, c'')dnl
12dnl
13dnl
14dnl CABS(x) ... compute the absolute value of complex number x.
15define(`CABS',`sqrt($1[0]*$1[0] + $1[1]*$1[1])')dnl
16dnl
17dnl
18dnl ASSIGN_PTR_TO_SCALAR(a, a_type, b, b_type) ... set a = *b
19define(`ASSIGN_PTR_TO_SCALAR',
20  `IF_REAL($2, `$1 = *$3;', `$1[0] = $3[0]; $1[1] = $3[1];')')dnl
21dnl
22dnl ASSIGN_SCALAR_TO_PTR(a, a_type, b, b_type) ... set *a = b
23define(`ASSIGN_SCALAR_TO_PTR',
24  `IF_REAL($4, `*$1 = $3;', `$1[0] = $3[0]; $1[1] = $3[1];')')dnl
25dnl
26dnl
27dnl ZERO_IMAG_PART(x, type) ... imag(x) = 0
28define(`ZERO_IMAG_PART', `ifelse(
29  REAL_COMPLEX($2), `complex', `$1[1] = 0.0;')')dnl
30dnl
31dnl
32define(`IS_MIXED', `ifelse(
33  __IS_MIXED_ABBREV($1, $2), `t', `t',
34  `$3', `', `f',
35  __IS_MIXED_ABBREV($2, $3))')dnl
36dnl
37dnl
38define(`__IS_MIXED_ABBREV',
39  `ifelse(REAL_COMPLEX($1_type), REAL_COMPLEX($2_type), `f', `t')')dnl
40dnl
41dnl
42define(`IS_MIXED_PREC', `ifelse(
43  `$#', `2', `ifelse(PREC($1)PREC($2), PREC($1)PREC($1), `f', `t')',
44  `ifelse(PREC($1)PREC($2)PREC($3), PREC($1)PREC($1)PREC($1), `f', `t')')')dnl
45dnl
46dnl
47dnl RANDOM(x, x_type, round_to_single)
48dnl Set x to a random number.  If round_to_single is t, round the number to single.
49define(`RANDOM', `ifelse(
50  REAL_COMPLEX($2), `real', `$1 = ifelse(`$3', `t', `(float)') xrand(seed);',
51  `$1[0] = ifelse(`$3', `t', `(float)') xrand(seed);
52   $1[1] = ifelse(`$3', `t', `(float)') xrand(seed);')')dnl
53dnl
54dnl
55define(`LOWER_PREC', `ifelse(
56  `$#', `1', `$1',
57  `$#', `2', `ifelse(
58    `$1', `D', `$2',
59    `$2', `D', `$1', `S')',
60  `LOWER_PREC($1, LOWER_PREC(shift($@)))')')dnl
61dnl
62dnl
63define(`SET_EPS',
64  `$2 = power(2, -BITS_`'PREC($1));')dnl
65dnl
66dnl
67define(`SET_UN',
68  `$2 = pow((double) BLAS_fpinfo_x(blas_base, BLAS_PREC($1)),
69            (double) BLAS_fpinfo_x(blas_emin, BLAS_PREC($1)));')dnl
70dnl
71dnl
72dnl SET_INTERNAL_PARAMS(type, _x)
73dnl If called with one argument, sets underflow and precision of given
74dnl type.  If _x is present, then sets the appropriate underflow and
75dnl precision values based on prec_val variable.
76define(`SET_INTERNAL_PARAMS',
77  `ifelse(`$2', `_x',
78    `switch(prec_val){
79       case 0:
80         SET_EPS($1, eps_int)
81         SET_UN($1, un_int)
82         prec = BLAS_PREC($1);
83         break;
84       case 1:
85         SET_EPS(real_D, eps_int)
86         SET_UN(real_D, un_int)
87         prec = BLAS_PREC(real_D);
88         break;
89       case 2:
90       default:
91         SET_EPS(real_E, eps_int)
92         SET_UN(real_E, un_int)
93         prec = BLAS_PREC(real_E);
94         break;
95     }',
96    `SET_EPS($1, eps_int)
97     SET_UN($1, un_int)
98     prec = BLAS_PREC($1);')')dnl
99dnl
100dnl
101dnl PRINT_NUMBER(var, type) ... print value of var
102define(`PRINT_NUMBER', `ifelse(
103  `$2', `real_S', `printf("%16.8e", $1);',
104  `$2', `real_D', `printf("%24.16e", $1);',
105  `$2', `complex_S', `printf("(%16.8e, %16.8e)", $1[0], $1[1]);',
106  `$2', `complex_D', `printf("(%24.16e, %24.16e)", $1[0], $1[1]);',
107  `$2', `real_E', `printf("[%24.16e %24.16e]", HEAD($1), TAIL($1));',
108  `$2', `complex_E',
109    `printf("([%24.16e  %24.16e], [%24.16e %24.16e])",
110      HEAD($1)[0], TAIL($1)[0], HEAD($1)[1], TAIL($1)[1]);', `
111#error Unknown type for PRINT_NUMBER')')dnl
112dnl
113dnl
114dnl ---------------------------------------------------------------------
115dnl Usage: PRINT_VAR(var, type, name)
116dnl        print var
117dnl
118dnl        type : the type and precision var
119dnl The type and precision specifier can be one of
120dnl        real_S       ... real and single
121dnl        real_D       ... real and double
122dnl        real_I       ... real and indigenous
123dnl        real_E       ... real and extra
124dnl        complex_S    ... complex and single
125dnl        complex_D    ... complex and double
126dnl        complex_I    ... complex and indigeneous
127dnl        complex_E    ... complex and extra
128dnl ----------------------------------------------------------------------
129define(`PRINT_VAR',
130  `ifelse(`$3', `', `printf("$1 = "); ', `printf("$3 = "); ')PRINT_NUMBER($1, $2)')dnl
131dnl
132dnl
133dnl ---------------------------------------------------------------------
134dnl Usage: PRINT_ARRAY_ELEM(var, index, type, name)
135dnl        print var[index]
136dnl
137dnl        type : the type and precision var
138dnl The type and precision specifier can be one of
139dnl        real_S       ... real and single
140dnl        real_D       ... real and double
141dnl        real_I       ... real and indigenous
142dnl        real_E       ... real and extra
143dnl        complex_S    ... complex and single
144dnl        complex_D    ... complex and double
145dnl        complex_I    ... complex and indigeneous
146dnl        complex_E    ... complex and extra
147dnl ----------------------------------------------------------------------
148define(`PRINT_ARRAY_ELEM',`ifelse(`$4', `', `', `printf("$4[%d] = ", $2); ')ifelse(
149  `$3', `real_S', `printf("%16.8e", $1[$2]);',
150  `$3', `real_D', `printf("%24.16e", $1[$2]);',
151  `$3', `complex_S', `printf("(%16.8e, %16.8e)", $1[$2], $1[$2+1]);',
152  `$3', `complex_D', `printf("(%24.16e, %24.16e)", $1[$2], $1[$2+1]);',
153  `$3', `real_E', `printf("[%24.16e, %24.16e]", HEAD($1)[$2], TAIL($1)[$2]);',
154  `$3', `complex_E',
155    `printf("([%24.16e  %24.16e], [%24.16e %24.16e])",
156      HEAD($1)[$2], TAIL($1)[$2], HEAD($1)[$2+1], TAIL($1)[$2+1]);', `
157#error Unknown type for PRINT_ARRAY_ELEM')')dnl
158dnl
159dnl
160dnl PRINT_PREC(prec)
161define(`PRINT_PREC',
162  `switch($1) {
163   case blas_prec_single:     printf("single "); break;
164   case blas_prec_double:     printf("double "); break;
165   case blas_prec_indigenous: printf("indigenous "); break;
166   case blas_prec_extra:      printf("extra "); break;
167}')dnl
168dnl
169dnl
170dnl PRINT_TRANS(name, var)
171define(`PRINT_TRANS',
172  `ifelse(`$2', `', `', `printf("$2:");
173   ')dnl
174   switch($1) {
175   case blas_no_trans:   printf("no_trans "); break;
176   case blas_trans:      printf("trans "); break;
177   case blas_conj_trans: printf("conj_trans "); break;
178}')dnl
179dnl
180dnl
181dnl PRINT_NORM(var)
182define(`PRINT_NORM',
183 `switch ($1) {
184  case -1: printf("near_underflow "); break;
185  case  0: printf("near_one "); break;
186  case  1: printf("near_overflow "); break;
187}')dnl
188dnl
189dnl
190dnl PRINT_ORDER(var)
191define(`PRINT_ORDER',
192 `switch ($1) {
193  case blas_rowmajor:
194       printf("row_major "); break;
195  case blas_colmajor:
196       printf("col_major "); break;
197}')dnl
198dnl
199dnl
200dnl PRINT_UPLO(var)
201define(`PRINT_UPLO',
202 `switch($1) {
203    case blas_upper: printf("upper "); break;
204    case blas_lower: printf("lower "); break;
205}')dnl
206dnl
207dnl
208dnl PRINT_DIAG(var)
209define(`PRINT_DIAG',
210 `switch($1) {
211    case blas_non_unit_diag: printf("non_unit_diag "); break;
212    case blas_unit_diag:     printf("unit_diag "); break;
213}')dnl
214dnl
215dnl
216dnl PRINT_CONJ(var)
217define(`PRINT_CONJ',
218 `switch($1){
219  case blas_no_conj: printf("no_conj "); break;
220  case blas_conj: printf("conj "); break;
221}')dnl
222dnl
223dnl
224dnl SET_ALPHA(type)
225dnl Sets alpha to zero, one, or leave it alone depending on alpha_val
226define(`SET_ALPHA',
227 `alpha_flag = 0;
228  switch (alpha_val) {
229  case 0:
230    ZERO(alpha, $1)
231    alpha_flag = 1;
232    break;
233  case 1:
234    ONE(alpha, $1)
235    alpha_flag = 1;
236    break;
237  }')dnl
238dnl
239dnl
240dnl SET_BETA(type)
241dnl Sets beta to zero, one, or leave it alone depending on beta_val
242define(`SET_BETA',
243 `beta_flag = 0;
244  switch (beta_val) {
245  case 0:
246    ZERO(beta, $1)
247    beta_flag = 1;
248    break;
249  case 1:
250    ONE(beta, $1)
251    beta_flag = 1;
252    break;
253  }')dnl
254dnl
255dnl
256dnl DOT_TESTGEN_NAME(abr_typeltr, x_typeltr, y_typeltr)
257define(`DOT_TESTGEN_NAME', `ifelse(
258  `$2&&$3', `$1&&$1', `BLAS_$1dot_testgen', `BLAS_$1dot_$2_$3_testgen')')dnl
259dnl
260dnl
261dnl DOT2_TESTGEN_NAME(abr_typeltr, x_typeltr, y_typeltr)
262define(`DOT2_TESTGEN_NAME', `ifelse(
263  `$2&&$3', `$1&&$1', `BLAS_$1dot2_testgen', `BLAS_$1dot2_$2_$3_testgen')')dnl
264dnl
265dnl
266dnl --------------------------------------------------------------------
267dnl Usage: TEST_DOT_NAME(abr_typeltr, x_typeltr, y_typeltr, extended)
268dnl        create a test_dot name
269dnl --------------------------------------------------------------------
270define(`TEST_DOT_NAME', `ifelse(
271        `$2&&$3', `$1&&$1',
272        `test_BLAS_$1dot',
273        `test_BLAS_$1dot_$2_$3')')dnl
274dnl
275dnl
276dnl --------------------------------------------------------------------
277dnl Usage: TEST_DOT2_NAME(aby_typeltr, A_typeltr, x_typeltr, extended)
278dnl        create a test_dot2 name
279dnl --------------------------------------------------------------------
280define(`TEST_DOT2_NAME', `ifelse(
281        `$2&&$3', `$1&&$1',
282        `test_BLAS_$1dot2',
283        `test_BLAS_$1dot2_$2_$3')')dnl
284dnl
285dnl
286dnl RAND_PTR(a, a_type)  ... *a = random
287define(`RAND_PTR', `ifelse(
288  `$2', `complex_S', `$1[0] = xrand(seed);  $1[1] = xrand(seed);',
289  `$2', `complex_D', `$1[0] = xrand(seed);  $1[1] = xrand(seed);',
290  `*$1 = xrand(seed);')')dnl
291dnl
292dnl
293define(`PRINT_TEST_RESULT', `
294  printf("\n");
295  if (nr_failed_routines)
296    printf("FAILED ");
297  else
298    printf("PASSED ");
299  printf("%-10s: FAIL/TOTAL = %d/%d\n",
300         base_routine, nr_failed_routines, nr_routines);
301')dnl
302dnl
303dnl
304define(`MAIN_TOP', `
305int main(int argc, char **argv) {
306  int nsizes, ntests, debug;
307  double thresh, test_prob;
308  double total_min_ratio, total_max_ratio;
309  int total_bad_ratios;
310  int seed, num_bad_ratio, num_tests;
311  int total_tests, nr_failed_routines = 0, nr_routines = 0;
312  double min_ratio, max_ratio;
313  const char *base_routine = "BASE_ROUTINE()";
314  char *fname;
315  int n;
316  $1
317
318  if (argc != 6) {
319    printf("Usage:\n");
320    printf("do_test_`'BASE_ROUTINE() <nsizes> <ntests> <thresh> <debug> <test_prob>\n");
321    printf("   <nsizes>: number of sizes to be run.\n");
322    printf("   <ntests>: the number of tests performed for each set of attributes\n");
323    printf("   <thresh>: to catch bad ratios if it is greater than <thresh>\n");
324    printf("    <debug>: 0, 1, 2, or 3; \n");
325    printf("        if 0, no printing \n");
326    printf("        if 1, print error summary only if tests fail\n");
327    printf("        if 2, print error summary for each n\n");
328    printf("        if 3, print complete info each test fails \n");
329    printf("<test_prob>: probability of preforming a given \n");
330    printf("           test case: 0.0 does no tests, 1.0 does all tests\n");
331    return -1;
332  } else {
333    nsizes= atoi(argv[1]);
334    ntests = atoi(argv[2]);
335    thresh = atof(argv[3]);
336    debug = atoi(argv[4]);
337    test_prob = atof(argv[5]);
338  }
339
340  seed = 1999;
341
342  if (nsizes<0 || ntests<0 || debug<0 || debug>3)
343    BLAS_error("Testing BASE_ROUTINE()", 0, 0, NULL);
344
345  printf("Testing %s...\n", base_routine);
346  printf("INPUT: nsizes = %d, ntests = %d, thresh = %4.2f, debug = %d\n\n",
347        nsizes, ntests, thresh, debug);
348
349  ')dnl
350dnl
351dnl
352define(`MAIN_BOTTOM', `
353  PRINT_TEST_RESULT
354  return 0;
355}
356')dnl
357dnl
358dnl
359dnl MAIN(preamble, body)
360define(`MAIN',
361`MAIN_TOP(`$1')
362  $2
363MAIN_BOTTOM()')dnl
364