1 /*************** -*- Mode: MACSYMA; Package: MAXIMA -*- ******************/
2 /***************************************************************************
4 *** Copyright (c) 1984 by William Schelter,University of Texas *****
5 *** All rights reserved *****
6 ***************************************************************************/
8 /* PRODUCED USING TOPS 20 AS GUIDE AND CHECKED ON 3600
9 This and the rtest*.mac files can be run using the command
10 Batch("cl-maxima-source:maxima;rtest1.mac",test); and a
11 log file will be written recording the items which the testing
12 function does not find the same as those answers listed in this file.
13 The test is based on manual.demo, with the answers obtained from
14 tops 20 macsyma, and checked on the 3600 with cl-maxima.
15 Although we have tried to put sufficient kills in, to eliminate
16 errors caused by previous definitions, you may get some additional
17 errors if you rerun the tests, or run some out of order. */
19 (?fmakunbound(f),kill(functions,values,arrays));
33 ev(g(2*y+z,-0.5),y:7);
34 3*(z+14)+1.22984884706593$
35 h(n):=sum(i*x^i,i,0,n);
36 h(n):=sum(i*x^i,i,0,n)$
39 t[n](x):=ratexpand(2*x*t[n-1](x)-t[n-2](x));
40 t[n](x):=ratexpand(2*x*t[n-1](x)-t[n-2](x))$
47 g[n](x):=sum(ev(x),i,n,n+2);
48 g[n](x):=sum(ev(x),i,n,n+2)$
49 h(n,x):=sum(ev(x),i,n,n+2);
50 h(n,x):=sum(ev(x),i,n,n+2)$
55 p[n](x):=ratsimp(1/(2^n*n!)*diff((x^2-1)^n,x,n));
56 p[n](x):=ratsimp(1/(2^n*n!)*diff((x^2-1)^n,x,n))$
57 q(n,x):=ratsimp(1/(2^n*n!)*diff((x^2-1)^n,x,n));
58 q(n,x):=ratsimp(1/(2^n*n!)*diff((x^2-1)^n,x,n))$
60 lambda([x],(3*x^2-1)/2)$
69 g(fun,a,b):=print(fun," applied to ",a," and ",b," is ",fun(a,b));
70 g(fun,a,b):=print(fun," applied to ",a," and ",b," is ",fun(a,b))$
71 g(f[2,1],sin(%pi),2*c);
74 /* tests for ibase and obase; a recent accretion. dunno where else to put this stuff. */
76 [integerp (2.), floatnump (2.)];
83 ''(1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1);
97 [symbolp (23401), numberp (23401)];
100 [symbolp (\10432), numberp (\10432)];
103 [10.25, 10.25d0, 10.25e0, 10.25f0, 10.25s0] - 1010 - 1/100;
104 ''(float ([0, 0, 0, 0, 0]));
106 [99.25, 99.25d0, 99.25e0, 99.25f0, 99.25s0] - 1100011 - 1/100;
107 ''(float ([0, 0, 0, 0, 0]));
113 ''(1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1);
119 ''(8.^3 + 8.^2 + 8. + 1);
124 [symbolp (8765), numberp (8765)];
127 [symbolp (\5678), numberp (\5678)];
130 [10.25, 10.25d0, 10.25e0, 10.25f0, 10.25s0] - 12 - 1/4;
131 ''(float ([0, 0, 0, 0, 0]));
133 [99.25, 99.25d0, 99.25e0, 99.25f0, 99.25s0] - 143 - 1/4;
134 ''(float ([0, 0, 0, 0, 0]));
140 ''(1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1);
146 ''(16.^5 + 16.^4 + 16.^3 + 16.^2 + 16. + 1);
149 ''(9*16.^2 + 9*16. + 9);
154 [symbolp (a000), numberp (a000)];
157 [symbolp (0a000), numberp (0a000)];
163 [symbolp (\0a000), numberp (\0a000)];
166 [is (abc = 0abc), is (0abc = \0abc), is (\0abc = abc)];
167 [false, false, false];
169 a000 + a000 + 0a000 + 0a000 + \0a000 + \0a000;
170 2*a000 + 2*\0a000 + 14000;
172 [10.25, 10.25d0, 10.25e0, 10.25f0, 10.25s0] - 0a - 1/4;
173 ''(float ([0, 0, 0, 0, 0]));
175 [99.25, 99.25d0, 99.25e0, 99.25f0, 99.25s0] - 63 - 1/4;
176 ''(float ([0, 0, 0, 0, 0]));
188 ''(1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1);
194 ''(36.^3 + 36.^2 + 36. + 1);
197 ''(9*36.^3 + 9*36.^2 + 9*36. + 9);
202 [symbolp (xyz), numberp (xyz)];
205 [symbolp (0xyz), numberp (0xyz)];
209 ''(33.*36.^2 + 34.*36. + 35.);
214 [symbolp (\0xyz), numberp (\0xyz)];
217 [is (xyz = 0xyz), is (0xyz = \0xyz), is (\0xyz = xyz)];
218 [false, false, false];
221 ''(33.*36.^2 + 34.*36. + 35.);
226 xyz + 0xyz + \0xyz + xyz + 0xyz + \0xyz + xyz + 0xyz + \0xyz;
227 3*xyz + 3*\0xyz + ''(3*(33.*36.^2 + 34.*36. + 35.));
229 [10.25, 10.25d0, 10.25e0, 10.25f0, 10.25s0] - 0a - 1/4;
230 ''(float ([0, 0, 0, 0, 0]));
232 [99.25, 99.25d0, 99.25e0, 99.25f0, 99.25s0] - 02r - 1/4;
233 ''(float ([0, 0, 0, 0, 0]));
242 ''(1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1);
271 (string (255), is (%% = "0FF" or %% = "0ff"));
274 (string (-255), is (%% = "-0FF" or %% = "-0ff"));
280 (string (10 * 16^3), is (%% = "0A000" or %% = "0a000"));
283 (string (10*16^3 + 11*16^2 + 12*16 + 13), is (%% = "0ABCD" or %% = "0abcd"));
289 string (8*36^3 + 8*36^2 + 8*36 + 8);
292 (string (8*36^3 + 9*36^2 + 10*36 + 11), is (%% = "89AB" or %% = "89ab"));
295 (string (35*36^3 + 35*36^2 + 35*36 + 35), is (%% = "0ZZZZ" or %% = "0zzzz"));
298 (string (-(35*36^3 + 35*36^2 + 35*36 + 35)), is (%% = "-0ZZZZ" or %% = "-0zzzz"));
301 (string (34*36^3 + 35*36^2 + 8*36 + 7), is (%% = "0YZ87" or %% = "0yz87"));
304 [ibase, obase] : [10., 10.];
308 ''(1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1);
319 (load (file_search (test_readbase_lisp, file_search_tests)),
320 test_readbase_lisp ());
321 [1., 2., 3., 4., 10., 20., 30., 40.];
326 (?autof (test_readbase_lisp_autoload, file_search (test_readbase_lisp_autoload, file_search_tests)),
327 test_readbase_lisp_autoload ());
328 [2., 3., 5., 7., 11., 13., 17., 19.];
333 (load (file_search (test_readbase_maxima, file_search_tests)),
334 test_readbase_maxima ());
335 [4., 3., 2., 1., 40., 30., 20., 10.];
340 (batch (file_search (test_readbase_maxima, file_search_tests)),
341 test_readbase_maxima ());
342 [4., 3., 2., 1., 40., 30., 20., 10.];
347 (auto_mexpr (test_readbase_maxima_autoload, file_search (test_readbase_maxima_autoload, file_search_tests)),
348 test_readbase_maxima_autoload ());
349 [19., 17., 13., 11., 7., 5., 3., 2.];
357 /* SF bug report # 2992398 "sort doesn't give error for invalid comparison"
360 errcatch (sort([c, a, b], "<"));
363 errcatch (sort([1, 2, 3], lambda([a, b], 'sdf)));
369 sort ([1, 2, 3], "<");
372 sort ([1, 2, 3], lambda ([a, b], sin(a) < sin(b)));
375 /* some tests for todd_coxeter; dunno where else to put them
376 * adapted from comments in src/todd-coxeter.lisp
379 /* this one seems to run indefinitely or at least a very long time */
381 todd_coxeter([x^^3,y.x.y^^-1 . x^^-1],[]);
385 todd_coxeter([a^^8,b^^7,a.b.a.b,(a^^-1 . b)^^3],[a^^2, a^^-1 . b]);
389 p(i,j) :=concat(x,i).concat(x,j),
390 symet(n):=create_list(if (j - i) = 1 then (p(i,j))^^3 else
391 if (not i = j) then (p(i,j))^^2 else p(i,i) , j,1,n-1,i,1,j),
395 /* comment says todd_coxeter(symet(n)) == n! */
397 todd_coxeter (symet (1));
400 todd_coxeter (symet (2));
403 todd_coxeter (symet (3));
406 todd_coxeter (symet (4));
409 todd_coxeter (symet (5));
412 /* SF bug #2695: 'kill' kills built-in properties of operator after user-defined property */
414 (kill (a, b), string (a*b));
417 (put ("*", 'bar, 'foo), kill (all), string (a*b));
420 /* SF bug #3387: kill(all) looses mtime's "nary" property
421 * (tickled by the preceding test)
427 (put ("+", 'baz, 'quux), kill (all));
433 /* reported to mailing list 2015-01-05: "order of operands is changed due to source information" */
435 block([simp:false], ?cons(?list('?mplus),?cdr([1,5,3])), string(%%));
438 block([simp:false], ?cons(?list('?mplus,'?foo, '?bar),?cdr([1,5,3])), string(%%));
441 /* SF bug #3012: "orderlessp/ordergreatp confusing treatment of upper/lower case in symbol names" */
443 orderlessp ("A1", "B1");
446 orderlessp ("A1", "Ba");
449 orderlessp ("Aa", "B1");
452 orderlessp ("Aa", "Ba");
455 kill (A1, B1, Aa, Ba);
470 sort (["aaa", "A_i", "bbb", "ccc", "C_R_tia", "C_tia", "l", "R_tia", "v", "x1",
471 "x10", "x8", "A0", "C_K_2", "C_MESS_P2", "C_S_1", "C_S_2", "C_S_MESS", "C_STREU", "ION", "U0"]);
472 ["A0", "A_i", "C_K_2", "C_MESS_P2", "C_R_tia", "C_STREU", "C_S_1",
473 "C_S_2", "C_S_MESS", "C_tia", "ION", "R_tia", "U0", "aaa", "bbb", "ccc", "l",
474 "v", "x1", "x10", "x8"];
476 kill (aaa, A_i, bbb, ccc, C_R_tia, C_tia, l, R_tia, v, x1, x10, x8, A0,
477 C_K_2, C_MESS_P2, C_S_1, C_S_2, C_S_MESS, C_STREU, ION, U0);
480 sort ([aaa, A_i, bbb, ccc, C_R_tia, C_tia, l, R_tia, v, x1, x10, x8, A0,
481 C_K_2, C_MESS_P2, C_S_1, C_S_2, C_S_MESS, C_STREU, ION, U0]);
482 [A0, A_i, C_K_2, C_MESS_P2, C_R_tia, C_STREU, C_S_1,
483 C_S_2, C_S_MESS, C_tia, ION, R_tia, U0, aaa, bbb, ccc, l,
486 /* SF bug #365: "orderlessp not transitive" */
488 (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);
491 orderlessp(l[1],l[2]);
494 orderlessp(l[2],l[3]);
497 orderlessp(l[1],l[3]);
500 (q: x^2, r: (x+1)^2, s: x*(x+2), 0);
515 [q+r+s, q+s+r, r+q+s, r+s+q, s+q+r, s+r+q];
516 [(x+1)^2+x^2+x*(x+2),
521 (x+1)^2+x^2+x*(x+2)];
550 orderlessp(t/2,t+1/4);
553 orderlessp((x+1)^2,x^2-1);
556 orderlessp(x^2-1,x^2);
559 orderlessp((x+1)^2,x^2);
562 /* additional tests related to #365, from mailing list 2016-01-14:
563 * "Simplifier can't decide and enters a cycle (minimalistic example)"
566 (kill(a, b, c, A, x, w), a:x, b:A(x - 1), c:A(w*(x - 1)), 0);
569 (kill(in_order, exactly_1),
570 in_order (a, b, c) := orderlessp(a, b) and orderlessp(b, c) and orderlessp(a, c),
571 exactly_1 ([p]) := is (length (sublist (p, lambda ([e], e=true))) = 1),
575 exactly_1 (in_order(a, b, c), in_order(a, c, b), in_order(b, a, c),
576 in_order(b, c, a), in_order(c, a, b), in_order(c, b, a));
579 exactly_1 (in_order(q, r, s), in_order(q, s, r), in_order(r, q, s),
580 in_order(r, s, q), in_order(s, q, r), in_order(s, r, q));
583 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]),
584 in_order(l[2], l[3], l[1]), in_order(l[3], l[1], l[2]), in_order(l[3], l[2], l[1]));
587 /* other examples -- let a = x + 1 or a = x - 1 instead of a = x. */
592 exactly_1 (in_order(a, b, c), in_order(a, c, b), in_order(b, a, c),
593 in_order(b, c, a), in_order(c, a, b), in_order(c, b, a));
599 exactly_1 (in_order(a, b, c), in_order(a, c, b), in_order(b, a, c),
600 in_order(b, c, a), in_order(c, a, b), in_order(c, b, a));
603 /* additional examples from mailing list 2016-01-28 tnx Stavros Macrakis */
605 ([[ sqrt(2), (1-sqrt(2))^x, log(1-sqrt(2))],
606 [ sqrt(2), (1-sqrt(2))^x, log(2)],
607 [ sqrt(2), (1-sqrt(2))^x, log(log(1-sqrt(2)))],
608 [ sqrt(2), (1-sqrt(2))^x, log(log(2))],
609 [ sqrt(2), (1-sqrt(2))^x, (1-sqrt(2))^(x+1)*log(2)*log(1-sqrt(2))],
610 [ -sqrt(2), (1-sqrt(2))^x, log(1-sqrt(2))],
611 [ -sqrt(2), (1-sqrt(2))^x, log(2)],
612 [ -sqrt(2), (1-sqrt(2))^x, log(log(1-sqrt(2)))],
613 [ -sqrt(2), (1-sqrt(2))^x, log(log(2))],
614 [ -sqrt(2), (1-sqrt(2))^x, (1-sqrt(2))^(x+1)*log(2)*log(1-sqrt(2))],
615 [1-sqrt(2), (1-sqrt(2))^x, (1-sqrt(2))^(x+1)*log(2)*log(1-sqrt(2))],
616 [1-sqrt(2), (1-sqrt(2))^x, log(1-sqrt(2))],
617 [1-sqrt(2), (1-sqrt(2))^x, log(2)],
618 [1-sqrt(2), (1-sqrt(2))^x, log(log(1-sqrt(2)))],
619 [1-sqrt(2), (1-sqrt(2))^x, log(log(2))]],
620 map (lambda ([l], apply (exactly_1, map (lambda ([triple], apply (in_order, triple)),
621 (listify (permutations (l)))))),
623 [true, true, true, true, true, true, true, true, true, true, true, true, true, true, true];
625 /* totalorderp from mailing list 2016-07-18 "Testing for total order (for orderlessp testing)" tnx Stavros */
627 (totalorderp(func,domain) :=
628 block([ord,i,j,res:[]],
629 ord: sort(domain, func),
636 if (func(eli,elj) # is(i<j)) and not(eli=elj)
637 then push([i,j,eli,elj],res))),
642 (b10: bfloat(1),fpprec:10,
643 b20: bfloat(1),fpprec:20,
644 totalorderp('orderlessp, [2^-K,b10,2^K,b20,K^(5/2),b10,2^x,K,x,2^-x,K^2]));
647 (declare (K, constant),
648 totalorderp('orderlessp, [2^-K,b10,2^K,b20,K^(5/2),b10,2^x,K,x,2^-x,K^2]));
654 /* ensure that GREAT returns only T or NIL, not an integer, when its arguments are strings. */
656 ?great ("foo", "bar");
659 ?great ("bar", "foo");
662 /* check return values for float_approx_equal */
664 (xx: [most_negative_float, least_negative_normalized_float, least_negative_float,
665 0.0, 1.0, least_positive_float, least_positive_normalized_float, most_positive_float],
667 if errcatch (x: 1.0/0.0) # [] then push (x, xx),
668 if errcatch (x: -1.0/0.0) # [] then push (x, xx),
669 if errcatch (x: 0.0/0.0) # [] then push (x, xx),
670 genmatrix (lambda ([i, j], errcatch (float_approx_equal (xx[i], xx[j])), if %% = [] then %% else %%[1]),
671 length (xx), length (xx)));
672 ''(genmatrix (lambda ([i, j], if i = j then true else false), length (xx), length (xx)));
676 bar: foo - float_eps (),
677 float_approx_equal_tolerance: float_eps (),
681 block ([foo100: 1e-100*foo, bar100: 1e-100*bar],
682 [is (foo100 = bar100), float_approx_equal (foo100, bar100)]);
685 block ([foo10: 1e-10*foo, bar10: 1e-10*bar],
686 [is (foo10 = bar10), float_approx_equal (foo10, bar10)]);
689 [is (foo = bar), float_approx_equal (foo, bar)];
692 block ([foo10: 1e10*foo, bar10: 1e10*bar],
693 [is (foo10 = bar10), float_approx_equal (foo10, bar10)]);
696 block ([foo100: 1e100*foo, bar100: 1e100*bar],
697 [is (foo100 = bar100), float_approx_equal (foo100, bar100)]);
700 /* errcatch failed to catch some types of errors. It caught the usual Maxima
701 * and lisp errors, but it failed to catch some errors that would just throw
705 errcatch (gf_set_data ("wtf"));
708 block ([?errorsw : true], errcatch (log (0)));
711 /* Try to verify that autoloading a Maxima function doesn't interfere with VARLIST.
712 * The one known example is this integral, which gives different results depending on
713 * whether trigsimp is loaded already or not.
715 * At present (2022-09-05), Maxima returns an incorrect result for this integral.
716 * At this point, verify only that the result is consistent.
718 * Probably a more contrived example would be better here -- if ever the integral
719 * is changed so it doesn't call trigsimp, this test won't verify autoloading behavior.
722 (kill (x, functions),
723 ii: 'integrate(sin(x)*atan2(sin(x), cos(x)), x, -%pi, %pi),
727 (result1: ev (ii, nouns),
728 /* remember result but don't test it -- at present (2022-09-05) it is incorrect */
732 (result2: ev (ii, nouns),
733 is (result2 = result1));
736 (kill (functions), /* make it necessary to reload trigsimp */
737 result3: ev (ii, nouns),
738 is (result3 = result2));
741 /* SF bug #4035: "Invisible characters should work better" */
743 /* from the bug report */
745 /* string in this next example has U+200B (ZERO WIDTH SPACE) before "23" */
746 errcatch (parse_string ("ex: 23;"));
754 /* these are the codes for the space characters mentioned in src/nparse.lisp */
755 (space_chars: map (unicode, [ 00A0, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 200A, 200B, 202F, 205F ]),
759 (nn: makelist (100 + i, i, 1, length (space_chars)),
760 apply (sconcat, flatten (append (["[", 100], map (lambda ([s, n], [",", s, n]), space_chars, nn), ["];"]))),