Release calc version 2.11.1t1

This commit is contained in:
Landon Curt Noll
1999-12-15 01:35:49 -08:00
parent f3913609ea
commit 6f5e8bf1b6
519 changed files with 17771 additions and 4208 deletions

331
cal/test2700.cal Normal file
View File

@@ -0,0 +1,331 @@
/*
* test2700 - 2700 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.
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
*
* @(#) $Revision: 29.1 $
* @(#) $Id: test2700.cal,v 29.1 1999/12/14 09:15:33 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test2700.cal,v $
*
* Under source code control: 1995/11/01 22:52:25
* File existed as early as: 1995
*
* Share and enjoy! :-) http://reality.sgi.com/chongo/tech/comp/calc/
*/
/*
* The following resource file gives a severe test of sqrt(x,y,z) for
* all 128 values of z, randomly produced real and complex x, and randomly
* produced nonzero values for y. After loading it, testcsqrt(n) will
* test n combinations of x and y; testcsqrt(str,n,2) will print 1 2 3 ...
* indicating work in process; testcsqrt(str,n,3) will give information about
* errors detected and will print values of x and y used.
* I've also defined a function iscomsq(x) which does for complex as well
* as real x what issq(x) currently does for real x.
*/
global defaultverbose = 1;
global err;
define mknonnegreal() {
switch(rand(8)) {
case 0: return rand(20);
case 1: return rand(20,1000);
case 2: return rand(1,10000)/rand(1,100);
case 3: return scale(mkposreal(), rand(1,100));
case 4: return scale(mkposreal(), -rand(1,100));
case 5: return rand(1, 1000) + scale(mkfrac(),-rand(1,100));
case 6: return mkposreal()^2;
case 7: return mkposreal() * (1+scale(mkfrac(),-rand(1,100)));
}
}
define mkposreal() {
local x;
x = mknonnegreal();
while (x == 0)
x = mknonnegreal();
return x;
}
define mkreal_2700() = rand(2) ? mknonnegreal() : -mknonnegreal();
define mknonzeroreal() = rand(2) ? mkposreal() : -mkposreal();
/* Number > 0 and < 1, almost uniformly distributed */
define mkposfrac() {
local x,y;
x = rand(1,1000);
do
y = rand(1,1000);
while (y == x);
if (x > y)
swap(x,y);
return x/y;
}
/* Nonzero > -1 and < 1 */
define mkfrac() = rand(2) ? mkposfrac() : -mkposfrac();
define mksquarereal() = mknonnegreal()^2;
/*
* XXX - Should be able to do better than the following. For nonsquare
* positive integer less than 1e6, could use
* x = rand(1, 1000);
* return rand(x^2 + 1, (x + 1)^2);
* Maybe could do
* do
* x = mkreal_2700();
* while
* (issq(x));
* This would of course not be satisfactory for testing issq().
*/
define mknonsquarereal() = 22 * mkposreal()^2/7;
define mkcomplex_2700() = mkreal_2700() + 1i * mkreal_2700();
define testcsqrt(str, n, verbose)
{
local x, y, z, m, i, p, v;
if (isnull(verbose))
verbose = defaultverbose;
if (verbose > 0) {
print str:":",:;
}
m = 0;
for (i = 1; i <= n; i++) {
if (verbose > 1) print i,:;
x = rand(3) ? mkreal_2700(): mkcomplex_2700();
y = scale(mknonzeroreal(), -100);
if (verbose > 2)
printf("%d: x = %d, y = %d\n", i, x, y);
for (z = 0; z < 128; z++) {
v = sqrt(x,y,z);
p = checksqrt(x,y,z,v);
if (p) {
if (verbose > 0)
printf(
"*** Type %d failure for x = %r, y = %r, z = %d\n",
p, x, y, z);
m++;
}
}
}
if (verbose > 0) {
if (m) {
printf("*** %d error(s)\n", m);
} else {
printf("no errors\n");
}
}
return m;
}
define checksqrt(x,y,z,v) /* Returns >0 if an error is detected */
{
local A, B, X, Y, t1, t2, eps, u, n, f, s;
A = re(x);
B = im(x);
X = re(v);
Y = im(v);
/* checking signs of X and Y */
if (B == 0 && A <= 0) /* t1 = sgn(re(tvsqrt)) */
t1 = 0;
else
t1 = (z & 64) ? -1 : 1;
t2 = B ? sgn(B) : (A < 0); /* t2 = sgn(im(tvsqrt)) */
if (z & 64)
t2 = -t2;
if (t1 == 0 && X != 0)
return 1;
if (t2 == 0 && Y != 0) {
printf("x = %d, Y = %d, t2 = %d\n", x, Y, t2);
return 2;
}
if (X && sgn(X) != t1)
return 3;
if (Y && sgn(Y) != t2)
return 4;
if (z & 32 && iscomsq(x))
return 5 * (x != v^2);
eps = (z & 16) ? abs(y)/2 : abs(y);
u = sgn(y);
/* Checking X */
n = X/y;
if (!isint(n))
return 6;
if (t1) {
f = checkavrem(A, B, abs(X), eps);
if (z & 16 && f < 0)
return 7;
if (!(z & 16) && f <= 0)
return 8;
if (!(z & 16) || f == 0) {
s = X ? t1 * sgn(A - X^2 + B^2/4/X^2) : t1;
if (s && !checkrounding(s,n,t1,u,z))
return 9;
}
}
/* Checking Y */
n = Y/y;
if (!isint(n))
return 10;
if (t2) {
f = checkavrem(-A, B, abs(Y), eps);
if (z & 16 && f < 0)
return 11;
if (!(z & 16) && f <= 0)
return 12;
if (!(z & 16) || f == 0) {
s = Y ? t2 * sgn(-A - Y^2 + B^2/4/Y^2) : t2;
if (s && !checkrounding(s,n,t2,u,z))
return 13;
}
}
return 0;
}
/*
* Check that the calculated absolute value X of the real part of
* sqrt(A + Bi) is between (true value - eps) and (true value + eps).
* Returns -1 if it is outside, 0 if on boundary, 1 if between.
*/
define checkavrem(A, B, X, eps)
{
local f;
f = sgn(A - (X + eps)^2 + B^2/4/(X + eps)^2);
if (f > 0)
return -1; /* X < tv - eps */
if (f == 0)
return 0; /* X = tv - eps */
if (X > eps) {
f = sgn(A - (X - eps)^2 + B^2/4/(X - eps)^2);
if (f < 0)
return -1; /* X > tv + eps */
if (f == 0)
return 0; /* X = tv + eps */
}
return 1; /* tv - eps < X < tv + eps */
}
define checkrounding(s,n,t,u,z)
{
local w;
switch (z & 15) {
case 0: w = (s == u); break;
case 1: w = (s == -u); break;
case 2: w = (s == t); break;
case 3: w = (s == -t); break;
case 4: w = (s > 0); break;
case 5: w = (s < 0); break;
case 6: w = (s == u/t); break;
case 7: w = (s == -u/t); break;
case 8: w = iseven(n); break;
case 9: w = isodd(n); break;
case 10: w = (u/t > 0) ? iseven(n) : isodd(n); break;
case 11: w = (u/t > 0) ? isodd(n) : iseven(n); break;
case 12: w = (u > 0) ? iseven(n) : isodd(n); break;
case 13: w = (u > 0) ? isodd(n) : iseven(n); break;
case 14: w = (t > 0) ? iseven(n) : isodd(n); break;
case 15: w = (t > 0) ? isodd(n) : iseven(n); break;
}
return w;
}
define iscomsq(x)
{
local c;
if (isreal(x))
return issq(abs(x));
c = norm(x);
if (!issq(c))
return 0;
return issq((re(x) + sqrt(c,1,32))/2);
}
/*
* test2700 - perform all of the above tests a bunch of times
*/
define test2700(verbose, tnum)
{
local n; /* test parameter */
local ep; /* test parameter */
local i;
/* set test parameters */
n = 32; /* internal test loop count */
if (isnull(verbose)) {
verbose = defaultverbose;
}
if (isnull(tnum)) {
tnum = 1; /* initial test number */
}
/*
* test a lot of stuff
*/
srand(2700e2700);
for (i=0; i < n; ++i) {
err += testcsqrt(strcat(str(tnum++),": complex sqrt",str(i)),
1, verbose);
}
if (verbose > 1) {
if (err) {
print "***", err, "error(s) found in testall";
} else {
print "no errors in testall";
}
}
return tnum;
}