1/*
2 * test8500 - 8500 series of the regress.cal test suite
3 *
4 * Copyright (C) 1999,2021  Ernest Bowen and Landon Curt Noll
5 *
6 * Primary author:  Ernest Bowen
7 *
8 * Calc is open software; you can redistribute it and/or modify it under
9 * the terms of the version 2.1 of the GNU Lesser General Public License
10 * as published by the Free Software Foundation.
11 *
12 * Calc is distributed in the hope that it will be useful, but WITHOUT
13 * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
14 * or FITNESS FOR A PARTICULAR PURPOSE.	 See the GNU Lesser General
15 * Public License for more details.
16 *
17 * A copy of version 2.1 of the GNU Lesser General Public License is
18 * distributed with calc under the filename COPYING-LGPL.  You should have
19 * received a copy with calc; if not, write to Free Software Foundation, Inc.
20 * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
21 *
22 * Under source code control:	1999/11/12 20:59:59
23 * File existed as early as:	1999
24 *
25 * Share and enjoy!  :-)	http://www.isthe.com/chongo/tech/comp/calc/
26 */
27
28/*
29 * Tests of // and % operators
30 */
31
32
33global err_8500;	/* divmod_8500 error count */
34global L_8500;		/* list of problem values */
35global ver_8500;	/* test verbosity - see setting comment near bottom */
36global old_seed_8500;	/* old srand() seed */
37
38/*
39 * save the config state so that we can change it and restore later
40 */
41global cfg_8500 = config("all");
42
43
44/*
45 * onetest_8500 - perform one division / remainder test
46 *
47 * Returns:
48 *	0 = test was successful
49 *	>0 = test error indicator
50 */
51define onetest_8500(a,b,rnd) {
52	local q, r, s, S;
53
54	/*
55	 * set a random rounding mode
56	 */
57	config("quo", rnd), config("mod", rnd);
58
59	/*
60	 * perform the division and mod
61	 */
62	q = a // b;
63	r = a % b;
64
65	/*
66	 * verify the fundamental math
67	 */
68	if (a != q * b + r)
69		return 1;
70
71	/*
72	 * determine if the rounding worked
73	 */
74	if (b) {
75		if (rnd & 16)
76			s = sgn(abs(r) - abs(b)/2);
77		else
78			s = sgn(abs(r) - abs(b));
79
80		if (s < 0 || r == 0)
81			return 0;
82
83		if (s > 0)
84			return 2;
85
86		if (((rnd & 16) && s == 0) || !(rnd & 16)) {
87
88			S = sgn(r) * sgn(b);   /* This is sgn(a/b) - a//b */
89			switch (rnd & 15) {
90				case 0: return (S < 0) ? 3 : 0;
91				case 1: return (S > 0) ? 4 : 0;
92				case 2: return (S != sgn(a)*sgn(b)) ? 5 : 0;
93				case 3: return (S != -sgn(a)*sgn(b)) ? 6 : 0;
94					break;
95				case 4: return (S != sgn(b)) ? 7 : 0;
96				case 5: return (S != -sgn(b)) ? 8 : 0;
97				case 6: return (S != sgn(a)) ? 9 : 0;
98				case 7: return (S != -sgn(a)) ? 10 : 0;
99				case 8: return (isodd(q)) ? 11 : 0;
100				case 9: return (iseven(q)) ? 12 : 0;
101				case 10: return (iseven(q) != (a/b > 0)) ? 13:0;
102				case 11: return (isodd(q) != (a/b > 0)) ? 14:0;
103				case 12: return (iseven(q) != (b > 0)) ? 15 : 0;
104				case 13: return (isodd(q) != (b > 0)) ? 16 : 0;
105				case 14: return (iseven(q) != (a > 0)) ? 17 : 0;
106				case 15: return (isodd(q) != (a > 0)) ? 18 : 0;
107			}
108		}
109	}
110
111	/*
112	 * all is well
113	 */
114	return 0;
115}
116
117
118/*
119 * divmod_8500 - perform a bunch of pseudo-random // and % test
120 *
121 * divmod_8500(N, M1, M2) will perform N tests with randomly chosen integers
122 * a, b with abs(a) < M1, abs(b) < M2, which with 50% probability are
123 * converted to a = (2 * a + 1) * b,  b = 2 * b (to give case where
124 * a / b is an integer + 1/2).
125 *
126 * N defaults to 10, M1 to 2^128, M2 to 2^64
127 *
128 * The testnum, if > 0, is used while printing a failure or success.
129 *
130 * The rounding parameter is randomly chosen.
131 *
132 * After a run of divmod_8500 the a, b, rnd values which gave failure are
133 * stored in the list L_8500.  L_8500[0], L_8500[1], L_8500[2] are a, b,
134 * rnd for the first* test, etc.
135 */
136define divmod_8500(N = 10, M1 = 2^128, M2 = 2^64, testnum = 0)
137{
138	local a, b, i, v, rnd;
139	local errmsg;		/* error message to display */
140
141	/*
142	 * firewall
143	 */
144	if (!isint(M1) || M1 < 2)
145		quit "Bad second arg for dtest";
146
147	if (!isint(M2) || M2 < 2)
148		quit "Bad third arg for dtest";
149
150	/*
151	 * test setup
152	 */
153	err_8500 = 0;
154	L_8500 = list();
155
156	/*
157	 * perform the random results
158	 */
159	for (i = 0; i < N; i++) {
160
161		/*
162		 * randomly select two values in the range controlled by M1,M2
163		 */
164		a = rand(-M1+1, M1);
165		b = rand(-M2+1, M2);
166		if (rand(2)) {
167			a = (2 * a + 1) * b;
168			b *= 2;
169		}
170
171		/*
172		 * select one of the 32 rounding modes at random
173		 */
174		rnd = rand(32);
175
176		/*
177		 * ver_8500 pre-test reporting
178		 */
179		if (ver_8500 > 1)
180			printf("Test %d: a = %d, b = %d, rnd = %d\n",
181					 i, a, b, rnd);
182
183		/*
184		 * perform the actual test
185		 */
186		v = onetest_8500(a, b, rnd);
187
188		/*
189		 * individual test analysis
190		 */
191		if (v != 0) {
192			err_8500++;
193			if (ver_8500 != 0) {
194				if (testnum > 0) {
195					errmsg = strprintf(
196						"Failure %d on test %d", v, i);
197					prob(errmsg);
198				} else {
199					printf("Failure %d on test %d", v, i);
200				}
201			}
202			append(L_8500, a, b, rnd);
203		}
204	}
205
206	/*
207	 * report in the results
208	 */
209	if (err_8500) {
210		if (testnum > 0) {
211			errmsg = strprintf(
212			    "%d: divmod_8500(%d,,,%d): %d failures",
213			    testnum, N, testnum, err_8500);
214			prob(errmsg);
215		} else {
216			printf("%s failure%s", err_8500,
217			       (err_8500 > 1) ? "s" : "");
218		}
219	} else {
220		if (testnum > 0) {
221			errmsg = strprintf("%d: divmod_8500(%d,,,%d)",
222			    testnum, N, testnum);
223			vrfy(err_8500 == 0, errmsg);
224		} else {
225			print "No failure";
226		}
227	}
228}
229
230/*
231 * ver_8500 != 0 displays failures; ver_8500 > 1 displays all numbers tested
232 */
233ver_8500 = 0;
234print '8501: ver_8500 = 0';
235old_seed_8500 = srand(31^61);
236print '8502: old_seed_8500 = srand(31^61)';
237
238/*
239 * do the tests
240 */
241divmod_8500(250, 2^128, 2^1, 8503);
242divmod_8500(250, 2^128, 2^64, 8504);
243divmod_8500(250, 2^256, 2^64, 8505);
244divmod_8500(250, 2^1024, 2^64, 8506);
245divmod_8500(250, 2^1024, 2^128, 8507);
246divmod_8500(250, 2^16384, 2^1024, 8508);
247divmod_8500(1000, 2^128, 2^64, 8509);
248
249/*
250 * restore state
251 */
252config("all", cfg_8500),;
253print '8510: config("all", cfg_8500),';
254srand(old_seed_8500),;
255print '8511: srand(old_seed_8500),';
256
257/*
258 * finished with 8500 tests
259 */
260print '8512: Ending test_divmod';
261