/*
 * test8500.divmod - test // and % with various rounding mode for test 85dd
 *
 * Copyright (C) 1999,2021,2023  Ernest Bowen and Landon Curt Noll
 *
 * Primary author:  Ernest Bowen
 *
 * Calc is open software; you can redistribute it and/or modify it under
 * the terms of the version 2.1 of the GNU Lesser General Public License
 * as published by the Free Software Foundation.
 *
 * Calc is distributed in the hope that it will be useful, but WITHOUT
 * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
 * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General
 * Public License for more details.
 *
 * A copy of version 2.1 of the GNU Lesser General Public License is
 * distributed with calc under the filename COPYING-LGPL.  You should have
 * received a copy with calc; if not, write to Free Software Foundation, Inc.
 * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 *
 * Under source code control:   1999/11/12 20:59:59
 * File existed as early as:    1999
 *
 * Share and enjoy!  :-)        http://www.isthe.com/chongo/tech/comp/calc/
 */

/*
 * Tests of // and % operators
 */


global err_8500;        /* divmod_8500 error count */
global L_8500;          /* list of problem values */
global ver_8500;        /* test verbosity - see setting comment near bottom */
global old_seed_8500;   /* old srand() seed */

/*
 * save the config state so that we can change it and restore later
 */
global cfg_8500 = config("all");


/*
 * onetest_8500 - perform one division / remainder test
 *
 * Returns:
 *      0 = test was successful
 *      >0 = test error indicator
 */
define onetest_8500(a,b,rnd) {
        local q, r, s, S;

        /*
         * set a random rounding mode
         */
        config("quo", rnd), config("mod", rnd);

        /*
         * perform the division and mod
         */
        q = a // b;
        r = a % b;

        /*
         * verify the fundamental math
         */
        if (a != q * b + r)
                return 1;

        /*
         * determine if the rounding worked
         */
        if (b) {
                if (rnd & 16)
                        s = sgn(abs(r) - abs(b)/2);
                else
                        s = sgn(abs(r) - abs(b));

                if (s < 0 || r == 0)
                        return 0;

                if (s > 0)
                        return 2;

                if (((rnd & 16) && s == 0) || !(rnd & 16)) {

                        S = sgn(r) * sgn(b);   /* This is sgn(a/b) - a//b */
                        switch (rnd & 15) {
                                case 0: return (S < 0) ? 3 : 0;
                                case 1: return (S > 0) ? 4 : 0;
                                case 2: return (S != sgn(a)*sgn(b)) ? 5 : 0;
                                case 3: return (S != -sgn(a)*sgn(b)) ? 6 : 0;
                                        break;
                                case 4: return (S != sgn(b)) ? 7 : 0;
                                case 5: return (S != -sgn(b)) ? 8 : 0;
                                case 6: return (S != sgn(a)) ? 9 : 0;
                                case 7: return (S != -sgn(a)) ? 10 : 0;
                                case 8: return (isodd(q)) ? 11 : 0;
                                case 9: return (iseven(q)) ? 12 : 0;
                                case 10: return (iseven(q) != (a/b > 0)) ? 13:0;
                                case 11: return (isodd(q) != (a/b > 0)) ? 14:0;
                                case 12: return (iseven(q) != (b > 0)) ? 15 : 0;
                                case 13: return (isodd(q) != (b > 0)) ? 16 : 0;
                                case 14: return (iseven(q) != (a > 0)) ? 17 : 0;
                                case 15: return (isodd(q) != (a > 0)) ? 18 : 0;
                        }
                }
        }

        /*
         * all is well
         */
        return 0;
}


/*
 * divmod_8500 - perform a bunch of pseudo-random // and % test
 *
 * divmod_8500(N, M1, M2) will perform N tests with randomly chosen integers
 * a, b with abs(a) < M1, abs(b) < M2, which with 50% probability are
 * converted to a = (2 * a + 1) * b,  b = 2 * b (to give case where
 * a / b is an integer + 1/2).
 *
 * N defaults to 10, M1 to 2^128, M2 to 2^64
 *
 * The testnum, if > 0, is used while printing a failure or success.
 *
 * The rounding parameter is randomly chosen.
 *
 * After a run of divmod_8500 the a, b, rnd values which gave failure are
 * stored in the list L_8500.  L_8500[0], L_8500[1], L_8500[2] are a, b,
 * rnd for the first* test, etc.
 */
define divmod_8500(N = 10, M1 = 2^128, M2 = 2^64, testnum = 0)
{
        local a, b, i, v, rnd;
        local errmsg;           /* error message to display */

        /*
         * firewall
         */
        if (!isint(M1) || M1 < 2)
                quit "Bad second arg for dtest";

        if (!isint(M2) || M2 < 2)
                quit "Bad third arg for dtest";

        /*
         * test setup
         */
        err_8500 = 0;
        L_8500 = list();

        /*
         * perform the random results
         */
        for (i = 0; i < N; i++) {

                /*
                 * randomly select two values in the range controlled by M1,M2
                 */
                a = rand(-M1+1, M1);
                b = rand(-M2+1, M2);
                if (rand(2)) {
                        a = (2 * a + 1) * b;
                        b *= 2;
                }

                /*
                 * select one of the 32 rounding modes at random
                 */
                rnd = rand(32);

                /*
                 * ver_8500 pre-test reporting
                 */
                if (ver_8500 > 1)
                        printf("Test %d: a = %d, b = %d, rnd = %d\n",
                                         i, a, b, rnd);

                /*
                 * perform the actual test
                 */
                v = onetest_8500(a, b, rnd);

                /*
                 * individual test analysis
                 */
                if (v != 0) {
                        err_8500++;
                        if (ver_8500 != 0) {
                                if (testnum > 0) {
                                        errmsg = strprintf(
                                                "Failure %d on test %d", v, i);
                                        prob(errmsg);
                                } else {
                                        printf("Failure %d on test %d", v, i);
                                }
                        }
                        append(L_8500, a, b, rnd);
                }
        }

        /*
         * report in the results
         */
        if (err_8500) {
                if (testnum > 0) {
                        errmsg = strprintf(
                            "%d: divmod_8500(%d,,,%d): %d failures",
                            testnum, N, testnum, err_8500);
                        prob(errmsg);
                } else {
                        printf("%s failure%s", err_8500,
                               (err_8500 > 1) ? "s" : "");
                }
        } else {
                if (testnum > 0) {
                        errmsg = strprintf("%d: divmod_8500(%d,,,%d)",
                            testnum, N, testnum);
                        vrfy(err_8500 == 0, errmsg);
                } else {
                        print "No failure";
                }
        }
}

/*
 * ver_8500 != 0 displays failures; ver_8500 > 1 displays all numbers tested
 */
ver_8500 = 0;
print '8501: ver_8500 = 0';
old_seed_8500 = srand(31^61);
print '8502: old_seed_8500 = srand(31^61)';

/*
 * do the tests
 */
divmod_8500(250, 2^128, 2^1, 8503);
divmod_8500(250, 2^128, 2^64, 8504);
divmod_8500(250, 2^256, 2^64, 8505);
divmod_8500(250, 2^1024, 2^64, 8506);
divmod_8500(250, 2^1024, 2^128, 8507);
divmod_8500(250, 2^16384, 2^1024, 8508);
divmod_8500(1000, 2^128, 2^64, 8509);

/*
 * restore state
 */
config("all", cfg_8500),;
print '8510: config("all", cfg_8500),';
srand(old_seed_8500),;
print '8511: srand(old_seed_8500),';

/*
 * finished with 8500 tests
 */
print '8512: Ending test_divmod';
