calc/cal/test8500.cal

/*
 * test8500 - 8500 series of the regress.cal test suite
 *
 * Copyright (C) 1999  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;
		}

		/*
		 * seelect 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';