1/*
2 * mathtest.c - test rig for mathlib
3 *
4 * Copyright (c) 1998-2023, Arm Limited.
5 * SPDX-License-Identifier: MIT OR Apache-2.0 WITH LLVM-exception
6 */
7
8#include <assert.h>
9#include <stdio.h>
10#include <stdlib.h>
11#include <string.h>
12#include <setjmp.h>
13#include <ctype.h>
14#include <math.h>
15#include <errno.h>
16#include <limits.h>
17#include <fenv.h>
18#include "mathlib.h"
19
20#ifndef math_errhandling
21# define math_errhandling 0
22#endif
23
24#ifdef __cplusplus
25 #define EXTERN_C extern "C"
26#else
27 #define EXTERN_C extern
28#endif
29
30#ifndef TRUE
31#define TRUE 1
32#endif
33#ifndef FALSE
34#define FALSE 0
35#endif
36
37#ifdef IMPORT_SYMBOL
38#define STR2(x) #x
39#define STR(x) STR2(x)
40_Pragma(STR(import IMPORT_SYMBOL))
41#endif
42
43int dmsd, dlsd;
44int quiet = 0;
45int doround = 0;
46unsigned statusmask = FE_ALL_EXCEPT;
47
48#define EXTRABITS (12)
49#define ULPUNIT (1<<EXTRABITS)
50
51typedef int (*test) (void);
52
53/*
54  struct to hold info about a function (which could actually be a macro)
55*/
56typedef struct {
57    enum {
58        t_func, t_macro
59    } type;
60    enum {
61        at_d, at_s,      /* double or single precision float */
62        at_d2, at_s2,    /* same, but taking two args */
63        at_di, at_si,    /* double/single and an int */
64        at_dip, at_sip,  /* double/single and an int ptr */
65        at_ddp, at_ssp,  /* d/s and a d/s ptr */
66        at_dc, at_sc,    /* double or single precision complex */
67        at_dc2, at_sc2   /* same, but taking two args */
68    } argtype;
69    enum {
70        rt_d, rt_s, rt_i, /* double, single, int */
71        rt_dc, rt_sc,     /* double, single precision complex */
72        rt_d2, rt_s2      /* also use res2 */
73    } rettype;
74    union {
75        void* ptr;
76        double (*d_d_ptr)(double);
77        float (*s_s_ptr)(float);
78        int (*d_i_ptr)(double);
79        int (*s_i_ptr)(float);
80        double (*d2_d_ptr)(double, double);
81        float (*s2_s_ptr)(float, float);
82        double (*di_d_ptr)(double,int);
83        float (*si_s_ptr)(float,int);
84        double (*dip_d_ptr)(double,int*);
85        float (*sip_s_ptr)(float,int*);
86        double (*ddp_d_ptr)(double,double*);
87        float (*ssp_s_ptr)(float,float*);
88    } func;
89    enum {
90        m_none,
91        m_isfinite, m_isfinitef,
92        m_isgreater, m_isgreaterequal,
93        m_isgreaterequalf, m_isgreaterf,
94        m_isinf, m_isinff,
95        m_isless, m_islessequal,
96        m_islessequalf, m_islessf,
97        m_islessgreater, m_islessgreaterf,
98        m_isnan, m_isnanf,
99        m_isnormal, m_isnormalf,
100        m_isunordered, m_isunorderedf,
101        m_fpclassify, m_fpclassifyf,
102        m_signbit, m_signbitf,
103        /* not actually a macro, but makes things easier */
104        m_rred, m_rredf,
105        m_cadd, m_csub, m_cmul, m_cdiv,
106        m_caddf, m_csubf, m_cmulf, m_cdivf
107    } macro_name; /* only used if a macro/something that can't be done using func */
108    long long tolerance;
109    const char* name;
110} test_func;
111
112/* used in qsort */
113int compare_tfuncs(const void* a, const void* b) {
114    return strcmp(((test_func*)a)->name, ((test_func*)b)->name);
115}
116
117int is_double_argtype(int argtype) {
118    switch(argtype) {
119    case at_d:
120    case at_d2:
121    case at_dc:
122    case at_dc2:
123        return 1;
124    default:
125        return 0;
126    }
127}
128
129int is_single_argtype(int argtype) {
130    switch(argtype) {
131    case at_s:
132    case at_s2:
133    case at_sc:
134    case at_sc2:
135        return 1;
136    default:
137        return 0;
138    }
139}
140
141int is_double_rettype(int rettype) {
142    switch(rettype) {
143    case rt_d:
144    case rt_dc:
145    case rt_d2:
146        return 1;
147    default:
148        return 0;
149    }
150}
151
152int is_single_rettype(int rettype) {
153    switch(rettype) {
154    case rt_s:
155    case rt_sc:
156    case rt_s2:
157        return 1;
158    default:
159        return 0;
160    }
161}
162
163int is_complex_argtype(int argtype) {
164    switch(argtype) {
165    case at_dc:
166    case at_sc:
167    case at_dc2:
168    case at_sc2:
169        return 1;
170    default:
171        return 0;
172    }
173}
174
175int is_complex_rettype(int rettype) {
176    switch(rettype) {
177    case rt_dc:
178    case rt_sc:
179        return 1;
180    default:
181        return 0;
182    }
183}
184
185/*
186 * Special-case flags indicating that some functions' error
187 * tolerance handling is more complicated than a fixed relative
188 * error bound.
189 */
190#define ABSLOWERBOUND 0x4000000000000000LL
191#define PLUSMINUSPIO2 0x1000000000000000LL
192
193#define ARM_PREFIX(x) x
194
195#define TFUNC(arg,ret,name,tolerance) { t_func, arg, ret, (void*)&name, m_none, tolerance, #name }
196#define TFUNCARM(arg,ret,name,tolerance) { t_func, arg, ret, (void*)& ARM_PREFIX(name), m_none, tolerance, #name }
197#define MFUNC(arg,ret,name,tolerance) { t_macro, arg, ret, NULL, m_##name, tolerance, #name }
198
199#ifndef PL
200/* sincosf wrappers for easier testing.  */
201static float sincosf_sinf(float x) { float s,c; sincosf(x, &s, &c); return s; }
202static float sincosf_cosf(float x) { float s,c; sincosf(x, &s, &c); return c; }
203#endif
204
205test_func tfuncs[] = {
206    /* trigonometric */
207    TFUNC(at_d,rt_d, acos, 4*ULPUNIT),
208    TFUNC(at_d,rt_d, asin, 4*ULPUNIT),
209    TFUNC(at_d,rt_d, atan, 4*ULPUNIT),
210    TFUNC(at_d2,rt_d, atan2, 4*ULPUNIT),
211
212    TFUNC(at_d,rt_d, tan, 2*ULPUNIT),
213    TFUNC(at_d,rt_d, sin, 2*ULPUNIT),
214    TFUNC(at_d,rt_d, cos, 2*ULPUNIT),
215
216    TFUNC(at_s,rt_s, acosf, 4*ULPUNIT),
217    TFUNC(at_s,rt_s, asinf, 4*ULPUNIT),
218    TFUNC(at_s,rt_s, atanf, 4*ULPUNIT),
219    TFUNC(at_s2,rt_s, atan2f, 4*ULPUNIT),
220    TFUNCARM(at_s,rt_s, tanf, 4*ULPUNIT),
221    TFUNCARM(at_s,rt_s, sinf, 3*ULPUNIT/4),
222    TFUNCARM(at_s,rt_s, cosf, 3*ULPUNIT/4),
223#ifndef PL
224    TFUNCARM(at_s,rt_s, sincosf_sinf, 3*ULPUNIT/4),
225    TFUNCARM(at_s,rt_s, sincosf_cosf, 3*ULPUNIT/4),
226#endif
227    /* hyperbolic */
228    TFUNC(at_d, rt_d, atanh, 4*ULPUNIT),
229    TFUNC(at_d, rt_d, asinh, 4*ULPUNIT),
230    TFUNC(at_d, rt_d, acosh, 4*ULPUNIT),
231    TFUNC(at_d,rt_d, tanh, 4*ULPUNIT),
232    TFUNC(at_d,rt_d, sinh, 4*ULPUNIT),
233    TFUNC(at_d,rt_d, cosh, 4*ULPUNIT),
234
235    TFUNC(at_s, rt_s, atanhf, 4*ULPUNIT),
236    TFUNC(at_s, rt_s, asinhf, 4*ULPUNIT),
237    TFUNC(at_s, rt_s, acoshf, 4*ULPUNIT),
238    TFUNC(at_s,rt_s, tanhf, 4*ULPUNIT),
239    TFUNC(at_s,rt_s, sinhf, 4*ULPUNIT),
240    TFUNC(at_s,rt_s, coshf, 4*ULPUNIT),
241
242    /* exponential and logarithmic */
243    TFUNC(at_d,rt_d, log, 3*ULPUNIT/4),
244    TFUNC(at_d,rt_d, log10, 3*ULPUNIT),
245    TFUNC(at_d,rt_d, log2, 3*ULPUNIT/4),
246    TFUNC(at_d,rt_d, log1p, 2*ULPUNIT),
247    TFUNC(at_d,rt_d, exp, 3*ULPUNIT/4),
248    TFUNC(at_d,rt_d, exp2, 3*ULPUNIT/4),
249    TFUNC(at_d,rt_d, expm1, ULPUNIT),
250    TFUNCARM(at_s,rt_s, logf, ULPUNIT),
251    TFUNC(at_s,rt_s, log10f, 3*ULPUNIT),
252    TFUNCARM(at_s,rt_s, log2f, ULPUNIT),
253    TFUNC(at_s,rt_s, log1pf, 2*ULPUNIT),
254    TFUNCARM(at_s,rt_s, expf, 3*ULPUNIT/4),
255    TFUNCARM(at_s,rt_s, exp2f, 3*ULPUNIT/4),
256    TFUNC(at_s,rt_s, expm1f, ULPUNIT),
257    TFUNC(at_d,rt_d, exp10, ULPUNIT),
258
259    /* power */
260    TFUNC(at_d2,rt_d, pow, 3*ULPUNIT/4),
261    TFUNC(at_d,rt_d, sqrt, ULPUNIT/2),
262    TFUNC(at_d,rt_d, cbrt, 2*ULPUNIT),
263    TFUNC(at_d2, rt_d, hypot, 4*ULPUNIT),
264
265    TFUNCARM(at_s2,rt_s, powf, ULPUNIT),
266    TFUNC(at_s,rt_s, sqrtf, ULPUNIT/2),
267    TFUNC(at_s,rt_s, cbrtf, 2*ULPUNIT),
268    TFUNC(at_s2, rt_s, hypotf, 4*ULPUNIT),
269
270    /* error function */
271    TFUNC(at_d,rt_d, erf, 16*ULPUNIT),
272    TFUNC(at_s,rt_s, erff, 16*ULPUNIT),
273    TFUNC(at_d,rt_d, erfc, 16*ULPUNIT),
274    TFUNC(at_s,rt_s, erfcf, 16*ULPUNIT),
275
276    /* gamma functions */
277    TFUNC(at_d,rt_d, tgamma, 16*ULPUNIT),
278    TFUNC(at_s,rt_s, tgammaf, 16*ULPUNIT),
279    TFUNC(at_d,rt_d, lgamma, 16*ULPUNIT | ABSLOWERBOUND),
280    TFUNC(at_s,rt_s, lgammaf, 16*ULPUNIT | ABSLOWERBOUND),
281
282    TFUNC(at_d,rt_d, ceil, 0),
283    TFUNC(at_s,rt_s, ceilf, 0),
284    TFUNC(at_d2,rt_d, copysign, 0),
285    TFUNC(at_s2,rt_s, copysignf, 0),
286    TFUNC(at_d,rt_d, floor, 0),
287    TFUNC(at_s,rt_s, floorf, 0),
288    TFUNC(at_d2,rt_d, fmax, 0),
289    TFUNC(at_s2,rt_s, fmaxf, 0),
290    TFUNC(at_d2,rt_d, fmin, 0),
291    TFUNC(at_s2,rt_s, fminf, 0),
292    TFUNC(at_d2,rt_d, fmod, 0),
293    TFUNC(at_s2,rt_s, fmodf, 0),
294    MFUNC(at_d, rt_i, fpclassify, 0),
295    MFUNC(at_s, rt_i, fpclassifyf, 0),
296    TFUNC(at_dip,rt_d, frexp, 0),
297    TFUNC(at_sip,rt_s, frexpf, 0),
298    MFUNC(at_d, rt_i, isfinite, 0),
299    MFUNC(at_s, rt_i, isfinitef, 0),
300    MFUNC(at_d, rt_i, isgreater, 0),
301    MFUNC(at_d, rt_i, isgreaterequal, 0),
302    MFUNC(at_s, rt_i, isgreaterequalf, 0),
303    MFUNC(at_s, rt_i, isgreaterf, 0),
304    MFUNC(at_d, rt_i, isinf, 0),
305    MFUNC(at_s, rt_i, isinff, 0),
306    MFUNC(at_d, rt_i, isless, 0),
307    MFUNC(at_d, rt_i, islessequal, 0),
308    MFUNC(at_s, rt_i, islessequalf, 0),
309    MFUNC(at_s, rt_i, islessf, 0),
310    MFUNC(at_d, rt_i, islessgreater, 0),
311    MFUNC(at_s, rt_i, islessgreaterf, 0),
312    MFUNC(at_d, rt_i, isnan, 0),
313    MFUNC(at_s, rt_i, isnanf, 0),
314    MFUNC(at_d, rt_i, isnormal, 0),
315    MFUNC(at_s, rt_i, isnormalf, 0),
316    MFUNC(at_d, rt_i, isunordered, 0),
317    MFUNC(at_s, rt_i, isunorderedf, 0),
318    TFUNC(at_di,rt_d, ldexp, 0),
319    TFUNC(at_si,rt_s, ldexpf, 0),
320    TFUNC(at_ddp,rt_d2, modf, 0),
321    TFUNC(at_ssp,rt_s2, modff, 0),
322#ifndef BIGRANGERED
323    MFUNC(at_d, rt_d, rred, 2*ULPUNIT),
324#else
325    MFUNC(at_d, rt_d, m_rred, ULPUNIT),
326#endif
327    MFUNC(at_d, rt_i, signbit, 0),
328    MFUNC(at_s, rt_i, signbitf, 0),
329};
330
331/*
332 * keywords are: func size op1 op2 result res2 errno op1r op1i op2r op2i resultr resulti
333 * also we ignore: wrongresult wrongres2 wrongerrno
334 * op1 equivalent to op1r, same with op2 and result
335 */
336
337typedef struct {
338    test_func *func;
339    unsigned op1r[2]; /* real part, also used for non-complex numbers */
340    unsigned op1i[2]; /* imaginary part */
341    unsigned op2r[2];
342    unsigned op2i[2];
343    unsigned resultr[3];
344    unsigned resulti[3];
345    enum {
346        rc_none, rc_zero, rc_infinity, rc_nan, rc_finite
347    } resultc; /* special complex results, rc_none means use resultr and resulti as normal */
348    unsigned res2[2];
349    unsigned status;                   /* IEEE status return, if any */
350    unsigned maybestatus;             /* for optional status, or allowance for spurious */
351    int nresult;                       /* number of result words */
352    int in_err, in_err_limit;
353    int err;
354    int maybeerr;
355    int valid;
356    int comment;
357    int random;
358} testdetail;
359
360enum {                                 /* keywords */
361    k_errno, k_errno_in, k_error, k_func, k_maybeerror, k_maybestatus, k_op1, k_op1i, k_op1r, k_op2, k_op2i, k_op2r,
362    k_random, k_res2, k_result, k_resultc, k_resulti, k_resultr, k_status,
363    k_wrongres2, k_wrongresult, k_wrongstatus, k_wrongerrno
364};
365char *keywords[] = {
366    "errno", "errno_in", "error", "func", "maybeerror", "maybestatus", "op1", "op1i", "op1r", "op2", "op2i", "op2r",
367    "random", "res2", "result", "resultc", "resulti", "resultr", "status",
368    "wrongres2", "wrongresult", "wrongstatus", "wrongerrno"
369};
370
371enum {
372    e_0, e_EDOM, e_ERANGE,
373
374    /*
375     * This enum makes sure that we have the right number of errnos in the
376     * errno[] array
377     */
378    e_number_of_errnos
379};
380char *errnos[] = {
381    "0", "EDOM", "ERANGE"
382};
383
384enum {
385    e_none, e_divbyzero, e_domain, e_overflow, e_underflow
386};
387char *errors[] = {
388    "0", "divbyzero", "domain", "overflow", "underflow"
389};
390
391static int verbose, fo, strict;
392
393/* state toggled by random=on / random=off */
394static int randomstate;
395
396/* Canonify a double NaN: SNaNs all become 7FF00000.00000001 and QNaNs
397 * all become 7FF80000.00000001 */
398void canon_dNaN(unsigned a[2]) {
399    if ((a[0] & 0x7FF00000) != 0x7FF00000)
400        return;                        /* not Inf or NaN */
401    if (!(a[0] & 0xFFFFF) && !a[1])
402        return;                        /* Inf */
403    a[0] &= 0x7FF80000;                /* canonify top word */
404    a[1] = 0x00000001;                 /* canonify bottom word */
405}
406
407/* Canonify a single NaN: SNaNs all become 7F800001 and QNaNs
408 * all become 7FC00001. Returns classification of the NaN. */
409void canon_sNaN(unsigned a[1]) {
410    if ((a[0] & 0x7F800000) != 0x7F800000)
411        return;                        /* not Inf or NaN */
412    if (!(a[0] & 0x7FFFFF))
413        return;                        /* Inf */
414    a[0] &= 0x7FC00000;                /* canonify most bits */
415    a[0] |= 0x00000001;                /* canonify bottom bit */
416}
417
418/*
419 * Detect difficult operands for FO mode.
420 */
421int is_dhard(unsigned a[2])
422{
423    if ((a[0] & 0x7FF00000) == 0x7FF00000)
424        return TRUE;                   /* inf or NaN */
425    if ((a[0] & 0x7FF00000) == 0 &&
426        ((a[0] & 0x7FFFFFFF) | a[1]) != 0)
427        return TRUE;                   /* denormal */
428    return FALSE;
429}
430int is_shard(unsigned a[1])
431{
432    if ((a[0] & 0x7F800000) == 0x7F800000)
433        return TRUE;                   /* inf or NaN */
434    if ((a[0] & 0x7F800000) == 0 &&
435        (a[0] & 0x7FFFFFFF) != 0)
436        return TRUE;                   /* denormal */
437    return FALSE;
438}
439
440/*
441 * Normalise all zeroes into +0, for FO mode.
442 */
443void dnormzero(unsigned a[2])
444{
445    if (a[0] == 0x80000000 && a[1] == 0)
446        a[0] = 0;
447}
448void snormzero(unsigned a[1])
449{
450    if (a[0] == 0x80000000)
451        a[0] = 0;
452}
453
454static int find(char *word, char **array, int asize) {
455    int i, j;
456
457    asize /= sizeof(char *);
458
459    i = -1; j = asize;                 /* strictly between i and j */
460    while (j-i > 1) {
461        int k = (i+j) / 2;
462        int c = strcmp(word, array[k]);
463        if (c > 0)
464            i = k;
465        else if (c < 0)
466            j = k;
467        else                           /* found it! */
468            return k;
469    }
470    return -1;                         /* not found */
471}
472
473static test_func* find_testfunc(char *word) {
474    int i, j, asize;
475
476    asize = sizeof(tfuncs)/sizeof(test_func);
477
478    i = -1; j = asize;                 /* strictly between i and j */
479    while (j-i > 1) {
480        int k = (i+j) / 2;
481        int c = strcmp(word, tfuncs[k].name);
482        if (c > 0)
483            i = k;
484        else if (c < 0)
485            j = k;
486        else                           /* found it! */
487            return tfuncs + k;
488    }
489    return NULL;                         /* not found */
490}
491
492static long long calc_error(unsigned a[2], unsigned b[3], int shift, int rettype) {
493    unsigned r0, r1, r2;
494    int sign, carry;
495    long long result;
496
497    /*
498     * If either number is infinite, require exact equality. If
499     * either number is NaN, require that both are NaN. If either
500     * of these requirements is broken, return INT_MAX.
501     */
502    if (is_double_rettype(rettype)) {
503        if ((a[0] & 0x7FF00000) == 0x7FF00000 ||
504            (b[0] & 0x7FF00000) == 0x7FF00000) {
505            if (((a[0] & 0x800FFFFF) || a[1]) &&
506                ((b[0] & 0x800FFFFF) || b[1]) &&
507                (a[0] & 0x7FF00000) == 0x7FF00000 &&
508                (b[0] & 0x7FF00000) == 0x7FF00000)
509                return 0;              /* both NaN - OK */
510            if (!((a[0] & 0xFFFFF) || a[1]) &&
511                !((b[0] & 0xFFFFF) || b[1]) &&
512                a[0] == b[0])
513                return 0;              /* both same sign of Inf - OK */
514            return LLONG_MAX;
515        }
516    } else {
517        if ((a[0] & 0x7F800000) == 0x7F800000 ||
518            (b[0] & 0x7F800000) == 0x7F800000) {
519            if ((a[0] & 0x807FFFFF) &&
520                (b[0] & 0x807FFFFF) &&
521                (a[0] & 0x7F800000) == 0x7F800000 &&
522                (b[0] & 0x7F800000) == 0x7F800000)
523                return 0;              /* both NaN - OK */
524            if (!(a[0] & 0x7FFFFF) &&
525                !(b[0] & 0x7FFFFF) &&
526                a[0] == b[0])
527                return 0;              /* both same sign of Inf - OK */
528            return LLONG_MAX;
529        }
530    }
531
532    /*
533     * Both finite. Return INT_MAX if the signs differ.
534     */
535    if ((a[0] ^ b[0]) & 0x80000000)
536        return LLONG_MAX;
537
538    /*
539     * Now it's just straight multiple-word subtraction.
540     */
541    if (is_double_rettype(rettype)) {
542        r2 = -b[2]; carry = (r2 == 0);
543        r1 = a[1] + ~b[1] + carry; carry = (r1 < a[1] || (carry && r1 == a[1]));
544        r0 = a[0] + ~b[0] + carry;
545    } else {
546        r2 = -b[1]; carry = (r2 == 0);
547        r1 = a[0] + ~b[0] + carry; carry = (r1 < a[0] || (carry && r1 == a[0]));
548        r0 = ~0 + carry;
549    }
550
551    /*
552     * Forgive larger errors in specialised cases.
553     */
554    if (shift > 0) {
555        if (shift > 32*3)
556            return 0;                  /* all errors are forgiven! */
557        while (shift >= 32) {
558            r2 = r1;
559            r1 = r0;
560            r0 = -(r0 >> 31);
561            shift -= 32;
562        }
563
564        if (shift > 0) {
565            r2 = (r2 >> shift) | (r1 << (32-shift));
566            r1 = (r1 >> shift) | (r0 << (32-shift));
567            r0 = (r0 >> shift) | ((-(r0 >> 31)) << (32-shift));
568        }
569    }
570
571    if (r0 & 0x80000000) {
572        sign = 1;
573        r2 = ~r2; carry = (r2 == 0);
574        r1 = 0 + ~r1 + carry; carry = (carry && (r2 == 0));
575        r0 = 0 + ~r0 + carry;
576    } else {
577        sign = 0;
578    }
579
580    if (r0 >= (1LL<<(31-EXTRABITS)))
581        return LLONG_MAX;                /* many ulps out */
582
583    result = (r2 >> (32-EXTRABITS)) & (ULPUNIT-1);
584    result |= r1 << EXTRABITS;
585    result |= (long long)r0 << (32+EXTRABITS);
586    if (sign)
587        result = -result;
588    return result;
589}
590
591/* special named operands */
592
593typedef struct {
594    unsigned op1, op2;
595    char* name;
596} special_op;
597
598static special_op special_ops_double[] = {
599    {0x00000000,0x00000000,"0"},
600    {0x3FF00000,0x00000000,"1"},
601    {0x7FF00000,0x00000000,"inf"},
602    {0x7FF80000,0x00000001,"qnan"},
603    {0x7FF00000,0x00000001,"snan"},
604    {0x3ff921fb,0x54442d18,"pi2"},
605    {0x400921fb,0x54442d18,"pi"},
606    {0x3fe921fb,0x54442d18,"pi4"},
607    {0x4002d97c,0x7f3321d2,"3pi4"},
608};
609
610static special_op special_ops_float[] = {
611    {0x00000000,0,"0"},
612    {0x3f800000,0,"1"},
613    {0x7f800000,0,"inf"},
614    {0x7fc00000,0,"qnan"},
615    {0x7f800001,0,"snan"},
616    {0x3fc90fdb,0,"pi2"},
617    {0x40490fdb,0,"pi"},
618    {0x3f490fdb,0,"pi4"},
619    {0x4016cbe4,0,"3pi4"},
620};
621
622/*
623   This is what is returned by the below functions.
624   We need it to handle the sign of the number
625*/
626static special_op tmp_op = {0,0,0};
627
628special_op* find_special_op_from_op(unsigned op1, unsigned op2, int is_double) {
629    int i;
630    special_op* sop;
631    if(is_double) {
632        sop = special_ops_double;
633    } else {
634        sop = special_ops_float;
635    }
636    for(i = 0; i < sizeof(special_ops_double)/sizeof(special_op); i++) {
637        if(sop->op1 == (op1&0x7fffffff) && sop->op2 == op2) {
638            if(tmp_op.name) free(tmp_op.name);
639            tmp_op.name = malloc(strlen(sop->name)+2);
640            if(op1>>31) {
641                sprintf(tmp_op.name,"-%s",sop->name);
642            } else {
643                strcpy(tmp_op.name,sop->name);
644            }
645            return &tmp_op;
646        }
647        sop++;
648    }
649    return NULL;
650}
651
652special_op* find_special_op_from_name(const char* name, int is_double) {
653    int i, neg=0;
654    special_op* sop;
655    if(is_double) {
656        sop = special_ops_double;
657    } else {
658        sop = special_ops_float;
659    }
660    if(*name=='-') {
661        neg=1;
662        name++;
663    } else if(*name=='+') {
664        name++;
665    }
666    for(i = 0; i < sizeof(special_ops_double)/sizeof(special_op); i++) {
667        if(0 == strcmp(name,sop->name)) {
668            tmp_op.op1 = sop->op1;
669            if(neg) {
670                tmp_op.op1 |= 0x80000000;
671            }
672            tmp_op.op2 = sop->op2;
673            return &tmp_op;
674        }
675        sop++;
676    }
677    return NULL;
678}
679
680/*
681   helper function for the below
682   type=0 for single, 1 for double, 2 for no sop
683*/
684int do_op(char* q, unsigned* op, const char* name, int num, int sop_type) {
685    int i;
686    int n=num;
687    special_op* sop = NULL;
688    for(i = 0; i < num; i++) {
689        op[i] = 0;
690    }
691    if(sop_type<2) {
692        sop = find_special_op_from_name(q,sop_type);
693    }
694    if(sop != NULL) {
695        op[0] = sop->op1;
696        op[1] = sop->op2;
697    } else {
698        switch(num) {
699        case 1: n = sscanf(q, "%x", &op[0]); break;
700        case 2: n = sscanf(q, "%x.%x", &op[0], &op[1]); break;
701        case 3: n = sscanf(q, "%x.%x.%x", &op[0], &op[1], &op[2]); break;
702        default: return -1;
703        }
704    }
705    if (verbose) {
706        printf("%s=",name);
707        for (i = 0; (i < n); ++i) printf("%x.", op[i]);
708        printf(" (n=%d)\n", n);
709    }
710    return n;
711}
712
713testdetail parsetest(char *testbuf, testdetail oldtest) {
714    char *p; /* Current part of line: Option name */
715    char *q; /* Current part of line: Option value */
716    testdetail ret; /* What we return */
717    int k; /* Function enum from k_* */
718    int n; /* Used as returns for scanfs */
719    int argtype=2, rettype=2; /* for do_op */
720
721    /* clear ret */
722    memset(&ret, 0, sizeof(ret));
723
724    if (verbose) printf("Parsing line: %s\n", testbuf);
725    while (*testbuf && isspace(*testbuf)) testbuf++;
726    if (testbuf[0] == ';' || testbuf[0] == '#' || testbuf[0] == '!' ||
727        testbuf[0] == '>' || testbuf[0] == '\0') {
728        ret.comment = 1;
729        if (verbose) printf("Line is a comment\n");
730        return ret;
731    }
732    ret.comment = 0;
733
734    if (*testbuf == '+') {
735        if (oldtest.valid) {
736            ret = oldtest;             /* structure copy */
737        } else {
738            fprintf(stderr, "copy from invalid: ignored\n");
739        }
740        testbuf++;
741    }
742
743    ret.random = randomstate;
744
745    ret.in_err = 0;
746    ret.in_err_limit = e_number_of_errnos;
747
748    p = strtok(testbuf, " \t");
749    while (p != NULL) {
750        q = strchr(p, '=');
751        if (!q)
752            goto balderdash;
753        *q++ = '\0';
754        k = find(p, keywords, sizeof(keywords));
755        switch (k) {
756        case k_random:
757            randomstate = (!strcmp(q, "on"));
758            ret.comment = 1;
759            return ret;                /* otherwise ignore this line */
760        case k_func:
761            if (verbose) printf("func=%s ", q);
762            //ret.func = find(q, funcs, sizeof(funcs));
763            ret.func = find_testfunc(q);
764            if (ret.func == NULL)
765                {
766                    if (verbose) printf("(id=unknown)\n");
767                    goto balderdash;
768                }
769            if(is_single_argtype(ret.func->argtype))
770                argtype = 0;
771            else if(is_double_argtype(ret.func->argtype))
772                argtype = 1;
773            if(is_single_rettype(ret.func->rettype))
774                rettype = 0;
775            else if(is_double_rettype(ret.func->rettype))
776                rettype = 1;
777            //ret.size = sizes[ret.func];
778            if (verbose) printf("(name=%s) (size=%d)\n", ret.func->name, ret.func->argtype);
779            break;
780        case k_op1:
781        case k_op1r:
782            n = do_op(q,ret.op1r,"op1r",2,argtype);
783            if (n < 1)
784                goto balderdash;
785            break;
786        case k_op1i:
787            n = do_op(q,ret.op1i,"op1i",2,argtype);
788            if (n < 1)
789                goto balderdash;
790            break;
791        case k_op2:
792        case k_op2r:
793            n = do_op(q,ret.op2r,"op2r",2,argtype);
794            if (n < 1)
795                goto balderdash;
796            break;
797        case k_op2i:
798            n = do_op(q,ret.op2i,"op2i",2,argtype);
799            if (n < 1)
800                goto balderdash;
801            break;
802        case k_resultc:
803            puts(q);
804            if(strncmp(q,"inf",3)==0) {
805                ret.resultc = rc_infinity;
806            } else if(strcmp(q,"zero")==0) {
807                ret.resultc = rc_zero;
808            } else if(strcmp(q,"nan")==0) {
809                ret.resultc = rc_nan;
810            } else if(strcmp(q,"finite")==0) {
811                ret.resultc = rc_finite;
812            } else {
813                goto balderdash;
814            }
815            break;
816        case k_result:
817        case k_resultr:
818            n = (do_op)(q,ret.resultr,"resultr",3,rettype);
819            if (n < 1)
820                goto balderdash;
821            ret.nresult = n; /* assume real and imaginary have same no. words */
822            break;
823        case k_resulti:
824            n = do_op(q,ret.resulti,"resulti",3,rettype);
825            if (n < 1)
826                goto balderdash;
827            break;
828        case k_res2:
829            n = do_op(q,ret.res2,"res2",2,rettype);
830            if (n < 1)
831                goto balderdash;
832            break;
833        case k_status:
834            while (*q) {
835                if (*q == 'i') ret.status |= FE_INVALID;
836                if (*q == 'z') ret.status |= FE_DIVBYZERO;
837                if (*q == 'o') ret.status |= FE_OVERFLOW;
838                if (*q == 'u') ret.status |= FE_UNDERFLOW;
839                q++;
840            }
841            break;
842        case k_maybeerror:
843            n = find(q, errors, sizeof(errors));
844            if (n < 0)
845                goto balderdash;
846            if(math_errhandling&MATH_ERREXCEPT) {
847                switch(n) {
848                case e_domain: ret.maybestatus |= FE_INVALID; break;
849                case e_divbyzero: ret.maybestatus |= FE_DIVBYZERO; break;
850                case e_overflow: ret.maybestatus |= FE_OVERFLOW; break;
851                case e_underflow: ret.maybestatus |= FE_UNDERFLOW; break;
852                }
853            }
854            {
855                switch(n) {
856                case e_domain:
857                    ret.maybeerr = e_EDOM; break;
858                case e_divbyzero:
859                case e_overflow:
860                case e_underflow:
861                    ret.maybeerr = e_ERANGE; break;
862                }
863            }
864        case k_maybestatus:
865            while (*q) {
866                if (*q == 'i') ret.maybestatus |= FE_INVALID;
867                if (*q == 'z') ret.maybestatus |= FE_DIVBYZERO;
868                if (*q == 'o') ret.maybestatus |= FE_OVERFLOW;
869                if (*q == 'u') ret.maybestatus |= FE_UNDERFLOW;
870                q++;
871            }
872            break;
873        case k_error:
874            n = find(q, errors, sizeof(errors));
875            if (n < 0)
876                goto balderdash;
877            if(math_errhandling&MATH_ERREXCEPT) {
878                switch(n) {
879                case e_domain: ret.status |= FE_INVALID; break;
880                case e_divbyzero: ret.status |= FE_DIVBYZERO; break;
881                case e_overflow: ret.status |= FE_OVERFLOW; break;
882                case e_underflow: ret.status |= FE_UNDERFLOW; break;
883                }
884            }
885            if(math_errhandling&MATH_ERRNO) {
886                switch(n) {
887                case e_domain:
888                    ret.err = e_EDOM; break;
889                case e_divbyzero:
890                case e_overflow:
891                case e_underflow:
892                    ret.err = e_ERANGE; break;
893                }
894            }
895            if(!(math_errhandling&MATH_ERRNO)) {
896                switch(n) {
897                case e_domain:
898                    ret.maybeerr = e_EDOM; break;
899                case e_divbyzero:
900                case e_overflow:
901                case e_underflow:
902                    ret.maybeerr = e_ERANGE; break;
903                }
904            }
905            break;
906        case k_errno:
907            ret.err = find(q, errnos, sizeof(errnos));
908            if (ret.err < 0)
909                goto balderdash;
910            break;
911        case k_errno_in:
912            ret.in_err = find(q, errnos, sizeof(errnos));
913            if (ret.err < 0)
914                goto balderdash;
915            ret.in_err_limit = ret.in_err + 1;
916            break;
917        case k_wrongresult:
918        case k_wrongstatus:
919        case k_wrongres2:
920        case k_wrongerrno:
921            /* quietly ignore these keys */
922            break;
923        default:
924            goto balderdash;
925        }
926        p = strtok(NULL, " \t");
927    }
928    ret.valid = 1;
929    return ret;
930
931    /* come here from almost any error */
932 balderdash:
933    ret.valid = 0;
934    return ret;
935}
936
937typedef enum {
938    test_comment,                      /* deliberately not a test */
939    test_invalid,                      /* accidentally not a test */
940    test_decline,                      /* was a test, and wasn't run */
941    test_fail,                         /* was a test, and failed */
942    test_pass                          /* was a test, and passed */
943} testresult;
944
945char failtext[512];
946
947typedef union {
948    unsigned i[2];
949    double f;
950    double da[2];
951} dbl;
952
953typedef union {
954    unsigned i;
955    float f;
956    float da[2];
957} sgl;
958
959/* helper function for runtest */
960void print_error(int rettype, unsigned *result, char* text, char** failp) {
961    special_op *sop;
962    char *str;
963
964    if(result) {
965        *failp += sprintf(*failp," %s=",text);
966        sop = find_special_op_from_op(result[0],result[1],is_double_rettype(rettype));
967        if(sop) {
968            *failp += sprintf(*failp,"%s",sop->name);
969        } else {
970            if(is_double_rettype(rettype)) {
971                str="%08x.%08x";
972            } else {
973                str="%08x";
974            }
975            *failp += sprintf(*failp,str,result[0],result[1]);
976        }
977    }
978}
979
980
981void print_ulps_helper(const char *name, long long ulps, char** failp) {
982    if(ulps == LLONG_MAX) {
983        *failp += sprintf(*failp, " %s=HUGE", name);
984    } else {
985        *failp += sprintf(*failp, " %s=%.3f", name, (double)ulps / ULPUNIT);
986    }
987}
988
989/* for complex args make ulpsr or ulpsri = 0 to not print */
990void print_ulps(int rettype, long long ulpsr, long long ulpsi, char** failp) {
991    if(is_complex_rettype(rettype)) {
992        if (ulpsr) print_ulps_helper("ulpsr",ulpsr,failp);
993        if (ulpsi) print_ulps_helper("ulpsi",ulpsi,failp);
994    } else {
995        if (ulpsr) print_ulps_helper("ulps",ulpsr,failp);
996    }
997}
998
999int runtest(testdetail t) {
1000    int err, status;
1001
1002    dbl d_arg1, d_arg2, d_res, d_res2;
1003    sgl s_arg1, s_arg2, s_res, s_res2;
1004
1005    int deferred_decline = FALSE;
1006    char *failp = failtext;
1007
1008    unsigned int intres=0;
1009
1010    int res2_adjust = 0;
1011
1012    if (t.comment)
1013        return test_comment;
1014    if (!t.valid)
1015        return test_invalid;
1016
1017    /* Set IEEE status to mathlib-normal */
1018    feclearexcept(FE_ALL_EXCEPT);
1019
1020    /* Deal with operands */
1021#define DO_DOP(arg,op) arg.i[dmsd] = t.op[0]; arg.i[dlsd] = t.op[1]
1022    DO_DOP(d_arg1,op1r);
1023    DO_DOP(d_arg2,op2r);
1024    s_arg1.i = t.op1r[0]; s_arg2.i = t.op2r[0];
1025    s_res.i = 0;
1026
1027    /*
1028     * Detect NaNs, infinities and denormals on input, and set a
1029     * deferred decline flag if we're in FO mode.
1030     *
1031     * (We defer the decline rather than doing it immediately
1032     * because even in FO mode the operation is not permitted to
1033     * crash or tight-loop; so we _run_ the test, and then ignore
1034     * all the results.)
1035     */
1036    if (fo) {
1037        if (is_double_argtype(t.func->argtype) && is_dhard(t.op1r))
1038            deferred_decline = TRUE;
1039        if (t.func->argtype==at_d2 && is_dhard(t.op2r))
1040            deferred_decline = TRUE;
1041        if (is_single_argtype(t.func->argtype) && is_shard(t.op1r))
1042            deferred_decline = TRUE;
1043        if (t.func->argtype==at_s2 && is_shard(t.op2r))
1044            deferred_decline = TRUE;
1045        if (is_double_rettype(t.func->rettype) && is_dhard(t.resultr))
1046            deferred_decline = TRUE;
1047        if (t.func->rettype==rt_d2 && is_dhard(t.res2))
1048            deferred_decline = TRUE;
1049        if (is_single_argtype(t.func->rettype) && is_shard(t.resultr))
1050            deferred_decline = TRUE;
1051        if (t.func->rettype==rt_s2 && is_shard(t.res2))
1052            deferred_decline = TRUE;
1053        if (t.err == e_ERANGE)
1054            deferred_decline = TRUE;
1055    }
1056
1057    /*
1058     * Perform the operation
1059     */
1060
1061    errno = t.in_err == e_EDOM ? EDOM : t.in_err == e_ERANGE ? ERANGE : 0;
1062    if (t.err == e_0)
1063        t.err = t.in_err;
1064    if (t.maybeerr == e_0)
1065        t.maybeerr = t.in_err;
1066
1067    if(t.func->type == t_func) {
1068        switch(t.func->argtype) {
1069        case at_d: d_res.f = t.func->func.d_d_ptr(d_arg1.f); break;
1070        case at_s: s_res.f = t.func->func.s_s_ptr(s_arg1.f); break;
1071        case at_d2: d_res.f = t.func->func.d2_d_ptr(d_arg1.f, d_arg2.f); break;
1072        case at_s2: s_res.f = t.func->func.s2_s_ptr(s_arg1.f, s_arg2.f); break;
1073        case at_di: d_res.f = t.func->func.di_d_ptr(d_arg1.f, d_arg2.i[dmsd]); break;
1074        case at_si: s_res.f = t.func->func.si_s_ptr(s_arg1.f, s_arg2.i); break;
1075        case at_dip: d_res.f = t.func->func.dip_d_ptr(d_arg1.f, (int*)&intres); break;
1076        case at_sip: s_res.f = t.func->func.sip_s_ptr(s_arg1.f, (int*)&intres); break;
1077        case at_ddp: d_res.f = t.func->func.ddp_d_ptr(d_arg1.f, &d_res2.f); break;
1078        case at_ssp: s_res.f = t.func->func.ssp_s_ptr(s_arg1.f, &s_res2.f); break;
1079        default:
1080            printf("unhandled function: %s\n",t.func->name);
1081            return test_fail;
1082        }
1083    } else {
1084        /* printf("macro: name=%s, num=%i, s1.i=0x%08x s1.f=%f\n",t.func->name, t.func->macro_name, s_arg1.i, (double)s_arg1.f); */
1085        switch(t.func->macro_name) {
1086        case m_isfinite: intres = isfinite(d_arg1.f); break;
1087        case m_isinf: intres = isinf(d_arg1.f); break;
1088        case m_isnan: intres = isnan(d_arg1.f); break;
1089        case m_isnormal: intres = isnormal(d_arg1.f); break;
1090        case m_signbit: intres = signbit(d_arg1.f); break;
1091        case m_fpclassify: intres = fpclassify(d_arg1.f); break;
1092        case m_isgreater: intres = isgreater(d_arg1.f, d_arg2.f); break;
1093        case m_isgreaterequal: intres = isgreaterequal(d_arg1.f, d_arg2.f); break;
1094        case m_isless: intres = isless(d_arg1.f, d_arg2.f); break;
1095        case m_islessequal: intres = islessequal(d_arg1.f, d_arg2.f); break;
1096        case m_islessgreater: intres = islessgreater(d_arg1.f, d_arg2.f); break;
1097        case m_isunordered: intres = isunordered(d_arg1.f, d_arg2.f); break;
1098
1099        case m_isfinitef: intres = isfinite(s_arg1.f); break;
1100        case m_isinff: intres = isinf(s_arg1.f); break;
1101        case m_isnanf: intres = isnan(s_arg1.f); break;
1102        case m_isnormalf: intres = isnormal(s_arg1.f); break;
1103        case m_signbitf: intres = signbit(s_arg1.f); break;
1104        case m_fpclassifyf: intres = fpclassify(s_arg1.f); break;
1105        case m_isgreaterf: intres = isgreater(s_arg1.f, s_arg2.f); break;
1106        case m_isgreaterequalf: intres = isgreaterequal(s_arg1.f, s_arg2.f); break;
1107        case m_islessf: intres = isless(s_arg1.f, s_arg2.f); break;
1108        case m_islessequalf: intres = islessequal(s_arg1.f, s_arg2.f); break;
1109        case m_islessgreaterf: intres = islessgreater(s_arg1.f, s_arg2.f); break;
1110        case m_isunorderedf: intres = isunordered(s_arg1.f, s_arg2.f); break;
1111
1112        default:
1113            printf("unhandled macro: %s\n",t.func->name);
1114            return test_fail;
1115        }
1116    }
1117
1118    /*
1119     * Decline the test if the deferred decline flag was set above.
1120     */
1121    if (deferred_decline)
1122        return test_decline;
1123
1124    /* printf("intres=%i\n",intres); */
1125
1126    /* Clear the fail text (indicating a pass unless we change it) */
1127    failp[0] = '\0';
1128
1129    /* Check the IEEE status bits (except INX, which we disregard).
1130     * We don't bother with this for complex numbers, because the
1131     * complex functions are hard to get exactly right and we don't
1132     * have to anyway (C99 annex G is only informative). */
1133    if (!(is_complex_argtype(t.func->argtype) || is_complex_rettype(t.func->rettype))) {
1134        status = fetestexcept(FE_INVALID|FE_DIVBYZERO|FE_OVERFLOW|FE_UNDERFLOW);
1135        if ((status|t.maybestatus|~statusmask) != (t.status|t.maybestatus|~statusmask)) {
1136            if (quiet) failtext[0]='x';
1137            else {
1138                failp += sprintf(failp,
1139                                 " wrongstatus=%s%s%s%s%s",
1140                                 (status & FE_INVALID ? "i" : ""),
1141                                 (status & FE_DIVBYZERO ? "z" : ""),
1142                                 (status & FE_OVERFLOW ? "o" : ""),
1143                                 (status & FE_UNDERFLOW ? "u" : ""),
1144                                 (status ? "" : "OK"));
1145            }
1146        }
1147    }
1148
1149    /* Check the result */
1150    {
1151        unsigned resultr[2], resulti[2];
1152        unsigned tresultr[3], tresulti[3], wres;
1153
1154        switch(t.func->rettype) {
1155        case rt_d:
1156        case rt_d2:
1157            tresultr[0] = t.resultr[0];
1158            tresultr[1] = t.resultr[1];
1159            resultr[0] = d_res.i[dmsd]; resultr[1] = d_res.i[dlsd];
1160            resulti[0] = resulti[1] = 0;
1161            wres = 2;
1162            break;
1163        case rt_i:
1164            tresultr[0] = t.resultr[0];
1165            resultr[0] = intres;
1166            resulti[0] = 0;
1167            wres = 1;
1168            break;
1169        case rt_s:
1170        case rt_s2:
1171            tresultr[0] = t.resultr[0];
1172            resultr[0] = s_res.i;
1173            resulti[0] = 0;
1174            wres = 1;
1175            break;
1176        default:
1177            puts("unhandled rettype in runtest");
1178            abort ();
1179        }
1180        if(t.resultc != rc_none) {
1181            int err = 0;
1182            switch(t.resultc) {
1183            case rc_zero:
1184                if(resultr[0] != 0 || resulti[0] != 0 ||
1185                   (wres==2 && (resultr[1] != 0 || resulti[1] != 0))) {
1186                    err = 1;
1187                }
1188                break;
1189            case rc_infinity:
1190                if(wres==1) {
1191                    if(!((resultr[0]&0x7fffffff)==0x7f800000 ||
1192                         (resulti[0]&0x7fffffff)==0x7f800000)) {
1193                        err = 1;
1194                    }
1195                } else {
1196                  if(!(((resultr[0]&0x7fffffff)==0x7ff00000 && resultr[1]==0) ||
1197                       ((resulti[0]&0x7fffffff)==0x7ff00000 && resulti[1]==0))) {
1198                        err = 1;
1199                    }
1200                }
1201                break;
1202            case rc_nan:
1203                if(wres==1) {
1204                    if(!((resultr[0]&0x7fffffff)>0x7f800000 ||
1205                         (resulti[0]&0x7fffffff)>0x7f800000)) {
1206                        err = 1;
1207                    }
1208                } else {
1209                    canon_dNaN(resultr);
1210                    canon_dNaN(resulti);
1211                    if(!(((resultr[0]&0x7fffffff)>0x7ff00000 && resultr[1]==1) ||
1212                         ((resulti[0]&0x7fffffff)>0x7ff00000 && resulti[1]==1))) {
1213                        err = 1;
1214                    }
1215                }
1216                break;
1217            case rc_finite:
1218                if(wres==1) {
1219                    if(!((resultr[0]&0x7fffffff)<0x7f800000 ||
1220                         (resulti[0]&0x7fffffff)<0x7f800000)) {
1221                        err = 1;
1222                    }
1223                } else {
1224                    if(!((resultr[0]&0x7fffffff)<0x7ff00000 ||
1225                         (resulti[0]&0x7fffffff)<0x7ff00000)) {
1226                        err = 1;
1227                    }
1228                }
1229                break;
1230            default:
1231                break;
1232            }
1233            if(err) {
1234                print_error(t.func->rettype,resultr,"wrongresultr",&failp);
1235                print_error(t.func->rettype,resulti,"wrongresulti",&failp);
1236            }
1237        } else if (t.nresult > wres) {
1238            /*
1239             * The test case data has provided the result to more
1240             * than double precision. Instead of testing exact
1241             * equality, we test against our maximum error
1242             * tolerance.
1243             */
1244            int rshift, ishift;
1245            long long ulpsr, ulpsi, ulptolerance;
1246
1247            tresultr[wres] = t.resultr[wres] << (32-EXTRABITS);
1248            tresulti[wres] = t.resulti[wres] << (32-EXTRABITS);
1249            if(strict) {
1250                ulptolerance = 4096; /* one ulp */
1251            } else {
1252                ulptolerance = t.func->tolerance;
1253            }
1254            rshift = ishift = 0;
1255            if (ulptolerance & ABSLOWERBOUND) {
1256                /*
1257                 * Hack for the lgamma functions, which have an
1258                 * error behaviour that can't conveniently be
1259                 * characterised in pure ULPs. Really, we want to
1260                 * say that the error in lgamma is "at most N ULPs,
1261                 * or at most an absolute error of X, whichever is
1262                 * larger", for appropriately chosen N,X. But since
1263                 * these two functions are the only cases where it
1264                 * arises, I haven't bothered to do it in a nice way
1265                 * in the function table above.
1266                 *
1267                 * (The difficult cases arise with negative input
1268                 * values such that |gamma(x)| is very near to 1; in
1269                 * this situation implementations tend to separately
1270                 * compute lgamma(|x|) and the log of the correction
1271                 * term from the Euler reflection formula, and
1272                 * subtract - which catastrophically loses
1273                 * significance.)
1274                 *
1275                 * As far as I can tell, nobody cares about this:
1276                 * GNU libm doesn't get those cases right either,
1277                 * and OpenCL explicitly doesn't state a ULP error
1278                 * limit for lgamma. So my guess is that this is
1279                 * simply considered acceptable error behaviour for
1280                 * this particular function, and hence I feel free
1281                 * to allow for it here.
1282                 */
1283                ulptolerance &= ~ABSLOWERBOUND;
1284                if (t.op1r[0] & 0x80000000) {
1285                    if (t.func->rettype == rt_d)
1286                        rshift = 0x400 - ((tresultr[0] >> 20) & 0x7ff);
1287                    else if (t.func->rettype == rt_s)
1288                        rshift = 0x80 - ((tresultr[0] >> 23) & 0xff);
1289                    if (rshift < 0)
1290                        rshift = 0;
1291                }
1292            }
1293            if (ulptolerance & PLUSMINUSPIO2) {
1294                ulptolerance &= ~PLUSMINUSPIO2;
1295                /*
1296                 * Hack for range reduction, which can reduce
1297                 * borderline cases in the wrong direction, i.e.
1298                 * return a value just outside one end of the interval
1299                 * [-pi/4,+pi/4] when it could have returned a value
1300                 * just inside the other end by subtracting an
1301                 * adjacent multiple of pi/2.
1302                 *
1303                 * We tolerate this, up to a point, because the
1304                 * trigonometric functions making use of the output of
1305                 * rred can cope and because making the range reducer
1306                 * do the exactly right thing in every case would be
1307                 * more expensive.
1308                 */
1309                if (wres == 1) {
1310                    /* Upper bound of overshoot derived in rredf.h */
1311                    if ((resultr[0]&0x7FFFFFFF) <= 0x3f494b02 &&
1312                        (resultr[0]&0x7FFFFFFF) > 0x3f490fda &&
1313                        (resultr[0]&0x80000000) != (tresultr[0]&0x80000000)) {
1314                        unsigned long long val;
1315                        val = tresultr[0];
1316                        val = (val << 32) | tresultr[1];
1317                        /*
1318                         * Compute the alternative permitted result by
1319                         * subtracting from the sum of the extended
1320                         * single-precision bit patterns of +pi/4 and
1321                         * -pi/4. This is a horrible hack which only
1322                         * works because we can be confident that
1323                         * numbers in this range all have the same
1324                         * exponent!
1325                         */
1326                        val = 0xfe921fb54442d184ULL - val;
1327                        tresultr[0] = val >> 32;
1328                        tresultr[1] = (val >> (32-EXTRABITS)) << (32-EXTRABITS);
1329                        /*
1330                         * Also, expect a correspondingly different
1331                         * value of res2 as a result of this change.
1332                         * The adjustment depends on whether we just
1333                         * flipped the result from + to - or vice
1334                         * versa.
1335                         */
1336                        if (resultr[0] & 0x80000000) {
1337                            res2_adjust = +1;
1338                        } else {
1339                            res2_adjust = -1;
1340                        }
1341                    }
1342                }
1343            }
1344            ulpsr = calc_error(resultr, tresultr, rshift, t.func->rettype);
1345            if(is_complex_rettype(t.func->rettype)) {
1346                ulpsi = calc_error(resulti, tresulti, ishift, t.func->rettype);
1347            } else {
1348                ulpsi = 0;
1349            }
1350            unsigned *rr = (ulpsr > ulptolerance || ulpsr < -ulptolerance) ? resultr : NULL;
1351            unsigned *ri = (ulpsi > ulptolerance || ulpsi < -ulptolerance) ? resulti : NULL;
1352/*             printf("tolerance=%i, ulpsr=%i, ulpsi=%i, rr=%p, ri=%p\n",ulptolerance,ulpsr,ulpsi,rr,ri); */
1353            if (rr || ri) {
1354                if (quiet) failtext[0]='x';
1355                else {
1356                    print_error(t.func->rettype,rr,"wrongresultr",&failp);
1357                    print_error(t.func->rettype,ri,"wrongresulti",&failp);
1358                    print_ulps(t.func->rettype,rr ? ulpsr : 0, ri ? ulpsi : 0,&failp);
1359                }
1360            }
1361        } else {
1362            if(is_complex_rettype(t.func->rettype))
1363                /*
1364                 * Complex functions are not fully supported,
1365                 * this is unreachable, but prevents warnings.
1366                 */
1367                abort();
1368            /*
1369             * The test case data has provided the result in
1370             * exactly the output precision. Therefore we must
1371             * complain about _any_ violation.
1372             */
1373            switch(t.func->rettype) {
1374            case rt_dc:
1375                canon_dNaN(tresulti);
1376                canon_dNaN(resulti);
1377                if (fo) {
1378                    dnormzero(tresulti);
1379                    dnormzero(resulti);
1380                }
1381                /* deliberate fall-through */
1382            case rt_d:
1383                canon_dNaN(tresultr);
1384                canon_dNaN(resultr);
1385                if (fo) {
1386                    dnormzero(tresultr);
1387                    dnormzero(resultr);
1388                }
1389                break;
1390            case rt_sc:
1391                canon_sNaN(tresulti);
1392                canon_sNaN(resulti);
1393                if (fo) {
1394                    snormzero(tresulti);
1395                    snormzero(resulti);
1396                }
1397                /* deliberate fall-through */
1398            case rt_s:
1399                canon_sNaN(tresultr);
1400                canon_sNaN(resultr);
1401                if (fo) {
1402                    snormzero(tresultr);
1403                    snormzero(resultr);
1404                }
1405                break;
1406            default:
1407                break;
1408            }
1409            if(is_complex_rettype(t.func->rettype)) {
1410                unsigned *rr, *ri;
1411                if(resultr[0] != tresultr[0] ||
1412                   (wres > 1 && resultr[1] != tresultr[1])) {
1413                    rr = resultr;
1414                } else {
1415                    rr = NULL;
1416                }
1417                if(resulti[0] != tresulti[0] ||
1418                   (wres > 1 && resulti[1] != tresulti[1])) {
1419                    ri = resulti;
1420                } else {
1421                    ri = NULL;
1422                }
1423                if(rr || ri) {
1424                    if (quiet) failtext[0]='x';
1425                    print_error(t.func->rettype,rr,"wrongresultr",&failp);
1426                    print_error(t.func->rettype,ri,"wrongresulti",&failp);
1427                }
1428            } else if (resultr[0] != tresultr[0] ||
1429                       (wres > 1 && resultr[1] != tresultr[1])) {
1430                if (quiet) failtext[0]='x';
1431                print_error(t.func->rettype,resultr,"wrongresult",&failp);
1432            }
1433        }
1434        /*
1435         * Now test res2, for those functions (frexp, modf, rred)
1436         * which use it.
1437         */
1438        if (t.func->func.ptr == &frexp || t.func->func.ptr == &frexpf ||
1439            t.func->macro_name == m_rred || t.func->macro_name == m_rredf) {
1440            unsigned tres2 = t.res2[0];
1441            if (res2_adjust) {
1442                /* Fix for range reduction, propagated from further up */
1443                tres2 = (tres2 + res2_adjust) & 3;
1444            }
1445            if (tres2 != intres) {
1446                if (quiet) failtext[0]='x';
1447                else {
1448                    failp += sprintf(failp,
1449                                     " wrongres2=%08x", intres);
1450                }
1451            }
1452        } else if (t.func->func.ptr == &modf || t.func->func.ptr == &modff) {
1453            tresultr[0] = t.res2[0];
1454            tresultr[1] = t.res2[1];
1455            if (is_double_rettype(t.func->rettype)) {
1456                canon_dNaN(tresultr);
1457                resultr[0] = d_res2.i[dmsd];
1458                resultr[1] = d_res2.i[dlsd];
1459                canon_dNaN(resultr);
1460                if (fo) {
1461                    dnormzero(tresultr);
1462                    dnormzero(resultr);
1463                }
1464            } else {
1465                canon_sNaN(tresultr);
1466                resultr[0] = s_res2.i;
1467                resultr[1] = s_res2.i;
1468                canon_sNaN(resultr);
1469                if (fo) {
1470                    snormzero(tresultr);
1471                    snormzero(resultr);
1472                }
1473            }
1474            if (resultr[0] != tresultr[0] ||
1475                (wres > 1 && resultr[1] != tresultr[1])) {
1476                if (quiet) failtext[0]='x';
1477                else {
1478                    if (is_double_rettype(t.func->rettype))
1479                        failp += sprintf(failp, " wrongres2=%08x.%08x",
1480                                         resultr[0], resultr[1]);
1481                    else
1482                        failp += sprintf(failp, " wrongres2=%08x",
1483                                         resultr[0]);
1484                }
1485            }
1486        }
1487    }
1488
1489    /* Check errno */
1490    err = (errno == EDOM ? e_EDOM : errno == ERANGE ? e_ERANGE : e_0);
1491    if (err != t.err && err != t.maybeerr) {
1492        if (quiet) failtext[0]='x';
1493        else {
1494            failp += sprintf(failp, " wrongerrno=%s expecterrno=%s ", errnos[err], errnos[t.err]);
1495        }
1496    }
1497
1498    return *failtext ? test_fail : test_pass;
1499}
1500
1501int passed, failed, declined;
1502
1503void runtests(char *name, FILE *fp) {
1504    char testbuf[512], linebuf[512];
1505    int lineno = 1;
1506    testdetail test;
1507
1508    test.valid = 0;
1509
1510    if (verbose) printf("runtests: %s\n", name);
1511    while (fgets(testbuf, sizeof(testbuf), fp)) {
1512        int res, print_errno;
1513        testbuf[strcspn(testbuf, "\r\n")] = '\0';
1514        strcpy(linebuf, testbuf);
1515        test = parsetest(testbuf, test);
1516        print_errno = 0;
1517        while (test.in_err < test.in_err_limit) {
1518            res = runtest(test);
1519            if (res == test_pass) {
1520                if (verbose)
1521                    printf("%s:%d: pass\n", name, lineno);
1522                ++passed;
1523            } else if (res == test_decline) {
1524                if (verbose)
1525                    printf("%s:%d: declined\n", name, lineno);
1526                ++declined;
1527            } else if (res == test_fail) {
1528                if (!quiet)
1529                    printf("%s:%d: FAIL%s: %s%s%s%s\n", name, lineno,
1530                           test.random ? " (random)" : "",
1531                           linebuf,
1532                           print_errno ? " errno_in=" : "",
1533                           print_errno ? errnos[test.in_err] : "",
1534                           failtext);
1535                ++failed;
1536            } else if (res == test_invalid) {
1537                printf("%s:%d: malformed: %s\n", name, lineno, linebuf);
1538                ++failed;
1539            }
1540            test.in_err++;
1541            print_errno = 1;
1542        }
1543        lineno++;
1544    }
1545}
1546
1547int main(int ac, char **av) {
1548    char **files;
1549    int i, nfiles = 0;
1550    dbl d;
1551
1552#ifdef MICROLIB
1553    /*
1554     * Invent argc and argv ourselves.
1555     */
1556    char *argv[256];
1557    char args[256];
1558    {
1559        int sargs[2];
1560        char *p;
1561
1562        ac = 0;
1563
1564        sargs[0]=(int)args;
1565        sargs[1]=(int)sizeof(args);
1566        if (!__semihost(0x15, sargs)) {
1567            args[sizeof(args)-1] = '\0';   /* just in case */
1568            p = args;
1569            while (1) {
1570                while (*p == ' ' || *p == '\t') p++;
1571                if (!*p) break;
1572                argv[ac++] = p;
1573                while (*p && *p != ' ' && *p != '\t') p++;
1574                if (*p) *p++ = '\0';
1575            }
1576        }
1577
1578        av = argv;
1579    }
1580#endif
1581
1582    /* Sort tfuncs */
1583    qsort(tfuncs, sizeof(tfuncs)/sizeof(test_func), sizeof(test_func), &compare_tfuncs);
1584
1585    /*
1586     * Autodetect the `double' endianness.
1587     */
1588    dmsd = 0;
1589    d.f = 1.0;                       /* 0x3ff00000 / 0x00000000 */
1590    if (d.i[dmsd] == 0) {
1591        dmsd = 1;
1592    }
1593    /*
1594     * Now dmsd denotes what the compiler thinks we're at. Let's
1595     * check that it agrees with what the runtime thinks.
1596     */
1597    d.i[0] = d.i[1] = 0x11111111;/* a random +ve number */
1598    d.f /= d.f;                    /* must now be one */
1599    if (d.i[dmsd] == 0) {
1600        fprintf(stderr, "YIKES! Compiler and runtime disagree on endianness"
1601                " of `double'. Bailing out\n");
1602        return 1;
1603    }
1604    dlsd = !dmsd;
1605
1606    /* default is terse */
1607    verbose = 0;
1608    fo = 0;
1609    strict = 0;
1610
1611    files = (char **)malloc((ac+1) * sizeof(char *));
1612    if (!files) {
1613        fprintf(stderr, "initial malloc failed!\n");
1614        return 1;
1615    }
1616#ifdef NOCMDLINE
1617    files[nfiles++] = "testfile";
1618#endif
1619
1620    while (--ac) {
1621        char *p = *++av;
1622        if (*p == '-') {
1623            static char *options[] = {
1624                "-fo",
1625#if 0
1626                "-noinexact",
1627                "-noround",
1628#endif
1629                "-nostatus",
1630                "-quiet",
1631                "-strict",
1632                "-v",
1633                "-verbose",
1634            };
1635            enum {
1636                op_fo,
1637#if 0
1638                op_noinexact,
1639                op_noround,
1640#endif
1641                op_nostatus,
1642                op_quiet,
1643                op_strict,
1644                op_v,
1645                op_verbose,
1646            };
1647            switch (find(p, options, sizeof(options))) {
1648            case op_quiet:
1649                quiet = 1;
1650                break;
1651#if 0
1652            case op_noinexact:
1653                statusmask &= 0x0F;    /* remove bit 4 */
1654                break;
1655            case op_noround:
1656                doround = 0;
1657                break;
1658#endif
1659            case op_nostatus:        /* no status word => noinx,noround */
1660                statusmask = 0;
1661                doround = 0;
1662                break;
1663            case op_v:
1664            case op_verbose:
1665                verbose = 1;
1666                break;
1667            case op_fo:
1668                fo = 1;
1669                break;
1670            case op_strict: /* tolerance is 1 ulp */
1671                strict = 1;
1672                break;
1673            default:
1674                fprintf(stderr, "unrecognised option: %s\n", p);
1675                break;
1676            }
1677        } else {
1678            files[nfiles++] = p;
1679        }
1680    }
1681
1682    passed = failed = declined = 0;
1683
1684    if (nfiles) {
1685        for (i = 0; i < nfiles; i++) {
1686            FILE *fp = fopen(files[i], "r");
1687            if (!fp) {
1688                fprintf(stderr, "Couldn't open %s\n", files[i]);
1689            } else
1690                runtests(files[i], fp);
1691        }
1692    } else
1693        runtests("(stdin)", stdin);
1694
1695    printf("Completed. Passed %d, failed %d (total %d",
1696           passed, failed, passed+failed);
1697    if (declined)
1698        printf(" plus %d declined", declined);
1699    printf(")\n");
1700    if (failed || passed == 0)
1701        return 1;
1702    printf("** TEST PASSED OK **\n");
1703    return 0;
1704}
1705
1706void undef_func() {
1707    failed++;
1708    puts("ERROR: undefined function called");
1709}
1710