tests/rtest1.mac

   1 /*************** -*- Mode: MACSYMA; Package: MAXIMA -*-  ******************/
   2 /***************************************************************************
   3 ***                                                                    *****
   4 ***     Copyright (c) 1984 by William Schelter,University of Texas     *****
   5 ***     All rights reserved                                            *****
   6 ***************************************************************************/
   7
   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. */
  18
  19 (?fmakunbound(f),kill(functions,values,arrays));
  20 done;
  21 f(x):=x^2+y;
  22 f(x):=x^2+y$
  23 f(2);
  24 y+4$
  25 ev(f(2),y:7);
  26 11$
  27 f(x):=sin(x)^2+1;
  28 f(x):=sin(x)^2+1$
  29 f(x+1);
  30 sin(x+1)^2+1$
  31 g(y,z):=f(z)+3*y;
  32 g(y,z):=f(z)+3*y$
  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)$
  37 functions;
  38 [f(x),g(y,z),h(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))$
  41 t[0](x):=1;
  42 t[0](x):=1$
  43 t[1](x):=x;
  44 t[1](x):=x$
  45 t[4](y);
  46 8*y^4-8*y^2+1$
  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)$
  51 g[2](i^2);
  52 3*i^2$
  53 h(2,i^2);
  54 29$
  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))$
  59 p[2];
  60 lambda([x],(3*x^2-1)/2)$
  61 p[2](y+1);
  62 (3*(y+1)^2-1)/2$
  63 q(2,y);
  64 (3*y^2-1)/2$
  65 p[2](5);
  66 37$
  67 f[i,j](x,y):=x^i+y^j;
  68 f[i,j](x,y):=x^i+y^j$
  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);
  72 2*c$
  73
  74 /* tests for ibase and obase; a recent accretion. dunno where else to put this stuff. */
  75
  76 [integerp (2.), floatnump (2.)];
  77 [true, false];
  78
  79 ibase : 2.;
  80 ''(1 + 1);
  81
  82 10.;
  83 ''(1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1);
  84
  85 10;
  86 2.;
  87
  88 11111111;
  89 255.;
  90
  91 10000000;
  92 128.;
  93
  94 00000001;
  95 1.;
  96
  97 [symbolp (23401), numberp (23401)];
  98 [true, false];
  99
 100 [symbolp (\10432), numberp (\10432)];
 101 [true, false];
 102
 103 [10.25, 10.25d0, 10.25e0, 10.25f0, 10.25s0] - 1010 - 1/100;
 104 ''(float ([0, 0, 0, 0, 0]));
 105
 106 [99.25, 99.25d0, 99.25e0, 99.25f0, 99.25s0] - 1100011 - 1/100;
 107 ''(float ([0, 0, 0, 0, 0]));
 108
 109 ibase : 8.;
 110 8.;
 111
 112 10.;
 113 ''(1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1);
 114
 115 10;
 116 8.;
 117
 118 1111;
 119 ''(8.^3 + 8.^2 + 8. + 1);
 120
 121 7777;
 122 4095.;
 123
 124 [symbolp (8765), numberp (8765)];
 125 [true, false];
 126
 127 [symbolp (\5678), numberp (\5678)];
 128 [true, false];
 129
 130 [10.25, 10.25d0, 10.25e0, 10.25f0, 10.25s0] - 12 - 1/4;
 131 ''(float ([0, 0, 0, 0, 0]));
 132
 133 [99.25, 99.25d0, 99.25e0, 99.25f0, 99.25s0] - 143 - 1/4;
 134 ''(float ([0, 0, 0, 0, 0]));
 135
 136 ibase : 16.;
 137 16.;
 138
 139 10.;
 140 ''(1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1);
 141
 142 10;
 143 16.;
 144
 145 111111;
 146 ''(16.^5 + 16.^4 + 16.^3 + 16.^2 + 16. + 1);
 147
 148 999;
 149 ''(9*16.^2 + 9*16. + 9);
 150
 151 1000;
 152 ''(16.^3);
 153
 154 [symbolp (a000), numberp (a000)];
 155 [true, false];
 156
 157 [symbolp (0a000), numberp (0a000)];
 158 [false, true];
 159
 160 0a000;
 161 ''(10.*16.^3);
 162
 163 [symbolp (\0a000), numberp (\0a000)];
 164 [true, false];
 165
 166 [is (abc = 0abc), is (0abc = \0abc), is (\0abc = abc)];
 167 [false, false, false];
 168
 169 a000 + a000 + 0a000 + 0a000 + \0a000 + \0a000;
 170 2*a000 + 2*\0a000 + 14000;
 171
 172 [10.25, 10.25d0, 10.25e0, 10.25f0, 10.25s0] - 0a - 1/4;
 173 ''(float ([0, 0, 0, 0, 0]));
 174
 175 [99.25, 99.25d0, 99.25e0, 99.25f0, 99.25s0] - 63 - 1/4;
 176 ''(float ([0, 0, 0, 0, 0]));
 177
 178 aa . bb;
 179 "." (\aa, \bb);
 180
 181 aa.bb;
 182 "." (\aa, \bb);
 183
 184 ibase : 36.;
 185 36.;
 186
 187 10.;
 188 ''(1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1);
 189
 190 10;
 191 36.;
 192
 193 1111;
 194 ''(36.^3 + 36.^2 + 36. + 1);
 195
 196 9999;
 197 ''(9*36.^3 + 9*36.^2 + 9*36. + 9);
 198
 199 10000;
 200 ''(36.^4);
 201
 202 [symbolp (xyz), numberp (xyz)];
 203 [true, false];
 204
 205 [symbolp (0xyz), numberp (0xyz)];
 206 [false, true];
 207
 208 0xyz;
 209 ''(33.*36.^2 + 34.*36. + 35.);
 210
 211 0XYZ;
 212 0xyz;
 213
 214 [symbolp (\0xyz), numberp (\0xyz)];
 215 [true, false];
 216
 217 [is (xyz = 0xyz), is (0xyz = \0xyz), is (\0xyz = xyz)];
 218 [false, false, false];
 219
 220 0xyz;
 221 ''(33.*36.^2 + 34.*36. + 35.);
 222
 223 1xyz;
 224 ''(36.^3 + 0xyz);
 225
 226 xyz + 0xyz + \0xyz + xyz + 0xyz + \0xyz + xyz + 0xyz + \0xyz;
 227 3*xyz + 3*\0xyz + ''(3*(33.*36.^2 + 34.*36. + 35.));
 228
 229 [10.25, 10.25d0, 10.25e0, 10.25f0, 10.25s0] - 0a - 1/4;
 230 ''(float ([0, 0, 0, 0, 0]));
 231
 232 [99.25, 99.25d0, 99.25e0, 99.25f0, 99.25s0] - 02r - 1/4;
 233 ''(float ([0, 0, 0, 0, 0]));
 234
 235 aa . bb;
 236 "." (\aa, \bb);
 237
 238 aa.bb;
 239 "." (\aa, \bb);
 240
 241 ibase : 10.;
 242 ''(1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1);
 243
 244 obase : 2;
 245 2.;
 246
 247 string (255);
 248 "11111111";
 249
 250 string (-255);
 251 "-11111111";
 252
 253 string (256);
 254 "100000000";
 255
 256 obase : 8;
 257 8.;
 258
 259 string (255);
 260 "377";
 261
 262 string (-255);
 263 "-377";
 264
 265 string (256);
 266 "400";
 267
 268 obase : 16;
 269 16.;
 270
 271 (string (255), is (%% = "0FF" or %% = "0ff"));
 272 true;
 273
 274 (string (-255), is (%% = "-0FF" or %% = "-0ff"));
 275 true;
 276
 277 string (256);
 278 "100";
 279
 280 (string (10 * 16^3), is (%% = "0A000" or %% = "0a000"));
 281 true;
 282
 283 (string (10*16^3 + 11*16^2 + 12*16 + 13), is (%% = "0ABCD" or %% = "0abcd"));
 284 true;
 285
 286 obase : 36;
 287 36.;
 288
 289 string (8*36^3 + 8*36^2 + 8*36 + 8);
 290 "8888";
 291
 292 (string (8*36^3 + 9*36^2 + 10*36 + 11), is (%% = "89AB" or %% = "89ab"));
 293 true;
 294
 295 (string (35*36^3 + 35*36^2 + 35*36 + 35), is (%% = "0ZZZZ" or %% = "0zzzz"));
 296 true;
 297
 298 (string (-(35*36^3 + 35*36^2 + 35*36 + 35)), is (%% = "-0ZZZZ" or %% = "-0zzzz"));
 299 true;
 300
 301 (string (34*36^3 + 35*36^2 + 8*36 + 7), is (%% = "0YZ87" or %% = "0yz87"));
 302 true;
 303
 304 [ibase, obase] : [10., 10.];
 305 [10., 10.];
 306
 307 10;
 308 ''(1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1);
 309
 310 string (10);
 311 "10";
 312
 313 ibase : 2.;
 314 2.;
 315
 316 [1, 11, 111, 1111];
 317 [1., 3., 7., 15.];
 318
 319 (load (file_search (test_readbase_lisp, file_search_tests)),
 320  test_readbase_lisp ());
 321 [1., 2., 3., 4., 10., 20., 30., 40.];
 322
 323 [1, 11, 111, 1111];
 324 [1., 3., 7., 15.];
 325
 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.];
 329
 330 [1, 11, 111, 1111];
 331 [1., 3., 7., 15.];
 332
 333 (load (file_search (test_readbase_maxima, file_search_tests)),
 334  test_readbase_maxima ());
 335 [4., 3., 2., 1., 40., 30., 20., 10.];
 336
 337 [1, 11, 111, 1111];
 338 [1., 3., 7., 15.];
 339
 340 (batch (file_search (test_readbase_maxima, file_search_tests)),
 341  test_readbase_maxima ());
 342 [4., 3., 2., 1., 40., 30., 20., 10.];
 343
 344 [1, 11, 111, 1111];
 345 [1., 3., 7., 15.];
 346
 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.];
 350
 351 [1, 11, 111, 1111];
 352 [1., 3., 7., 15.];
 353
 354 ibase : 10.;
 355 10.;
 356
 357 /* SF bug report # 2992398 "sort doesn't give error for invalid comparison"
 358  */
 359
 360 errcatch (sort([c, a, b], "<"));
 361 [];
 362
 363 errcatch (sort([1, 2, 3], lambda([a, b], 'sdf)));
 364 [];
 365
 366 sort ([c, a, b]);
 367 [a, b, c];
 368
 369 sort ([1, 2, 3], "<");
 370 [1, 2, 3];
 371
 372 sort ([1, 2, 3], lambda ([a, b], sin(a) < sin(b)));
 373 [3, 1, 2];
 374
 375 /* some tests for todd_coxeter; dunno where else to put them
 376  * adapted from comments in src/todd-coxeter.lisp
 377  */
 378
 379 /* this one seems to run indefinitely or at least a very long time */
 380 /*
 381 todd_coxeter([x^^3,y.x.y^^-1 . x^^-1],[]);
 382 6;
 383  */
 384
 385 todd_coxeter([a^^8,b^^7,a.b.a.b,(a^^-1 . b)^^3],[a^^2, a^^-1 . b]);
 386 448;
 387
 388 (kill (p, symet),
 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),
 392  0);
 393 0;
 394
 395 /* comment says todd_coxeter(symet(n)) == n! */
 396
 397 todd_coxeter (symet (1));
 398 1;
 399
 400 todd_coxeter (symet (2));
 401 2;
 402
 403 todd_coxeter (symet (3));
 404 6;
 405
 406 todd_coxeter (symet (4));
 407 24;
 408
 409 todd_coxeter (symet (5));
 410 120;
 411
 412 /* SF bug #2695: 'kill' kills built-in properties of operator after user-defined property */
 413
 414 (kill (a, b), string (a*b));
 415 "a*b";
 416
 417 (put ("*", 'bar, 'foo), kill (all), string (a*b));
 418 "a*b";
 419
 420 /* SF bug #3387: kill(all) looses mtime's "nary" property
 421  * (tickled by the preceding test)
 422  */
 423
 424 xreduce ("*", []);
 425 1;
 426
 427 (put ("+", 'baz, 'quux), kill (all));
 428 done;
 429
 430 xreduce ("+", []);
 431 0;
 432
 433 /* reported to mailing list 2015-01-05: "order of operands is changed due to source information" */
 434
 435 block([simp:false], ?cons(?list('?mplus),?cdr([1,5,3])), string(%%));
 436 "1+5+3";
 437
 438 block([simp:false], ?cons(?list('?mplus,'?foo, '?bar),?cdr([1,5,3])), string(%%));
 439 "1+5+3";
 440
 441 /* SF bug #3012: "orderlessp/ordergreatp confusing treatment of upper/lower case in symbol names" */
 442
 443 orderlessp ("A1", "B1");
 444 true;
 445
 446 orderlessp ("A1", "Ba");
 447 true;
 448
 449 orderlessp ("Aa", "B1");
 450 true;
 451
 452 orderlessp ("Aa", "Ba");
 453 true;
 454
 455 kill (A1, B1, Aa, Ba);
 456 done;
 457
 458 orderlessp (A1, B1);
 459 true;
 460
 461 orderlessp (A1, Ba);
 462 true;
 463
 464 orderlessp (Aa, B1);
 465 true;
 466
 467 orderlessp (Aa, Ba);
 468 true;
 469
 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"];
 475
 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);
 478 done;
 479
 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,
 484 v, x1, x10, x8];
 485
 486 /* SF bug #365: "orderlessp not transitive" */
 487
 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);
 489 0;
 490
 491 orderlessp(l[1],l[2]);
 492 true;
 493
 494 orderlessp(l[2],l[3]);
 495 true;
 496
 497 orderlessp(l[1],l[3]);
 498 true;
 499
 500 (q: x^2, r: (x+1)^2, s: x*(x+2), 0);
 501 0;
 502
 503 orderlessp(s,q);
 504 true;
 505
 506 orderlessp(q,r);
 507 true;
 508
 509 orderlessp(r,s);
 510 false;
 511
 512 orderlessp(s, r);
 513 true;
 514
 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),
 517  (x+1)^2+x^2+x*(x+2),
 518  (x+1)^2+x^2+x*(x+2),
 519  (x+1)^2+x^2+x*(x+2),
 520  (x+1)^2+x^2+x*(x+2),
 521  (x+1)^2+x^2+x*(x+2)];
 522
 523 (q+s+r)-(q+s+r);
 524 0;
 525
 526 (q+s+r)-(s+q+r);
 527 0;
 528
 529 (q+r+s)-(q+s+r);
 530 0;
 531
 532 foo : q+r+s;
 533 (x+1)^2+x^2+x*(x+2);
 534
 535 expand(foo,0,0);
 536 (x+1)^2+x^2+x*(x+2);
 537
 538 expand(foo,0,0);
 539 (x+1)^2+x^2+x*(x+2);
 540
 541 q+r+s-r-q-s;
 542 0;
 543
 544 orderlessp(t/2,t);
 545 true;
 546
 547 orderlessp(t,t+1/4);
 548 true;
 549
 550 orderlessp(t/2,t+1/4);
 551 true;
 552
 553 orderlessp((x+1)^2,x^2-1);
 554 false;
 555
 556 orderlessp(x^2-1,x^2);
 557 true;
 558
 559 orderlessp((x+1)^2,x^2);
 560 false;
 561
 562 /* additional tests related to #365, from mailing list 2016-01-14:
 563  * "Simplifier can't decide and enters a cycle (minimalistic example)"
 564  */
 565
 566 (kill(a, b, c, A, x, w), a:x, b:A(x - 1), c:A(w*(x - 1)), 0);
 567 0;
 568
 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),
 572  0);
 573 0;
 574
 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));
 577 true;
 578
 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));
 581 true;
 582
 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]));
 585 true;
 586
 587 /* other examples -- let a = x + 1 or a = x - 1 instead of a = x. */
 588
 589 (a : x + 1, 0);
 590 0;
 591
 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));
 594 true;
 595
 596 (a : x - 1, 0);
 597 0;
 598
 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));
 601 true;
 602
 603 /* additional examples from mailing list 2016-01-28 tnx Stavros Macrakis */
 604
 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)))))),
 622        %%));
 623 [true, true, true, true, true, true, true, true, true, true, true, true, true, true, true];
 624
 625 /* totalorderp from mailing list 2016-07-18 "Testing for total order (for orderlessp testing)" tnx Stavros */
 626
 627 (totalorderp(func,domain) :=
 628    block([ord,i,j,res:[]],
 629       ord: sort(domain, func),
 630       i:0,
 631       for eli in ord do
 632         (i:i+1,
 633          j:0,
 634          for elj in ord do
 635           (j:j+1,
 636            if (func(eli,elj) # is(i<j)) and not(eli=elj)
 637            then push([i,j,eli,elj],res))),
 638               res),
 639  0);
 640 0;
 641
 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]));
 645 [];
 646
 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]));
 649 [];
 650
 651 kill (K);
 652 done;
 653
 654 /* ensure that GREAT returns only T or NIL, not an integer, when its arguments are strings. */
 655
 656 ?great ("foo", "bar");
 657 true;
 658
 659 ?great ("bar", "foo");
 660 false;
 661
 662 /* check return values for float_approx_equal */
 663
 664 (load (floatproperties),
 665  xx: [largest_negative_float, least_negative_normalized_float, least_negative_float,
 666       0.0, 1.0, least_positive_float, least_positive_normalized_float, largest_float],
 667  xx : unique (xx),
 668  if errcatch (x: 1.0/0.0) # [] then push (x, xx),
 669  if errcatch (x: -1.0/0.0) # [] then push (x, xx),
 670  if errcatch (x: 0.0/0.0) # [] then push (x, xx),
 671  genmatrix (lambda ([i, j], errcatch (float_approx_equal (xx[i], xx[j])), if %% = [] then %% else %%[1]),
 672             length (xx), length (xx)));
 673 ''(genmatrix (lambda ([i, j], if i = j then true else false), length (xx), length (xx)));
 674
 675 (kill (foo, bar),
 676  foo: 1.0,
 677  bar: foo - float_eps (),
 678  float_approx_equal_tolerance: float_eps (),
 679  floatnump (bar));
 680 true;
 681
 682 block ([foo100: 1e-100*foo, bar100: 1e-100*bar],
 683         [is (foo100 = bar100), float_approx_equal (foo100, bar100)]);
 684 [false, true];
 685
 686 block ([foo10: 1e-10*foo, bar10: 1e-10*bar],
 687         [is (foo10 = bar10), float_approx_equal (foo10, bar10)]);
 688 [false, true];
 689
 690 [is (foo = bar), float_approx_equal (foo, bar)];
 691 [false, true];
 692
 693 block ([foo10: 1e10*foo, bar10: 1e10*bar],
 694         [is (foo10 = bar10), float_approx_equal (foo10, bar10)]);
 695 [false, true];
 696
 697 block ([foo100: 1e100*foo, bar100: 1e100*bar],
 698         [is (foo100 = bar100), float_approx_equal (foo100, bar100)]);
 699 [false, true];
 700
 701 /* errcatch failed to catch some types of errors.  It caught the usual Maxima
 702  * and lisp errors, but it failed to catch some errors that would just throw
 703  * elsewhere.
 704  */
 705
 706 errcatch (gf_set_data ("wtf"));
 707 [];
 708
 709 block ([?errorsw : true], errcatch (log (0)));
 710 [];
 711
 712 /* Try to verify that autoloading a Maxima function doesn't interfere with VARLIST.
 713  * The one known example is this integral, which gives different results depending on
 714  * whether trigsimp is loaded already or not.
 715  *
 716  * At present (2022-09-05), Maxima returns an incorrect result for this integral.
 717  * At this point, verify only that the result is consistent.
 718  *
 719  * Probably a more contrived example would be better here -- if ever the integral
 720  * is changed so it doesn't call trigsimp, this test won't verify autoloading behavior.
 721  */
 722
 723 (kill (x, functions),
 724  ii: 'integrate(sin(x)*atan2(sin(x), cos(x)), x, -%pi, %pi),
 725  0);
 726 0;
 727
 728 (result1: ev (ii, nouns),
 729  /* remember result but don't test it -- at present (2022-09-05) it is incorrect */
 730  0);
 731 0;
 732
 733 (result2: ev (ii, nouns),
 734  is (result2 = result1));
 735 true;
 736
 737 (kill (functions), /* make it necessary to reload trigsimp */
 738  result3: ev (ii, nouns),
 739  is (result3 = result2));
 740 true;
 741
 742 /* SF bug #4035: "Invisible characters should work better" */
 743
 744 /* from the bug report */
 745
 746 /* string in this next example has U+200B (ZERO WIDTH SPACE) before "23" */
 747 errcatch (parse_string ("ex: 23;"));
 748 [ex: 23];
 749
 750 /* other examples */
 751
 752 ibase: 16.;
 753 16.;
 754
 755 /* these are the codes for the space characters mentioned in src/nparse.lisp */
 756 (space_chars: map (unicode, [ 00A0, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 200A, 200B, 202F, 205F ]),
 757  ibase: 10.);
 758 10.;
 759
 760 (nn: makelist (100 + i, i, 1, length (space_chars)),
 761  apply (sconcat, flatten (append (["[", 100], map (lambda ([s, n], [",", s, n]), space_chars, nn), ["];"]))),
 762  parse_string (%%));
 763 ''(cons (100, nn));