/*************** -*- Mode: MACSYMA; Package: MAXIMA -*-  ******************/
/***************************************************************************
***                                                                    *****
***     Copyright (c) 1984 by William Schelter,University of Texas     *****
***     All rights reserved                                            *****
***************************************************************************/

/* PRODUCED USING TOPS 20 AS GUIDE AND CHECKED ON 3600 
This and the rtest*.mac files can be run using the command
Batch("cl-maxima-source:maxima;rtest1.mac",test);   and a
log file will be written recording the items which the testing
function does not find the same as those answers listed in this file.
The test is based on manual.demo, with the answers obtained from
tops 20 macsyma, and checked on the 3600 with cl-maxima.  
Although we have tried to put sufficient kills in, to eliminate
errors caused by previous definitions, you may get some additional
errors if you rerun the tests, or run some out of order. */

(?fmakunbound(f),kill(functions,values,arrays));
done;
f(x):=x^2+y;
f(x):=x^2+y$
f(2);
y+4$
ev(f(2),y:7);
11$
f(x):=sin(x)^2+1;
f(x):=sin(x)^2+1$
f(x+1);
sin(x+1)^2+1$
g(y,z):=f(z)+3*y;
g(y,z):=f(z)+3*y$
ev(g(2*y+z,-0.5),y:7);
3*(z+14)+1.22984884706593$
h(n):=sum(i*x^i,i,0,n);
h(n):=sum(i*x^i,i,0,n)$
functions;
[f(x),g(y,z),h(n)]$
t[n](x):=ratexpand(2*x*t[n-1](x)-t[n-2](x));
t[n](x):=ratexpand(2*x*t[n-1](x)-t[n-2](x))$
t[0](x):=1;
t[0](x):=1$
t[1](x):=x;
t[1](x):=x$
t[4](y);
8*y^4-8*y^2+1$
g[n](x):=sum(ev(x),i,n,n+2);
g[n](x):=sum(ev(x),i,n,n+2)$
h(n,x):=sum(ev(x),i,n,n+2);
h(n,x):=sum(ev(x),i,n,n+2)$
g[2](i^2);
3*i^2$
h(2,i^2);
29$
p[n](x):=ratsimp(1/(2^n*n!)*diff((x^2-1)^n,x,n));
p[n](x):=ratsimp(1/(2^n*n!)*diff((x^2-1)^n,x,n))$
q(n,x):=ratsimp(1/(2^n*n!)*diff((x^2-1)^n,x,n));
q(n,x):=ratsimp(1/(2^n*n!)*diff((x^2-1)^n,x,n))$
p[2];
lambda([x],(3*x^2-1)/2)$
p[2](y+1);
(3*(y+1)^2-1)/2$
q(2,y);
(3*y^2-1)/2$
p[2](5);
37$
f[i,j](x,y):=x^i+y^j;
f[i,j](x,y):=x^i+y^j$
g(fun,a,b):=print(fun," applied to ",a," and ",b," is ",fun(a,b));
g(fun,a,b):=print(fun," applied to ",a," and ",b," is ",fun(a,b))$
g(f[2,1],sin(%pi),2*c);
2*c$

/* tests for ibase and obase; a recent accretion. dunno where else to put this stuff. */

[integerp (2.), floatnump (2.)];
[true, false];

ibase : 2.;
''(1 + 1);

10.;
''(1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1);

10;
2.;

11111111;
255.;

10000000;
128.;

00000001;
1.;

[symbolp (23401), numberp (23401)];
[true, false];

[symbolp (\10432), numberp (\10432)];
[true, false];

[10.25, 10.25d0, 10.25e0, 10.25f0, 10.25s0] - 1010 - 1/100;
''(float ([0, 0, 0, 0, 0]));

[99.25, 99.25d0, 99.25e0, 99.25f0, 99.25s0] - 1100011 - 1/100;
''(float ([0, 0, 0, 0, 0]));

ibase : 8.;
8.;

10.;
''(1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1);

10;
8.;

1111;
''(8.^3 + 8.^2 + 8. + 1);

7777;
4095.;

[symbolp (8765), numberp (8765)];
[true, false];

[symbolp (\5678), numberp (\5678)];
[true, false];

[10.25, 10.25d0, 10.25e0, 10.25f0, 10.25s0] - 12 - 1/4;
''(float ([0, 0, 0, 0, 0]));

[99.25, 99.25d0, 99.25e0, 99.25f0, 99.25s0] - 143 - 1/4;
''(float ([0, 0, 0, 0, 0]));

ibase : 16.;
16.;

10.;
''(1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1);

10;
16.;

111111;
''(16.^5 + 16.^4 + 16.^3 + 16.^2 + 16. + 1);

999;
''(9*16.^2 + 9*16. + 9);

1000;
''(16.^3);

[symbolp (a000), numberp (a000)];
[true, false];

[symbolp (0a000), numberp (0a000)];
[false, true];

0a000;
''(10.*16.^3);

[symbolp (\0a000), numberp (\0a000)];
[true, false];

[is (abc = 0abc), is (0abc = \0abc), is (\0abc = abc)];
[false, false, false];

a000 + a000 + 0a000 + 0a000 + \0a000 + \0a000;
2*a000 + 2*\0a000 + 14000;

[10.25, 10.25d0, 10.25e0, 10.25f0, 10.25s0] - 0a - 1/4;
''(float ([0, 0, 0, 0, 0]));

[99.25, 99.25d0, 99.25e0, 99.25f0, 99.25s0] - 63 - 1/4;
''(float ([0, 0, 0, 0, 0]));

aa . bb;
"." (\aa, \bb);

aa.bb;
"." (\aa, \bb);

ibase : 36.;
36.;

10.;
''(1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1);

10;
36.;

1111;
''(36.^3 + 36.^2 + 36. + 1);

9999;
''(9*36.^3 + 9*36.^2 + 9*36. + 9);

10000;
''(36.^4);

[symbolp (xyz), numberp (xyz)];
[true, false];

[symbolp (0xyz), numberp (0xyz)];
[false, true];

0xyz;
''(33.*36.^2 + 34.*36. + 35.);

0XYZ;
0xyz;

[symbolp (\0xyz), numberp (\0xyz)];
[true, false];

[is (xyz = 0xyz), is (0xyz = \0xyz), is (\0xyz = xyz)];
[false, false, false];

0xyz;
''(33.*36.^2 + 34.*36. + 35.);

1xyz;
''(36.^3 + 0xyz);

xyz + 0xyz + \0xyz + xyz + 0xyz + \0xyz + xyz + 0xyz + \0xyz;
3*xyz + 3*\0xyz + ''(3*(33.*36.^2 + 34.*36. + 35.));

[10.25, 10.25d0, 10.25e0, 10.25f0, 10.25s0] - 0a - 1/4;
''(float ([0, 0, 0, 0, 0]));

[99.25, 99.25d0, 99.25e0, 99.25f0, 99.25s0] - 02r - 1/4;
''(float ([0, 0, 0, 0, 0]));

aa . bb;
"." (\aa, \bb);

aa.bb;
"." (\aa, \bb);

ibase : 10.;
''(1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1);

obase : 2;
2.;

string (255);
"11111111";

string (-255);
"-11111111";

string (256);
"100000000";

obase : 8;
8.;

string (255);
"377";

string (-255);
"-377";

string (256);
"400";

obase : 16;
16.;

(string (255), is (%% = "0FF" or %% = "0ff"));
true;

(string (-255), is (%% = "-0FF" or %% = "-0ff"));
true;

string (256);
"100";

(string (10 * 16^3), is (%% = "0A000" or %% = "0a000"));
true;

(string (10*16^3 + 11*16^2 + 12*16 + 13), is (%% = "0ABCD" or %% = "0abcd"));
true;

obase : 36;
36.;

string (8*36^3 + 8*36^2 + 8*36 + 8);
"8888";

(string (8*36^3 + 9*36^2 + 10*36 + 11), is (%% = "89AB" or %% = "89ab"));
true;

(string (35*36^3 + 35*36^2 + 35*36 + 35), is (%% = "0ZZZZ" or %% = "0zzzz"));
true;

(string (-(35*36^3 + 35*36^2 + 35*36 + 35)), is (%% = "-0ZZZZ" or %% = "-0zzzz"));
true;

(string (34*36^3 + 35*36^2 + 8*36 + 7), is (%% = "0YZ87" or %% = "0yz87"));
true;

[ibase, obase] : [10., 10.];
[10., 10.];

10;
''(1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1);

string (10);
"10";

ibase : 2.;
2.;

[1, 11, 111, 1111];
[1., 3., 7., 15.];

(load (file_search (test_readbase_lisp, file_search_tests)),
 test_readbase_lisp ());
[1., 2., 3., 4., 10., 20., 30., 40.];

[1, 11, 111, 1111];
[1., 3., 7., 15.];

(?autof (test_readbase_lisp_autoload, file_search (test_readbase_lisp_autoload, file_search_tests)),
 test_readbase_lisp_autoload ());
[2., 3., 5., 7., 11., 13., 17., 19.];

[1, 11, 111, 1111];
[1., 3., 7., 15.];

(load (file_search (test_readbase_maxima, file_search_tests)),
 test_readbase_maxima ());
[4., 3., 2., 1., 40., 30., 20., 10.];

[1, 11, 111, 1111];
[1., 3., 7., 15.];

(batch (file_search (test_readbase_maxima, file_search_tests)),
 test_readbase_maxima ());
[4., 3., 2., 1., 40., 30., 20., 10.];

[1, 11, 111, 1111];
[1., 3., 7., 15.];

(auto_mexpr (test_readbase_maxima_autoload, file_search (test_readbase_maxima_autoload, file_search_tests)),
 test_readbase_maxima_autoload ());
[19., 17., 13., 11., 7., 5., 3., 2.];

[1, 11, 111, 1111];
[1., 3., 7., 15.];

ibase : 10.;
10.;

/* SF bug report # 2992398 "sort doesn't give error for invalid comparison"
 */

errcatch (sort([c, a, b], "<"));
[];

errcatch (sort([1, 2, 3], lambda([a, b], 'sdf)));
[];

sort ([c, a, b]);
[a, b, c];

sort ([1, 2, 3], "<");
[1, 2, 3];

sort ([1, 2, 3], lambda ([a, b], sin(a) < sin(b)));
[3, 1, 2];

/* some tests for todd_coxeter; dunno where else to put them
 * adapted from comments in src/todd-coxeter.lisp
 */

/* this one seems to run indefinitely or at least a very long time */
/*
todd_coxeter([x^^3,y.x.y^^-1 . x^^-1],[]);
6;
 */

todd_coxeter([a^^8,b^^7,a.b.a.b,(a^^-1 . b)^^3],[a^^2, a^^-1 . b]);
448;

(kill (p, symet),
 p(i,j) :=concat(x,i).concat(x,j),
 symet(n):=create_list(if (j - i) = 1 then (p(i,j))^^3 else
   if (not i = j) then (p(i,j))^^2 else p(i,i) , j,1,n-1,i,1,j),
 0);
0;

/* comment says todd_coxeter(symet(n)) == n! */

todd_coxeter (symet (1));
1;

todd_coxeter (symet (2));
2;

todd_coxeter (symet (3));
6;

todd_coxeter (symet (4));
24;

todd_coxeter (symet (5));
120;

/* SF bug #2695: 'kill' kills built-in properties of operator after user-defined property */

(kill (a, b), string (a*b));
"a*b";

(put ("*", 'bar, 'foo), kill (all), string (a*b));
"a*b";

/* SF bug #3387: kill(all) looses mtime's "nary" property
 * (tickled by the preceding test)
 */

xreduce ("*", []);
1;

(put ("+", 'baz, 'quux), kill (all));
done;

xreduce ("+", []);
0;

/* reported to mailing list 2015-01-05: "order of operands is changed due to source information" */

block([simp:false], ?cons(?list('?mplus),?cdr([1,5,3])), string(%%));
"1+5+3";

block([simp:false], ?cons(?list('?mplus,'?foo, '?bar),?cdr([1,5,3])), string(%%));
"1+5+3";

/* SF bug #3012: "orderlessp/ordergreatp confusing treatment of upper/lower case in symbol names" */

orderlessp ("A1", "B1");
true;

orderlessp ("A1", "Ba");
true;

orderlessp ("Aa", "B1");
true;

orderlessp ("Aa", "Ba");
true;

kill (A1, B1, Aa, Ba);
done;

orderlessp (A1, B1);
true;

orderlessp (A1, Ba);
true;

orderlessp (Aa, B1);
true;

orderlessp (Aa, Ba);
true;

sort (["aaa", "A_i", "bbb", "ccc", "C_R_tia", "C_tia", "l", "R_tia", "v", "x1",
  "x10", "x8", "A0", "C_K_2", "C_MESS_P2", "C_S_1", "C_S_2", "C_S_MESS", "C_STREU", "ION", "U0"]);
["A0", "A_i", "C_K_2", "C_MESS_P2", "C_R_tia", "C_STREU", "C_S_1", 
"C_S_2", "C_S_MESS", "C_tia", "ION", "R_tia", "U0", "aaa", "bbb", "ccc", "l", 
"v", "x1", "x10", "x8"];

kill (aaa, A_i, bbb, ccc, C_R_tia, C_tia, l, R_tia, v, x1, x10, x8, A0,
  C_K_2, C_MESS_P2, C_S_1, C_S_2, C_S_MESS, C_STREU, ION, U0);
done;

sort ([aaa, A_i, bbb, ccc, C_R_tia, C_tia, l, R_tia, v, x1, x10, x8, A0,
  C_K_2, C_MESS_P2, C_S_1, C_S_2, C_S_MESS, C_STREU, ION, U0]);
[A0, A_i, C_K_2, C_MESS_P2, C_R_tia, C_STREU, C_S_1, 
C_S_2, C_S_MESS, C_tia, ION, R_tia, U0, aaa, bbb, ccc, l, 
v, x1, x10, x8];

/* SF bug #365: "orderlessp not transitive" */

(kill(l, p, q, r, s, x, v), l: [z+x*(x+2)+v+1,z+x^2+x+v+1,z+(x+1)^2+v], 0);
0;

orderlessp(l[1],l[2]);
true;

orderlessp(l[2],l[3]);
true;

orderlessp(l[1],l[3]);
true;

(q: x^2, r: (x+1)^2, s: x*(x+2), 0);
0;

orderlessp(s,q);
true;

orderlessp(q,r);
true;

orderlessp(r,s);
false;

orderlessp(s, r);
true;

[q+r+s, q+s+r, r+q+s, r+s+q, s+q+r, s+r+q];
[(x+1)^2+x^2+x*(x+2),
 (x+1)^2+x^2+x*(x+2),
 (x+1)^2+x^2+x*(x+2),
 (x+1)^2+x^2+x*(x+2),
 (x+1)^2+x^2+x*(x+2),
 (x+1)^2+x^2+x*(x+2)];

(q+s+r)-(q+s+r);
0;

(q+s+r)-(s+q+r);
0;

(q+r+s)-(q+s+r);
0;

foo : q+r+s;
(x+1)^2+x^2+x*(x+2);

expand(foo,0,0);
(x+1)^2+x^2+x*(x+2);

expand(foo,0,0);
(x+1)^2+x^2+x*(x+2);

q+r+s-r-q-s;
0;

orderlessp(t/2,t);
true;

orderlessp(t,t+1/4);
true;

orderlessp(t/2,t+1/4);
true;

orderlessp((x+1)^2,x^2-1);
false;

orderlessp(x^2-1,x^2);
true;

orderlessp((x+1)^2,x^2);
false;

/* additional tests related to #365, from mailing list 2016-01-14:
 * "Simplifier can't decide and enters a cycle (minimalistic example)"
 */

(kill(a, b, c, A, x, w), a:x, b:A(x - 1), c:A(w*(x - 1)), 0);
0;

(kill(in_order, exactly_1),
 in_order (a, b, c) := orderlessp(a, b) and orderlessp(b, c) and orderlessp(a, c),
 exactly_1 ([p]) := is (length (sublist (p, lambda ([e], e=true))) = 1),
 0);
0;

exactly_1 (in_order(a, b, c), in_order(a, c, b), in_order(b, a, c),
 in_order(b, c, a), in_order(c, a, b), in_order(c, b, a));
true;

exactly_1 (in_order(q, r, s), in_order(q, s, r), in_order(r, q, s),
 in_order(r, s, q), in_order(s, q, r), in_order(s, r, q));
true;

exactly_1 (in_order(l[1], l[2], l[3]), in_order(l[1], l[3], l[2]), in_order(l[2], l[1], l[3]),
 in_order(l[2], l[3], l[1]), in_order(l[3], l[1], l[2]), in_order(l[3], l[2], l[1]));
true;

/* other examples -- let a = x + 1 or a = x - 1 instead of a = x. */

(a : x + 1, 0);
0;

exactly_1 (in_order(a, b, c), in_order(a, c, b), in_order(b, a, c),
 in_order(b, c, a), in_order(c, a, b), in_order(c, b, a));
true;

(a : x - 1, 0);
0;

exactly_1 (in_order(a, b, c), in_order(a, c, b), in_order(b, a, c),
 in_order(b, c, a), in_order(c, a, b), in_order(c, b, a));
true;

/* additional examples from mailing list 2016-01-28 tnx Stavros Macrakis */

([[  sqrt(2), (1-sqrt(2))^x, log(1-sqrt(2))],
  [  sqrt(2), (1-sqrt(2))^x, log(2)],
  [  sqrt(2), (1-sqrt(2))^x, log(log(1-sqrt(2)))],
  [  sqrt(2), (1-sqrt(2))^x, log(log(2))],
  [  sqrt(2), (1-sqrt(2))^x, (1-sqrt(2))^(x+1)*log(2)*log(1-sqrt(2))],
  [ -sqrt(2), (1-sqrt(2))^x, log(1-sqrt(2))],
  [ -sqrt(2), (1-sqrt(2))^x, log(2)],
  [ -sqrt(2), (1-sqrt(2))^x, log(log(1-sqrt(2)))],
  [ -sqrt(2), (1-sqrt(2))^x, log(log(2))],
  [ -sqrt(2), (1-sqrt(2))^x, (1-sqrt(2))^(x+1)*log(2)*log(1-sqrt(2))],
  [1-sqrt(2), (1-sqrt(2))^x, (1-sqrt(2))^(x+1)*log(2)*log(1-sqrt(2))],
  [1-sqrt(2), (1-sqrt(2))^x, log(1-sqrt(2))],
  [1-sqrt(2), (1-sqrt(2))^x, log(2)],
  [1-sqrt(2), (1-sqrt(2))^x, log(log(1-sqrt(2)))],
  [1-sqrt(2), (1-sqrt(2))^x, log(log(2))]],
  map (lambda ([l], apply (exactly_1, map (lambda ([triple], apply (in_order, triple)),  
					   (listify (permutations (l)))))),
       %%));
[true, true, true, true, true, true, true, true, true, true, true, true, true, true, true];

/* totalorderp from mailing list 2016-07-18 "Testing for total order (for orderlessp testing)" tnx Stavros */

(totalorderp(func,domain) :=
   block([ord,i,j,res:[]],
      ord: sort(domain, func),
      i:0,
      for eli in ord do
        (i:i+1,
         j:0,
         for elj in ord do
          (j:j+1,
           if (func(eli,elj) # is(i<j)) and not(eli=elj)
           then push([i,j,eli,elj],res))),
              res),
 0);
0;

(b10: bfloat(1),fpprec:10,
 b20: bfloat(1),fpprec:20,
 totalorderp('orderlessp, [2^-K,b10,2^K,b20,K^(5/2),b10,2^x,K,x,2^-x,K^2]));
[];

(declare (K, constant),
 totalorderp('orderlessp, [2^-K,b10,2^K,b20,K^(5/2),b10,2^x,K,x,2^-x,K^2]));
[];

kill (K);
done;

/* ensure that GREAT returns only T or NIL, not an integer, when its arguments are strings. */

?great ("foo", "bar");
true;

?great ("bar", "foo");
false;

/* check return values for float_approx_equal */

(xx: [most_negative_float, least_negative_normalized_float, least_negative_float,
      0.0, 1.0, least_positive_float, least_positive_normalized_float, most_positive_float],
 xx : unique (xx),
 if errcatch (x: 1.0/0.0) # [] then push (x, xx),
 if errcatch (x: -1.0/0.0) # [] then push (x, xx),
 if errcatch (x: 0.0/0.0) # [] then push (x, xx),
 genmatrix (lambda ([i, j], errcatch (float_approx_equal (xx[i], xx[j])), if %% = [] then %% else %%[1]),
            length (xx), length (xx)));
''(genmatrix (lambda ([i, j], if i = j then true else false), length (xx), length (xx)));

(kill (foo, bar),
 foo: 1.0,
 bar: foo - float_eps (),
 float_approx_equal_tolerance: float_eps (),
 floatnump (bar));
true;

block ([foo100: 1e-100*foo, bar100: 1e-100*bar],
        [is (foo100 = bar100), float_approx_equal (foo100, bar100)]);
[false, true];

block ([foo10: 1e-10*foo, bar10: 1e-10*bar],
        [is (foo10 = bar10), float_approx_equal (foo10, bar10)]);
[false, true];

[is (foo = bar), float_approx_equal (foo, bar)];
[false, true];

block ([foo10: 1e10*foo, bar10: 1e10*bar],
        [is (foo10 = bar10), float_approx_equal (foo10, bar10)]);
[false, true];

block ([foo100: 1e100*foo, bar100: 1e100*bar],
        [is (foo100 = bar100), float_approx_equal (foo100, bar100)]);
[false, true];

/* errcatch failed to catch some types of errors.  It caught the usual Maxima
 * and lisp errors, but it failed to catch some errors that would just throw
 * elsewhere.
 */

errcatch (gf_set_data ("wtf"));
[];

block ([?errorsw : true], errcatch (log (0)));
[];

/* Try to verify that autoloading a Maxima function doesn't interfere with VARLIST.
 * The one known example is this integral, which gives different results depending on
 * whether trigsimp is loaded already or not.
 *
 * At present (2022-09-05), Maxima returns an incorrect result for this integral.
 * At this point, verify only that the result is consistent.
 *
 * Probably a more contrived example would be better here -- if ever the integral
 * is changed so it doesn't call trigsimp, this test won't verify autoloading behavior.
 */

(kill (x, functions),
 ii: 'integrate(sin(x)*atan2(sin(x), cos(x)), x, -%pi, %pi),
 0);
0;

(result1: ev (ii, nouns),
 /* remember result but don't test it -- at present (2022-09-05) it is incorrect */
 0);
0;

(result2: ev (ii, nouns),
 is (result2 = result1));
true;

(kill (functions), /* make it necessary to reload trigsimp */
 result3: ev (ii, nouns),
 is (result3 = result2));
true;

/* SF bug #4035: "Invisible characters should work better" */

/* from the bug report */

/* string in this next example has U+200B (ZERO WIDTH SPACE) before "23" */
errcatch (parse_string ("ex: ​23;"));
[ex: 23];

/* other examples */

ibase: 16.;
16.;

/* these are the codes for the space characters mentioned in src/nparse.lisp */
(space_chars: map (unicode, [ 00A0, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 200A, 200B, 202F, 205F ]),
 ibase: 10.);
10.;

(nn: makelist (100 + i, i, 1, length (space_chars)),
 apply (sconcat, flatten (append (["[", 100], map (lambda ([s, n], [",", s, n]), space_chars, nn), ["];"]))),
 parse_string (%%));
''(cons (100, nn));
