1 /*
2 * $Id: testp.i,v 1.2 2010-07-03 19:42:31 dhmunro Exp $
3 * Test of Yorick parser
4 */
5 /* Copyright (c) 2005, The Regents of the University of California.
6 * All rights reserved.
7 * This file is part of yorick (http://yorick.sourceforge.net).
8 * Read the accompanying LICENSE file for details.
9 */
10
11 goofs= 0; /* cumulative tally of errors detected */
12 write, "Begin Yorick parser test...";
13 if (do_stats) "A "+print(yorick_stats());
14
15 /* ------------------------------------------------------------------------- */
16
17 /* First function is pure parser test, exercising many yucky language
18 features, but not producing any usable procedure. Check disassembled
19 function to be sure code is correct. */
20 func parser_test(pos1, pos2, pos3, .., key1=, key2=, key3=)
21 {
22 pos1= '\0';
23 pos2= 1s;
24 pos3= 2n;
25 loc1= 3L;
26 loc2= 4.0e0F;
27 loc3= 5.0;
28 loc4= 6.0i;
29 loc5= "A string with ' and /* inside.";
30
31
32 /* Blank lines, then a short comment with imbedded " character */
33
34 /* A multiline comment with blank lines and various types of
35 quote characters,
36
37 such as " and ',
38
39
40 all of which should be completely ignored... */
41
42 #if 0
43 Try commenting something out with #if 0/#endif sequence
44 # if 0
45 These should nest properly...
46 # endif
47 ...So this line should still be commented out.
48 #endif
49 # if 0
50 Be sure indented style works.
51 # endif
52
53 // Comment out something with C++-style comment
54 // ... and another comment
55 /*
56 // Nested comment test
57 terrible syntax error
58 */
59 // first commented out line; /* nested normal comment */
60 // second bad line;
61 // third bad line;
62 // fourth bad line; /* final nested comment
63
64 key1= pos3; // C++ comment
65 /* initial comment */ key2 /* imbedded comment */ = 0 /* repeated
66 constant */ + 6.; /* followed by a second repeated constant */
67
68 key3= ext1; /* first example of an external variable // nest test */
69
70 local loc6; local loc7, loc8, loc9; // C++ style comment /* nesting */
71 extern ext2, ext3; extern ext4;
72
73 ext2= -1; /* negative of existing constant */
74 loc6= - /* nasty imbedded
75 comment */ 7.0;
76
77 ext3= "multiline string also tests escape sequences: \
78 \\n\n, \\t\t, \\a\a, \\f\f, \\r\r, \\v\v, \\b\b, \', \"\n\
79 \?, \q, C-a\1, C-b\02, C-c\003, C-d\0041 (should C-d1), C-z\x1A,\
80 DEL\x7f"; /* Note: \? and \q should just give ? and q */
81
82 loc7= ext4+1;
83 loc8= ext5(); /* should push nil argument */
84 ext5(pos1);
85 ext5(pos1, key1, loc1);
86 ext5(pos1, key1, .., loc1);
87 ext5;
88 ext5, pos1;
89 ext5, pos1, key1, loc1, ext1, /* final argument nil */;
90
91 /* Try lines with implicit semi-colon terminators: */
92 loc7(3:, 6*loc1+loc2, ::loc2+loc3)=
93 5
94 loc8= loc7 + 7*
95 loc6(3,
96 )
97
98 if (loc1) ext5
99 else ext5, 1
100
101 if (loc1) ext5
102 ext5, 1
103
104 /* Try several popular styles */
105 if (loc1) {
106 ext3;
107 } else if (!loc2) {
108 ext3, 1;
109 } else if (loc3) {
110 ext3, 1;
111 ext3, 2;
112 } else {
113 ext3, 3;
114 }
115
116 if (loc1)
117 {
118 ext4;
119 }
120 else if (loc2)
121 {
122 ext4, 1;
123 }
124 else if (!loc3)
125 {
126 ext4, 1;
127 ext4, 2;
128 }
129 else
130 {
131 ext4, 3;
132 }
133
134 if (!loc1) ext5;
135 else if (loc2) ext5, 1;
136 else if (loc3) { ext5, 1; ext5, 2; }
137 else ext5, 3;
138
139 while (loc1--) {
140 ext6;
141 ext6, 2;
142 }; /* check that extraneous trailing semi-colon is OK */
143
144 backward:
145 do {
146 ext6;
147 if (ext1) break;
148 if (ext2) continue;
149 ext6, 2;
150 } while (--loc1);
151
152 if (ext6) goto forward;
153 if (ext3) goto backward;
154
155 for (loc1=0 ; loc1<8 ; loc1++) {
156 ext5;
157 ext5, 2;
158 }
159
160 forward:
161 for (loc1=0, loc2=loc3=0 ;
162 loc1<8 ;
163 loc1++, loc2+=2, loc3+=3) {
164 if (ext4>=9) continue;
165 ext5;
166 do {
167 ext6;
168 if (ext1!=3) break;
169 for (loc1=0 ; loc1<8 ; loc1++) {
170 ext5;
171 if (ext3<=2) break;
172 if (ext4==7) continue;
173 if (!ext1) goto inloop;
174 ext5, 2;
175 }
176 if (ext2) continue;
177 ext6, 2;
178 } while (--loc1);
179 if (ext3>3) break;
180 ext5, 2;
181 inloop:
182 }
183
184 if (loc1 || loc2 && loc3) goto backward;
185
186 return 3*loc1(3:12:3, ptp, avg:9:21)? 3+ext1 : 2-ext2;
187 }
188
189 if (do_stats) "B "+print(yorick_stats());
190
191 #if 0
192 Here is the correct disassemble output for parser_test:
193 func parser_test(pos1,pos2,pos3,..,key1=,key2=,key3=)
194 17 sp->1 PushChar(0x00)
195 19 sp0>1 Define(pos1)
196 21 sp->0 DropTop
197 22 sp+>1 PushShort(1)
198 24 sp0>1 Define(pos2)
199 26 sp->0 DropTop
200 27 sp+>1 PushInt(2)
201 29 sp0>1 Define(pos3)
202 31 sp->0 DropTop
203 32 sp+>1 PushLong(3)
204 34 sp0>1 Define(loc1)
205 36 sp->0 DropTop
206 37 sp+>1 PushFloat(4)
207 39 sp0>1 Define(loc2)
208 41 sp->0 DropTop
209 42 sp+>1 PushDouble(5)
210 44 sp0>1 Define(loc3)
211 46 sp->0 DropTop
212 47 sp+>1 PushImaginary(6i)
213 49 sp0>1 Define(loc4)
214 51 sp->0 DropTop
215 52 sp+>1 PushString("A string with ' and /* i"...)
216 54 sp0>1 Define(loc5)
217 56 sp->0 DropTop
218 57 sp+>1 PushVariable(pos3)
219 59 sp0>1 Define(key1)
220 61 sp->0 DropTop
221 62 sp+>1 PushLong(0)
222 64 sp+>2 PushDouble(6)
223 66 sp->1 Add
224 67 sp0>1 Define(key2)
225 69 sp->0 DropTop
226 70 sp+>1 PushVariable(ext1)
227 72 sp0>1 Define(key3)
228 74 sp->0 DropTop
229 75 sp+>1 PushLong(-1)
230 77 sp0>1 Define(ext2)
231 79 sp->0 DropTop
232 80 sp+>1 PushDouble(-7)
233 82 sp0>1 Define(loc6)
234 84 sp->0 DropTop
235 85 sp+>1 PushString("multiline string also te"...)
236 87 sp0>1 Define(ext3)
237 89 sp->0 DropTop
238 90 sp+>1 PushVariable(ext4)
239 92 sp+>2 PushLong(1)
240 94 sp->1 Add
241 95 sp0>1 Define(loc7)
242 97 sp->0 DropTop
243 98 sp+>1 PushVariable(ext5)
244 100 sp+>2 PushNil
245 101 sp->1 Eval(1)
246 103 sp0>1 Define(loc8)
247 105 sp->0 DropTop
248 106 sp+>1 PushVariable(ext5)
249 108 sp+>2 PushReference(pos1)
250 110 sp->1 Eval(1)
251 112 sp0>1 Print
252 113 sp->0 DropTop
253 114 sp+>1 PushVariable(ext5)
254 116 sp+>2 PushReference(pos1)
255 118 sp+>3 PushReference(key1)
256 120 sp+>4 PushReference(loc1)
257 122 sp->1 Eval(3)
258 124 sp0>1 Print
259 125 sp->0 DropTop
260 126 sp+>1 PushVariable(ext5)
261 128 sp+>2 PushReference(pos1)
262 130 sp+>3 PushReference(key1)
263 132 sp+>4 FormRangeFlag(..)
264 134 sp+>5 PushReference(loc1)
265 136 sp->1 Eval(4)
266 138 sp0>1 Print
267 139 sp->0 DropTop
268 140 sp+>1 PushVariable(ext5)
269 142 sp0>1 Print
270 143 sp->0 DropTop
271 144 sp+>1 PushVariable(ext5)
272 146 sp+>2 PushReference(pos1)
273 148 sp->1 Eval(1)
274 150 sp->0 DropTop
275 151 sp+>1 PushVariable(ext5)
276 153 sp+>2 PushReference(pos1)
277 155 sp+>3 PushReference(key1)
278 157 sp+>4 PushReference(loc1)
279 159 sp+>5 PushReference(ext1)
280 161 sp+>6 PushNil
281 162 sp->1 Eval(5)
282 164 sp->0 DropTop
283 165 sp+>1 PushVariable(loc7)
284 167 sp+>2 PushLong(3)
285 169 sp+>3 PushNil
286 170 sp->2 FormRange(2)
287 172 sp+>3 PushLong(6)
288 174 sp+>4 PushVariable(loc1)
289 176 sp->3 Multiply
290 177 sp+>4 PushVariable(loc2)
291 179 sp->3 Add
292 180 sp+>4 PushNil
293 181 sp+>5 PushNil
294 182 sp+>6 PushVariable(loc2)
295 184 sp+>7 PushVariable(loc3)
296 186 sp->6 Add
297 187 sp->4 FormRange(3)
298 189 sp->1 Eval(3)
299 191 sp+>2 PushLong(5)
300 193 sp->1 Assign
301 194 sp->0 DropTop
302 195 sp+>1 PushVariable(loc7)
303 197 sp+>2 PushLong(7)
304 199 sp+>3 PushVariable(loc6)
305 201 sp+>4 PushLong(3)
306 203 sp+>5 PushNil
307 204 sp->3 Eval(2)
308 206 sp->2 Multiply
309 207 sp->1 Add
310 208 sp0>1 Define(loc8)
311 210 sp->0 DropTop
312 211 sp+>1 PushVariable(loc1)
313 213 sp->0 BranchFalse to pc= 221
314 215 sp+>1 PushVariable(ext5)
315 217 sp0>1 Print
316 218 sp->0 DropTop
317 219 sp0>0 Branch to pc= 228
318 221 sp+>1 PushVariable(ext5)
319 223 sp+>2 PushLong(1)
320 225 sp->1 Eval(1)
321 227 sp->0 DropTop
322 228 sp+>1 PushVariable(loc1)
323 230 sp->0 BranchFalse to pc= 236
324 232 sp+>1 PushVariable(ext5)
325 234 sp0>1 Print
326 235 sp->0 DropTop
327 236 sp+>1 PushVariable(ext5)
328 238 sp+>2 PushLong(1)
329 240 sp->1 Eval(1)
330 242 sp->0 DropTop
331 243 sp+>1 PushVariable(loc1)
332 245 sp->0 BranchFalse to pc= 253
333 247 sp+>1 PushVariable(ext3)
334 249 sp0>1 Print
335 250 sp->0 DropTop
336 251 sp0>0 Branch to pc= 293
337 253 sp+>1 PushVariable(loc2)
338 255 sp->0 BranchTrue to pc= 266
339 257 sp+>1 PushVariable(ext3)
340 259 sp+>2 PushLong(1)
341 261 sp->1 Eval(1)
342 263 sp->0 DropTop
343 264 sp0>0 Branch to pc= 293
344 266 sp+>1 PushVariable(loc3)
345 268 sp->0 BranchFalse to pc= 286
346 270 sp+>1 PushVariable(ext3)
347 272 sp+>2 PushLong(1)
348 274 sp->1 Eval(1)
349 276 sp->0 DropTop
350 277 sp+>1 PushVariable(ext3)
351 279 sp+>2 PushLong(2)
352 281 sp->1 Eval(1)
353 283 sp->0 DropTop
354 284 sp0>0 Branch to pc= 293
355 286 sp+>1 PushVariable(ext3)
356 288 sp+>2 PushLong(3)
357 290 sp->1 Eval(1)
358 292 sp->0 DropTop
359 293 sp+>1 PushVariable(loc1)
360 295 sp->0 BranchFalse to pc= 303
361 297 sp+>1 PushVariable(ext4)
362 299 sp0>1 Print
363 300 sp->0 DropTop
364 301 sp0>0 Branch to pc= 343
365 303 sp+>1 PushVariable(loc2)
366 305 sp->0 BranchFalse to pc= 316
367 307 sp+>1 PushVariable(ext4)
368 309 sp+>2 PushLong(1)
369 311 sp->1 Eval(1)
370 313 sp->0 DropTop
371 314 sp0>0 Branch to pc= 343
372 316 sp+>1 PushVariable(loc3)
373 318 sp->0 BranchTrue to pc= 336
374 320 sp+>1 PushVariable(ext4)
375 322 sp+>2 PushLong(1)
376 324 sp->1 Eval(1)
377 326 sp->0 DropTop
378 327 sp+>1 PushVariable(ext4)
379 329 sp+>2 PushLong(2)
380 331 sp->1 Eval(1)
381 333 sp->0 DropTop
382 334 sp0>0 Branch to pc= 343
383 336 sp+>1 PushVariable(ext4)
384 338 sp+>2 PushLong(3)
385 340 sp->1 Eval(1)
386 342 sp->0 DropTop
387 343 sp+>1 PushVariable(loc1)
388 345 sp->0 BranchTrue to pc= 353
389 347 sp+>1 PushVariable(ext5)
390 349 sp0>1 Print
391 350 sp->0 DropTop
392 351 sp0>0 Branch to pc= 393
393 353 sp+>1 PushVariable(loc2)
394 355 sp->0 BranchFalse to pc= 366
395 357 sp+>1 PushVariable(ext5)
396 359 sp+>2 PushLong(1)
397 361 sp->1 Eval(1)
398 363 sp->0 DropTop
399 364 sp0>0 Branch to pc= 393
400 366 sp+>1 PushVariable(loc3)
401 368 sp->0 BranchFalse to pc= 386
402 370 sp+>1 PushVariable(ext5)
403 372 sp+>2 PushLong(1)
404 374 sp->1 Eval(1)
405 376 sp->0 DropTop
406 377 sp+>1 PushVariable(ext5)
407 379 sp+>2 PushLong(2)
408 381 sp->1 Eval(1)
409 383 sp->0 DropTop
410 384 sp0>0 Branch to pc= 393
411 386 sp+>1 PushVariable(ext5)
412 388 sp+>2 PushLong(3)
413 390 sp->1 Eval(1)
414 392 sp->0 DropTop
415 393 sp+>1 PushVariable(loc1)
416 395 sp+>2 Push1
417 396 sp+>3 DupUnder
418 397 sp->2 Subtract
419 398 sp0>2 Define(loc1)
420 400 sp->1 DropTop
421 401 sp->0 BranchFalse to pc= 416
422 403 sp+>1 PushVariable(ext6)
423 405 sp0>1 Print
424 406 sp->0 DropTop
425 407 sp+>1 PushVariable(ext6)
426 409 sp+>2 PushLong(2)
427 411 sp->1 Eval(1)
428 413 sp->0 DropTop
429 414 sp0>0 Branch to pc= 393
430 416 sp+>1 PushVariable(ext6)
431 418 sp0>1 Print
432 419 sp->0 DropTop
433 420 sp+>1 PushVariable(ext1)
434 422 sp->0 BranchFalse to pc= 426
435 424 sp0>0 Branch to pc= 447
436 426 sp+>1 PushVariable(ext2)
437 428 sp->0 BranchFalse to pc= 432
438 430 sp0>0 Branch to pc= 439
439 432 sp+>1 PushVariable(ext6)
440 434 sp+>2 PushLong(2)
441 436 sp->1 Eval(1)
442 438 sp->0 DropTop
443 439 sp+>1 PushVariable(loc1)
444 441 sp+>2 Push1
445 442 sp->1 Subtract
446 443 sp0>1 Define(loc1)
447 445 sp->0 BranchTrue to pc= 416
448 447 sp+>1 PushVariable(ext6)
449 449 sp->0 BranchFalse to pc= 453
450 451 sp0>0 Branch to pc= 493
451 453 sp+>1 PushVariable(ext3)
452 455 sp->0 BranchFalse to pc= 459
453 457 sp0>0 Branch to pc= 416
454 459 sp+>1 PushLong(0)
455 461 sp0>1 Define(loc1)
456 463 sp->0 DropTop
457 464 sp+>1 PushVariable(loc1)
458 466 sp+>2 PushLong(8)
459 468 sp->1 Less
460 469 sp->0 BranchFalse to pc= 493
461 471 sp+>1 PushVariable(ext5)
462 473 sp0>1 Print
463 474 sp->0 DropTop
464 475 sp+>1 PushVariable(ext5)
465 477 sp+>2 PushLong(2)
466 479 sp->1 Eval(1)
467 481 sp->0 DropTop
468 482 sp+>1 PushVariable(loc1)
469 484 sp+>2 Push1
470 485 sp+>3 DupUnder
471 486 sp->2 Add
472 487 sp0>2 Define(loc1)
473 489 sp->1 DropTop
474 490 sp->0 DropTop
475 491 sp0>0 Branch to pc= 464
476 493 sp+>1 PushLong(0)
477 495 sp0>1 Define(loc1)
478 497 sp->0 DropTop
479 498 sp+>1 PushLong(0)
480 500 sp0>1 Define(loc3)
481 502 sp0>1 Define(loc2)
482 504 sp->0 DropTop
483 505 sp+>1 PushVariable(loc1)
484 507 sp+>2 PushLong(8)
485 509 sp->1 Less
486 510 sp->0 BranchFalse to pc= 660
487 512 sp+>1 PushVariable(ext4)
488 514 sp+>2 PushLong(9)
489 516 sp->1 GreaterEQ
490 517 sp->0 BranchFalse to pc= 521
491 519 sp0>0 Branch to pc= 633
492 521 sp+>1 PushVariable(ext5)
493 523 sp0>1 Print
494 524 sp->0 DropTop
495 525 sp+>1 PushVariable(ext6)
496 527 sp0>1 Print
497 528 sp->0 DropTop
498 529 sp+>1 PushVariable(ext1)
499 531 sp+>2 PushLong(3)
500 533 sp->1 NotEqual
501 534 sp->0 BranchFalse to pc= 538
502 536 sp0>0 Branch to pc= 617
503 538 sp+>1 PushLong(0)
504 540 sp0>1 Define(loc1)
505 542 sp->0 DropTop
506 543 sp+>1 PushVariable(loc1)
507 545 sp+>2 PushLong(8)
508 547 sp->1 Less
509 548 sp->0 BranchFalse to pc= 596
510 550 sp+>1 PushVariable(ext5)
511 552 sp0>1 Print
512 553 sp->0 DropTop
513 554 sp+>1 PushVariable(ext3)
514 556 sp+>2 PushLong(2)
515 558 sp->1 LessEQ
516 559 sp->0 BranchFalse to pc= 563
517 561 sp0>0 Branch to pc= 596
518 563 sp+>1 PushVariable(ext4)
519 565 sp+>2 PushLong(7)
520 567 sp->1 Equal
521 568 sp->0 BranchFalse to pc= 572
522 570 sp0>0 Branch to pc= 585
523 572 sp+>1 PushVariable(ext1)
524 574 sp->0 BranchTrue to pc= 578
525 576 sp0>0 Branch to pc= 633
526 578 sp+>1 PushVariable(ext5)
527 580 sp+>2 PushLong(2)
528 582 sp->1 Eval(1)
529 584 sp->0 DropTop
530 585 sp+>1 PushVariable(loc1)
531 587 sp+>2 Push1
532 588 sp+>3 DupUnder
533 589 sp->2 Add
534 590 sp0>2 Define(loc1)
535 592 sp->1 DropTop
536 593 sp->0 DropTop
537 594 sp0>0 Branch to pc= 543
538 596 sp+>1 PushVariable(ext2)
539 598 sp->0 BranchFalse to pc= 602
540 600 sp0>0 Branch to pc= 609
541 602 sp+>1 PushVariable(ext6)
542 604 sp+>2 PushLong(2)
543 606 sp->1 Eval(1)
544 608 sp->0 DropTop
545 609 sp+>1 PushVariable(loc1)
546 611 sp+>2 Push1
547 612 sp->1 Subtract
548 613 sp0>1 Define(loc1)
549 615 sp->0 BranchTrue to pc= 525
550 617 sp+>1 PushVariable(ext3)
551 619 sp+>2 PushLong(3)
552 621 sp->1 Greater
553 622 sp->0 BranchFalse to pc= 626
554 624 sp0>0 Branch to pc= 660
555 626 sp+>1 PushVariable(ext5)
556 628 sp+>2 PushLong(2)
557 630 sp->1 Eval(1)
558 632 sp->0 DropTop
559 633 sp+>1 PushVariable(loc1)
560 635 sp+>2 Push1
561 636 sp+>3 DupUnder
562 637 sp->2 Add
563 638 sp0>2 Define(loc1)
564 640 sp->1 DropTop
565 641 sp->0 DropTop
566 642 sp+>1 PushVariable(loc2)
567 644 sp+>2 PushLong(2)
568 646 sp->1 Add
569 647 sp0>1 Define(loc2)
570 649 sp->0 DropTop
571 650 sp+>1 PushVariable(loc3)
572 652 sp+>2 PushLong(3)
573 654 sp->1 Add
574 655 sp0>1 Define(loc3)
575 657 sp->0 DropTop
576 658 sp0>0 Branch to pc= 505
577 660 sp+>1 PushVariable(loc1)
578 662 sp->0 BranchTrue to pc= 673
579 664 sp+>1 PushVariable(loc2)
580 666 sp->0 BranchFalse to pc= 671
581 668 sp+>1 PushVariable(loc3)
582 670 sp==0 AndOrLogical for &&
583 671 sp+>1 Push0
584 672 sp==0 AndOrLogical for ||
585 673 sp+>1 Push1
586 674 sp->0 BranchFalse to pc= 678
587 676 sp0>0 Branch to pc= 416
588 678 sp+>1 PushLong(3)
589 680 sp+>2 PushVariable(loc1)
590 682 sp+>3 PushLong(3)
591 684 sp+>4 PushLong(12)
592 686 sp+>5 PushLong(3)
593 688 sp->3 FormRange(3)
594 690 sp+>4 FormRangeFunc(ptp:)
595 692 sp+>5 PushLong(9)
596 694 sp+>6 PushLong(21)
597 696 sp->5 FormRange(2)
598 698 sp0>5 AddRangeFunc(avg:)
599 700 sp->2 Eval(3)
600 702 sp->1 Multiply
601 703 sp->0 BranchFalse to pc= 712
602 705 sp+>1 PushLong(3)
603 707 sp+>2 PushVariable(ext1)
604 709 sp->1 Add
605 710 sp0>1 Branch to pc= 717
606 712 sp+>1 PushLong(2)
607 714 sp+>2 PushVariable(ext2)
608 716 sp->1 Subtract
609 717 sp->0 Return
610 718 sp==0 Halt-Virtual-Machine
611 #endif
612
613 /* Try reinstated line */
614 junk= 1;
615 #if 1
616 junk= 0;
617 # if 0
618 junk= 2;
619 # endif
620 #endif
621 if (junk) {
622 goofs++;
623 "**FAILURE** #if / #endif construction broken";
624 }
625
626 /* ------------------------------------------------------------------------- */
627
628 f= open("../i/testp.i", "r", 1);
629 if (is_void(f)) f= open(Y_SITE+"i/testp.i", "r", 1);
630 if (f) {
631 while (!strmatch((line= rdline(f)), "Here is the correct disassemble"));
632 correct= [];
633 while (!strmatch((line= rdline(f)), "#endif")) grow, correct, line;
634 close, f;
635 if (anyof(disassemble(parser_test)!=correct)) {
636 goofs++;
637 "**FAILURE** of the parser_test disassembly";
638 " -- writing disassmbly of parser_test to pjunk.jnk";
639 f= open("pjunk.jnk", "w");
640 write, f, format="%s\n", disassemble(parser_test);
641 close, f;
642 }
643 correct= [];
644 } else {
645 "WARNING-- skipping disassembly check, i/testp.i not present";
646 }
647
648 /* check that first appearance of symbol as keyword leaves it undecided */
parser_test(x)649 func parser_test(x)
650 {
651 png, dpi=72, x;
652 dpi = 300;
653 local dpi;
654 }
parser_test(x)655 func parser_test(x)
656 {
657 png, dpi=72, x;
658 call, dpi;
659 extern dpi;
660 }
661 parser_test= [];
662
663 /* Check for limitation on yacc-parser stack depth.
664 If this fails with a SYNTAX error like "yacc stack overflow", see
665 top of yorick.y source-- your yacc may have a switch to fix it. */
666 { if (1) x= [1, 2];
667 else if (1) x= [1, 2]; else if (1) x= [1, 2]; else if (1) x= [1, 2];
668 else if (1) x= [1, 2]; else if (1) x= [1, 2]; else if (1) x= [1, 2];
669 else if (1) x= [1, 2]; else if (1) x= [1, 2]; else if (1) x= [1, 2];
670 else if (1) x= [1, 2]; else if (1) x= [1, 2]; else if (1) x= [1, 2];
671 else if (1) x= [1, 2]; else if (1) x= [1, 2]; else if (1) x= [1, 2];
672 else if (1) x= [1, 2]; else if (1) x= [1, 2]; else if (1) x= [1, 2];
673 else if (1) x= [1, 2]; else if (1) x= [1, 2]; else if (1) x= [1, 2];
674 else if (1) x= [1, 2]; else if (1) x= [1, 2]; else if (1) x= [1, 2];
675 else if (1) x= [1, 2]; else if (1) x= [1, 2]; else if (1) x= [1, 2];
676 else if (1) x= [1, 2]; else if (1) x= [1, 2]; else if (1) x= [1, 2];
677 else if (1) x= [1, 2]; else if (1) x= [1, 2]; else if (1) x= [1, 2];
678 else if (1) x= [1, 2]; else if (1) x= [1, 2]; else if (1) x= [1, 2];
679 else if (1) x= [1, 2]; else if (1) x= [1, 2]; else if (1) x= [1, 2];
680 else if (1) x= [1, 2]; else if (1) x= [1, 2]; else if (1) x= [1, 2];
681 else x= [1,2]; }
682
683 x= [];
684
685 /* If following lines give syntax errors, something is wrong with
686 the NumberValue routine in Yorick/yorick.c */
687 if (abs(100000000000000000000.0-1.e20)>1.e11)
688 write, "**WARNING** problem with numeric conversions";
689 if (0xffffffff != ((0xffff<<16)|0xffff))
690 write, "**WARNING** problem with strtoul?";
691
692 /* test basic flow control statements */
693 i= 0;
694 do { i++; } while (i<20);
695 if (i!=20)
696 error, "***PARSER BUG*** try recompiling Yorick/parse.c unoptimized";
697 for (i=0 ; i<20 ; ++i);
698 if (i!=20)
699 error, "***PARSER BUG*** try recompiling Yorick/parse.c unoptimized";
700 i= 0;
701 while (i<20) ++i;
702 if (i!=20)
703 error, "***PARSER BUG*** try recompiling Yorick/parse.c unoptimized";
704 i= j= 0;
705 do { i++; if (i>15) break; else if (i>5) continue; j++; } while (i<20);
706 if (i!=16 || j!=5)
707 error, "***PARSER BUG*** try recompiling Yorick/parse.c unoptimized";
708 for (i=j=0 ; i<20 ; ++i) { if (i>15) break; if (i>10) continue; ++j; }
709 if (i!=16 || j!=11)
710 error, "***PARSER BUG*** try recompiling Yorick/parse.c unoptimized";
711 i= j= 0;
712 while (i<20) { ++i; if (i>15) break; if (i>10) continue; ++j; }
713 if (i!=16 || j!=10)
714 error, "***PARSER BUG*** try recompiling Yorick/parse.c unoptimized";
715
716 if (do_stats) "C "+print(yorick_stats());
717
718 /* ------------------------------------------------------------------------- */
719
720 write, "Test 17x10x10 binary operators...";
721
722 /* Test all binary operations. There are 10 data types and
723 17 operators, so the complete test involves 1700 function calls... */
724 iS= 1n; lS= 1; dS= 1.0
725 cA= ['\1', '\2']; sA= [1s, 2s]; iA= [1n, 2n]; lA= [1, 2];
726 fA= [1.0f, 2.0f]; dA= [1., 2.]; zA= [1+0i, 2+0i];
727
op_test(SS,AS,SA,AA,op_name)728 func op_test(SS, AS, SA, AA, op_name) /* SS, .. AA are correct answers */
729 {
730 extern op; /* the function to be tested */
731 goof= array(1, 10, 10); /* array to hold any mistakes */
732
733 except_complex= only_integer= goof;
734 except_complex(10,)= except_complex(,10)= 0;
735 only_integer(3,)= only_integer(,3)= 0;
736 only_integer(8:,)= 0; only_integer(,8:)= 0;
737
738 answer= SS;
739 op,iS,iS,1,1; op,lS,iS,2,1; op,dS,iS,3,1;
740 op,iS,lS,1,2; op,lS,lS,2,2; op,dS,lS,3,2;
741 op,iS,dS,1,3; op,lS,dS,2,3; op,dS,dS,3,3;
742
743 answer= AS;
744 op,cA,iS,4,1; op,sA,iS,5,1; op,iA,iS,6,1; op,lA,iS,7,1;
745 op,fA,iS,8,1; op,dA,iS,9,1; op,zA,iS,10,1;
746 op,cA,lS,4,2; op,sA,lS,5,2; op,iA,lS,6,2; op,lA,lS,7,2;
747 op,fA,lS,8,2; op,dA,lS,9,2; op,zA,lS,10,2;
748 op,cA,dS,4,3; op,sA,dS,5,3; op,iA,dS,6,3; op,lA,dS,7,3;
749 op,fA,dS,8,3; op,dA,dS,9,3; op,zA,dS,10,3;
750
751 answer= SA;
752 op,iS,cA,1,4; op,iS,sA,1,5; op,iS,iA,1,6; op,iS,lA,1,7;
753 op,iS,fA,1,8; op,iS,dA,1,9; op,iS,zA,1,10;
754 op,lS,cA,2,4; op,lS,sA,2,5; op,lS,iA,2,6; op,lS,lA,2,7;
755 op,lS,fA,2,8; op,lS,dA,2,9; op,lS,zA,2,10;
756 op,dS,cA,3,4; op,dS,sA,3,5; op,dS,iA,3,6; op,dS,lA,3,7;
757 op,dS,fA,3,8; op,dS,dA,3,9; op,dS,zA,3,10;
758
759 answer= AA;
760 op,cA,cA,4,4; op,cA,sA,4,5; op,cA,iA,4,6; op,cA,lA,4,7;
761 op,cA,fA,4,8; op,cA,dA,4,9; op,cA,zA,4,10;
762 op,sA,cA,5,4; op,sA,sA,5,5; op,sA,iA,5,6; op,sA,lA,5,7;
763 op,sA,fA,5,8; op,sA,dA,5,9; op,sA,zA,5,10;
764 op,iA,cA,6,4; op,iA,sA,6,5; op,iA,iA,6,6; op,iA,lA,6,7;
765 op,iA,fA,6,8; op,iA,dA,6,9; op,iA,zA,6,10;
766 op,lA,cA,7,4; op,lA,sA,7,5; op,lA,iA,7,6; op,lA,lA,7,7;
767 op,lA,fA,7,8; op,lA,dA,7,9; op,lA,zA,7,10;
768 op,fA,cA,8,4; op,fA,sA,8,5; op,fA,iA,8,6; op,fA,lA,8,7;
769 op,fA,fA,8,8; op,fA,dA,8,9; op,fA,zA,8,10;
770 op,dA,cA,9,4; op,dA,sA,9,5; op,dA,iA,9,6; op,dA,lA,9,7;
771 op,dA,fA,9,8; op,dA,dA,9,9; op,dA,zA,9,10;
772 op,zA,cA,10,4; op,zA,sA,10,5; op,zA,iA,10,6; op,zA,lA,10,7;
773 op,zA,fA,10,8; op,zA,dA,10,9; op,zA,zA,10,10;
774
775 if (anyof(goof)) {
776 goofs++;
777 "**FAILURE** of the following operations "+op_name+":";
778 where2(goof);
779 }
780 }
781
782 if (do_stats) "D "+print(yorick_stats());
783
op(l,r,il,ir)784 func op(l, r, il, ir)
785 { goof(il, ir)= anyof((l + r)!=answer); }
786 op_test, 2, [2, 3], [2, 3], [2, 4], "+";
787
op(l,r,il,ir)788 func op(l, r, il, ir)
789 { goof(il, ir)= anyof((l - r)!=answer); }
790 op_test, 0, [0, 1], [0, -1], [0, 0], "-";
791
op(l,r,il,ir)792 func op(l, r, il, ir)
793 { goof(il, ir)= anyof((l * r)!=answer); }
794 op_test, 1, [1, 2], [1, 2], [1, 4], "*";
795
op(l,r,il,ir)796 func op(l, r, il, ir)
797 {
798 if (structof(l+r)!=structof(l+r+0.0f))
799 goof(il, ir)= anyof((l / r)!=structof(l+r)(answer));
800 else /* otherwise fails on Crays because division is inexact */
801 goof(il, ir)= anyof(abs((l / r) - answer) > 1.e-6);
802 }
803 op_test, 1, [1, 2], [1, 0.5], [1, 1], "/";
804
op(l,r,il,ir)805 func op(l, r, il, ir)
806 {
807 if (structof(r)!=structof(r+0.0f))
808 goof(il, ir)= anyof((l ^ r)!=answer);
809 else /* otherwise fails on MacIntosh for unknown reason */
810 goof(il, ir)= anyof(abs((l ^ r) - answer) > 1.e-6);
811 }
812 op_test, 1, [1, 2], [1, 1], [1, 4], "^";
813
op(l,r,il,ir)814 func op(l, r, il, ir)
815 { goof(il, ir)= anyof((l == r)!=answer); }
816 op_test, 1, [1, 0], [1, 0], [1, 1], "==";
817
op(l,r,il,ir)818 func op(l, r, il, ir)
819 { goof(il, ir)= anyof((l != r)!=answer); }
820 op_test, 0, [0, 1], [0, 1], [0, 0], "!=";
821
op(l,r,il,ir)822 func op(l, r, il, ir)
823 { goof(il, ir)= except_complex(il, ir) && anyof((l % r)!=answer); }
824 op_test, 0, [0, 0], [0, 1], [0, 0], "%";
825
op(l,r,il,ir)826 func op(l, r, il, ir)
827 { goof(il, ir)= except_complex(il, ir) && anyof((l > r)!=answer); }
828 op_test, 0, [0, 1], [0, 0], [0, 0], ">";
829
op(l,r,il,ir)830 func op(l, r, il, ir)
831 { goof(il, ir)= except_complex(il, ir) && anyof((l <= r)!=answer); }
832 op_test, 1, [1, 0], [1, 1], [1, 1], "<=";
833
op(l,r,il,ir)834 func op(l, r, il, ir)
835 { goof(il, ir)= except_complex(il, ir) && anyof((l < r)!=answer); }
836 op_test, 0, [0, 0], [0, 1], [0, 0], "<";
837
op(l,r,il,ir)838 func op(l, r, il, ir)
839 { goof(il, ir)= except_complex(il, ir) && anyof((l >= r)!=answer); }
840 op_test, 1, [1, 1], [1, 0], [1, 1], ">=";
841
op(l,r,il,ir)842 func op(l, r, il, ir)
843 { goof(il, ir)= only_integer(il, ir) && anyof((l << r)!=answer); }
844 op_test, 2, [2, 4], [2, 4], [2, 8], "<<";
845
op(l,r,il,ir)846 func op(l, r, il, ir)
847 { goof(il, ir)= only_integer(il, ir) && anyof((l >> r)!=answer); }
848 op_test, 0, [0, 1], [0, 0], [0, 0], ">>";
849
op(l,r,il,ir)850 func op(l, r, il, ir)
851 { goof(il, ir)= only_integer(il, ir) && anyof((l & r)!=answer); }
852 op_test, 1, [1, 0], [1, 0], [1, 2], "&";
853
op(l,r,il,ir)854 func op(l, r, il, ir)
855 { goof(il, ir)= only_integer(il, ir) && anyof((l | r)!=answer); }
856 op_test, 1, [1, 3], [1, 3], [1, 2], "|";
857
op(l,r,il,ir)858 func op(l, r, il, ir)
859 { goof(il, ir)= only_integer(il, ir) && anyof((l ~ r)!=answer); }
860 op_test, 0, [0, 3], [0, 3], [0, 0], "~";
861
862 op= op_test= [];
863 if (do_stats) "E "+print(yorick_stats());
864
865 /* ------------------------------------------------------------------------- */
866
867 write, "Test unary operators...";
868
869 /* Test all unary operators. */
870
op_test(SS,AA,op_name)871 func op_test(SS, AA, op_name) /* SS, AA are correct answers */
872 {
873 extern op; /* the function to be tested */
874 goof= array(1, 10); /* array to hold any mistakes */
875
876 except_complex= only_integer= goof;
877 except_complex(10)= 0;
878 only_integer(3)= 0;
879 only_integer(8:)= 0;
880
881 answer= SS;
882 op,iS,1; op,lS,2; op,dS,3;
883
884 answer= AA&0xff;
885 op,cA,4;
886 answer= AA;
887 op,sA,5; op,iA,6; op,lA,7; op,fA,8; op,dA,9; op,zA,10;
888
889 if (anyof(goof)) {
890 goofs++;
891 "**FAILURE** of the following operations "+op_name+":";
892 where2(goof);
893 }
894 }
895
896 if (do_stats) "F "+print(yorick_stats());
897
op(l,il)898 func op(l, il)
899 { goof(il)= anyof((+ l)!=answer); }
900 op_test, 1, [1, 2], "+";
901
op(l,il)902 func op(l, il)
903 { goof(il)= anyof((- l)!=answer); }
904 op_test, -1, [-1, -2], "-";
905
op(l,il)906 func op(l, il)
907 { goof(il)= anyof((! (l-1))!=answer); }
908 op_test, 1, [1, 0], "!";
909
op(l,il)910 func op(l, il)
911 { goof(il)= only_integer(il) && anyof((~ l)!=answer); }
912 op_test, -2, [-2, -3], "~";
913
914 op= op_test= [];
915 if (do_stats) "G "+print(yorick_stats());
916
917 /* ------------------------------------------------------------------------- */
918
919 write, "Test array manipulation functions...";
920
921 /* Test array manipulation functions. */
922
not_near(x,y)923 func not_near(x,y)
924 {
925 return anyof(abs(x-y)>1.e-9);
926 }
927
928 x= [0,1](-,) + [0,10,20](-,-,) + [0,100,200,300](-,-,-,) +
929 [0,1000,2000,3000,4000](-,-,-,-,) +
930 [0,10000,20000,30000,40000,50000](-,-,-,-,-,);
931 if (x(1,2,3,4,5,6)!=54321 || x(1,2,1,1,3,4)!=32001) {
932 goofs++;
933 "**FAILURE** of - subscript or broadcasting";
934 }
935
936 y= [];
937 grow, y, -2;
938 if (anyof(y!=-2)) {
939 goofs++;
940 "**FAILURE** of grow test 1";
941 }
942 grow, y, [1,2,3];
943 if (anyof(y!=[-2,1,2,3])) {
944 goofs++;
945 "**FAILURE** of grow test 2";
946 }
947 grow, y, [6,5,4];
948 if (anyof(y!=[-2,1,2,3,6,5,4])) {
949 goofs++;
950 "**FAILURE** of grow test 3";
951 }
952 y= [[1,2,3],[4,5,6]];
953 grow, y, -1;
954 if (anyof(y!=[[1,2,3],[4,5,6],[-1,-1,-1]])) {
955 goofs++;
956 "**FAILURE** of grow test 4";
957 }
958 grow, y, [6,5,4];
959 if (anyof(y!=[[1,2,3],[4,5,6],[-1,-1,-1],[6,5,4]])) {
960 goofs++;
961 "**FAILURE** of grow test 5";
962 }
963
964 if (indgen(0)!=orgsof([1])(1) ||
965 anyof(indgen(5)!=[0,1,2,3,4]+indgen(0))) {
966 goofs++;
967 "**FAILURE** of indgen function";
968 }
969
970 if (not_near(span(1,4,4), [1,2,3,4]) ||
971 not_near(span(0,[2,4],3), [[0,1,2],[0,2,4]]) ||
972 not_near(span(0,[2,4],3,0), [[0,0],[1,2],[2,4]]) ||
973 not_near(spanl(1,8,4), [1,2,4,8]) ||
974 not_near(spanl(1,[4,16],3,0), [[1,1],[2,4],[4,16]])) {
975 goofs++;
976 "**FAILURE** of span or spanl function";
977 }
978
979 y= [0., 1, 2, 3, 4, 5, 6, 7, 8, 9];
980 if (digitize(3.5, y)!=5 ||
981 anyof(digitize([[-5, 8.5],[11,5],[.5,-.5]],y)!=[[1,10],[11,7],[2,1]]) ||
982 anyof(digitize([[-5, 8.5],[11,5],[.5,-.5]],y(::-1))!=
983 [[11,2],[1,5],[10,11]])) {
984 goofs++;
985 "**FAILURE** of digitize function";
986 }
987
988 if (interp(y, y, 3.5)!=3.5 ||
989 anyof(interp(y,y,[[-5, 8.5],[11,5],[.5,-.5]])!=[[0,8.5],[9,5],[.5,0]]) ||
990 anyof(interp([y,y],y,[[-5, 8.5],[11,5],[.5,-.5]])!=
991 [[[0,8.5],[9,5],[.5,0]],[[0,8.5],[9,5],[.5,0]]]) ||
992 anyof(interp(transpose([y,y]),y,[[-5, 8.5],[11,5],[.5,-.5]],0)!=
993 [[[0,0],[8.5,8.5]],[[9,9],[5,5]],[[.5,.5],[0,0]]])) {
994 goofs++;
995 "**FAILURE** of interp function";
996 }
997
998 if (not_near(integ(y, y, 3.5), 0.5*3.5^2) ||
999 not_near(integ(y,y,[[-5, 8.5],[11,5],[.5,-.5]]),
1000 0.5*[[0,8.5],[9,5],[.5,0]]^2)) {
1001 goofs++;
1002 "**FAILURE** of integ function";
1003 }
1004
1005 if (anyof(histogram([1,5,2,1,1,5,2,1,4,5])!=[4,2,0,1,3]) ||
1006 anyof(histogram([1,5,2,1,1,5,2,1,4,5],top=7)!=[4,2,0,1,3,0,0]) ||
1007 anyof(histogram([1,5,2,1,1,5,2,1,4,5],y,top=7)!=
1008 [14.,8.,0.,8.,15.,0.,0.])) {
1009 goofs++;
1010 "**FAILURE** of histogram function";
1011 }
1012
1013 if (anyof(poly([0.,1.,2.], 1,-2,1)!=[1.,0.,1.]) ||
1014 anyof(poly([0.,1.,2.], 1,[-2,-1,0],1)!=[1.,1.,5.])) {
1015 goofs++;
1016 "**FAILURE** of poly function";
1017 }
1018
1019 if (anyof(sort([5,1,7,3])!=[2,4,1,3]) ||
1020 anyof(sort([5.,1.,7.,3.])!=[2,4,1,3]) ||
1021 anyof(sort(["go", "a", "stay", "abc"])!=[2,4,1,3]) ||
1022 median([5.,1.,7.,3.])!=4 || median([5.,1.,7.,3.,-2500.])!=3 ||
1023 anyof(median([[5.,1.,7.,3.],[5.,1.,99.,3.]])!=[4,4]) ||
1024 anyof(median([[5.,5.],[-55.,1.],[7.,99.],[3.,3.]],0)!=[4,4])) {
1025 goofs++;
1026 "**FAILURE** of sort or median function";
1027 }
1028
1029 if (anyof(dimsof(x) != [6, 1,2,3,4,5,6]) ||
1030 anyof(dimsof(transpose(x)) != [6, 6,2,3,4,5,1]) ||
1031 anyof(dimsof(transpose(x,[1,2])) != [6, 2,1,3,4,5,6]) ||
1032 anyof(dimsof(transpose(x,[1,0])) != [6, 6,2,3,4,5,1]) ||
1033 anyof(dimsof(transpose(x,2)) != [6, 6,1,2,3,4,5]) ||
1034 anyof(dimsof(transpose(x,0)) != [6, 2,3,4,5,6,1]) ||
1035 anyof(dimsof(transpose(x,3)) != [6, 5,6,1,2,3,4]) ||
1036 anyof(dimsof(transpose(x,[4,6,3],[2,5])) != [6, 1,5,6,3,2,4])) {
1037 goofs++;
1038 "**FAILURE** of transpose test 1";
1039 }
1040 y= transpose(x,[4,6,3],[2,5]);
1041 if (y(1,5,6,3,2,4)!=x(1,2,3,4,5,6) || y(1,3,4,1,2,1)!=x(1,2,1,1,3,4)) {
1042 goofs++;
1043 "**FAILURE** of transpose test 2";
1044 }
1045
1046 x= y= [];
1047 if (do_stats) "H "+print(yorick_stats());
1048
1049 /* ------------------------------------------------------------------------- */
1050
1051 write, "Test struct instancing and indexing...";
1052
1053 /* Test structs. */
1054
1055 struct Stest {
1056 char a;
1057 short b;
1058 double c(4);
1059 int d(2,3), e(5);
1060 complex f(2);
1061 }
1062
1063 x= Stest(a='A', b=13, c=[2,-4,6,-8],
1064 d=[[-1,2],[-3,4],[-5,6]], e=[10,20,30,40,50], f=[1i,2-2i]);
1065 if (x.a!='A' || x.b!=13 || anyof(x.c!=[2.,-4.,6.,-8.]) ||
1066 anyof(x.d!=[[-1,2],[-3,4],[-5,6]]) || anyof(x.e!=[10,20,30,40,50]) ||
1067 anyof(x.f!=[1i,2-2i])) {
1068 goofs++;
1069 "**FAILURE** of - struct instance declaration";
1070 }
1071
1072 y= array(Stest, 2);
1073 y(..)= x;
1074 y.a(2)= 'B';
1075 y(2).b= -x.b;
1076 y.c(..,2)= x.c(::-1);
1077 y(2).d(,1:2)= transpose(x.d(,1:2));
1078 y.e(::-1,2)= x.e;
1079 y(2).f= conj(x.f);
1080
1081 if (x!=y(1) || y(2).a!='B' || y(2).b!=-13 || anyof(y(2).c!=[-8.,6.,-4.,2.]) ||
1082 anyof(y(2).d!=[[-1,-3],[2,4],[-5,6]]) ||
1083 anyof(y(2).e!=[50,40,30,20,10]) || anyof(y(2).f!=[-1i,2+2i])) {
1084 goofs++;
1085 "**FAILURE** of - struct instance array indexing";
1086 }
1087
1088 x= y= [];
1089 if (do_stats) "I "+print(yorick_stats());
1090
1091 /* ------------------------------------------------------------------------- */
1092
1093 write, "Test range functions...";
1094
1095 /* Test range functions. */
1096
1097 x= [[[3,7,5],[-4,2,-6]], [[-1,-4,-2],[0,4,8]],
1098 [[-1,-5,2],[1,0,0]], [[9,8,7],[-9,9,-6]]];
1099 y= x+0.5;
1100
1101 if (anyof(x(,-:1:2,,1)!=[[[3,7,5],[3,7,5]],[[-4,2,-6],[-4,2,-6]]])) {
1102 goofs++;
1103 "**FAILURE** of - pseudo range function (-)";
1104 }
1105
1106 if (anyof(x(,..)!=x) || anyof(x(..,:)!=x) || anyof(x(,*)!=x(,1:8)) ||
1107 anyof(x(*,)!=x(1:6,1,))) {
1108 goofs++;
1109 "**FAILURE** of - rubber range function (.. or *)";
1110 }
1111
1112 if (anyof(x(,pcen,)(,uncp,)!=x) || anyof(y(,pcen,)(,uncp,)!=y)) {
1113 goofs++;
1114 "**FAILURE** of - uncp range function";
1115 }
1116
1117 if (anyof(x(,pcen,)(,2:-1,)!=x(,zcen,)) ||
1118 anyof(x(,pcen,)(,1,)!=x(,1,)) || anyof(x(,pcen,)(,0,)!=x(,0,)) ||
1119 anyof(y(,pcen,)!=x(,pcen,)+0.5)) {
1120 goofs++;
1121 "**FAILURE** of - pcen range function";
1122 }
1123
1124 if (anyof(x(,zcen,)!=[[[-.5,4.5,-.5]],[[-.5,0,3]],
1125 [[0,-2.5,1]],[[0,8.5,.5]]]) ||
1126 anyof(y(,zcen,)!=[[[-.5,4.5,-.5]],[[-.5,0,3]],
1127 [[0,-2.5,1]],[[0,8.5,.5]]] + 0.5)) {
1128 goofs++;
1129 "**FAILURE** of - zcen range function";
1130 }
1131
1132 if (anyof(x(,dif,)!=[[[-7,-5,-11]],[[1,8,10]],[[2,5,-2]],[[-18,1,-13]]]) ||
1133 anyof(y(,dif,)!=[[[-7,-5,-11]],[[1,8,10]],[[2,5,-2]],[[-18,1,-13]]])) {
1134 goofs++;
1135 "**FAILURE** of - dif range function";
1136 }
1137
1138 if (anyof(x(,psum,)!=[[[3,7,5],[-1,9,-1]], [[-1,-4,-2],[-1,0,6]],
1139 [[-1,-5,2],[0,-5,2]], [[9,8,7],[0,17,1]]]) ||
1140 anyof(y(,psum,)!=[[[3,7,5],[-1,9,-1]], [[-1,-4,-2],[-1,0,6]],
1141 [[-1,-5,2],[0,-5,2]], [[9,8,7],[0,17,1]]] +
1142 [0.5,1.0](-,))) {
1143 goofs++;
1144 "**FAILURE** of - psum range function";
1145 }
1146
1147 if (anyof(x(,cum,)!=[[[0,0,0],[3,7,5],[-1,9,-1]],
1148 [[0,0,0],[-1,-4,-2],[-1,0,6]],
1149 [[0,0,0],[-1,-5,2],[0,-5,2]],
1150 [[0,0,0],[9,8,7],[0,17,1]]]) ||
1151 anyof(y(,cum,)!=[[[0,0,0],[3,7,5],[-1,9,-1]],
1152 [[0,0,0],[-1,-4,-2],[-1,0,6]],
1153 [[0,0,0],[-1,-5,2],[0,-5,2]],
1154 [[0,0,0],[9,8,7],[0,17,1]]] +
1155 [0.0,0.5,1.0](-,))) {
1156 goofs++;
1157 "**FAILURE** of - cum range function";
1158 }
1159
1160 if (anyof(x(zcen,dif,)!=[[[-6,-8]],[[4.5,9]],[[3.5,1.5]],[[-8.5,-6]]]) ||
1161 anyof(y(zcen,dif,)!=[[[-6,-8]],[[4.5,9]],[[3.5,1.5]],[[-8.5,-6]]])) {
1162 goofs++;
1163 "**FAILURE** of - zcen,dif multiple range function";
1164 }
1165
1166 if (anyof(x(min,,max)!=[7,0]) || anyof(y(,,max)(min,)!=[7,1]+0.5)) {
1167 goofs++;
1168 "**FAILURE** of - min or max range function";
1169 }
1170
1171 if (anyof(x(,ptp,)!=[[-7,-5,-11],[1,8,10],[2,5,-2],[-18,1,-13]]) ||
1172 anyof(y(,ptp,)!=[[-7,-5,-11],[1,8,10],[2,5,-2],[-18,1,-13]])) {
1173 goofs++;
1174 "**FAILURE** of - ptp range function";
1175 }
1176
1177 if (anyof(x(,mnx,)!=[[2, 2, 2], [1, 1, 1], [1, 1, 2], [2, 1, 2]]) ||
1178 anyof(y(,mnx,)!=[[2, 2, 2], [1, 1, 1], [1, 1, 2], [2, 1, 2]])) {
1179 goofs++;
1180 "**FAILURE** of - mnx range function";
1181 }
1182
1183 if (anyof(x(,mxx,)!=3-x(,mnx,)) ||
1184 anyof(y(,mxx,)!=3-y(,mnx,))) {
1185 goofs++;
1186 "**FAILURE** of - mxx range function";
1187 }
1188
1189 if (anyof(x(,sum,)!=x(,1,)+x(,2,)) ||
1190 anyof(y(,sum,)!=y(,1,)+y(,2,))) {
1191 goofs++;
1192 "**FAILURE** of - sum range function";
1193 }
1194
1195 if (anyof(x(,avg,)!=0.5*(x(,1,)+x(,2,))) ||
1196 anyof(y(,avg,)!=0.5*(y(,1,)+y(,2,)))) {
1197 goofs++;
1198 "**FAILURE** of - avg range function";
1199 }
1200
1201 if (anyof(abs(x(,rms,)-0.5*abs(x(,1,)-x(,2,)))>1.e-10) ||
1202 anyof(abs(y(,rms,)-0.5*abs(y(,1,)-y(,2,)))>1.e-10)) {
1203 goofs++;
1204 "**FAILURE** of - rms range function";
1205 }
1206
1207 x= [[1,2,3],[-5,5,-8]];
1208 y= [[1,1],[-1,-1],[0,1]];
1209
1210 if (anyof(x(+,)*y(,+) != [[-1,-10],[2,-18]]) ||
1211 anyof(x(,+)*y(+,) != [[-4,7,-5],[4,-7,5],[-5,5,-8]])) {
1212 goofs++;
1213 "**FAILURE** of + matrix multiply function";
1214 }
1215
1216 x+= 0i;
1217
1218 if (anyof(x(+,)*y(,+) != [[-1,-10],[2,-18]]) ||
1219 anyof(x(,+)*y(+,) != [[-4,7,-5],[4,-7,5],[-5,5,-8]])) {
1220 goofs++;
1221 "**FAILURE** of + complex matrix multiply function";
1222 }
1223
1224 /* first test matrix multiply conformability rules
1225 -- this will just blow up if there's a problem */
1226 rop= lop= array(0., 4, 3, 2);
1227 dst= lop(+,,)*rop(+,,) + array(0., 3,2,3,2);
1228 dst= lop(,+,)*rop(,+,) + array(0., 4,2,4,2);
1229 dst= lop(,,+)*rop(,,+) + array(0., 4,3,4,3);
1230 rop= transpose(rop, 2);
1231 dst= lop(+,,)*rop(,+,) + array(0., 3,2,2,3);
1232 dst= lop(,+,)*rop(,,+) + array(0., 4,2,2,4);
1233 dst= lop(,,+)*rop(+,,) + array(0., 4,3,4,3);
1234 rop= transpose(rop, 2);
1235 dst= lop(+,,)*rop(,,+) + array(0., 3,2,3,2);
1236 dst= lop(,+,)*rop(+,,) + array(0., 4,2,2,4);
1237 dst= lop(,,+)*rop(,+,) + array(0., 4,3,3,4);
1238
1239 /* next, try to exercise all the branches of the matrix
1240 multiply routines -- test all five dimensions,
1241 plus unit length leading dimension (special branch) */
1242 lop= [[[1,2],[3,4]],[[5,6],[7,8]]];
1243 rop= lop+10;
1244 dst1= lop(,+,)*rop(,+,);
1245 dst2= lop(1,+,)*rop(,+,);
1246 if (anyof(dst1!=
1247 [[[[50,74],[146,170]],[[54,80], [158,184]]],
1248 [[[66,98],[194,226]],[[70,104],[206,240]]]]) ||
1249 anyof(dst2!=
1250 [[[50,146],[54,158]],[[66,194],[70,206]]])) {
1251 goofs++;
1252 "**FAILURE** of + matrix multiply function";
1253 }
1254
1255 lop+= 0i;
1256 rop+= 0i;
1257
1258 dst1= lop(,+,)*rop(,+,);
1259 dst2= lop(1,+,)*rop(,+,);
1260 if (anyof(dst1!=
1261 [[[[50,74],[146,170]],[[54,80], [158,184]]],
1262 [[[66,98],[194,226]],[[70,104],[206,240]]]]) ||
1263 anyof(dst2!=
1264 [[[50,146],[54,158]],[[66,194],[70,206]]])) {
1265 goofs++;
1266 "**FAILURE** of + complex matrix multiply function";
1267 }
1268
1269 x= y= lop= rop= dst1= dst2= [];
1270 if (do_stats) "J "+print(yorick_stats());
1271
1272 /* ------------------------------------------------------------------------- */
1273
1274 write, "Test math functions...";
1275
1276 /* Test math functions. */
1277
1278 x= pi/4; y= [3*pi/4, pi/6];
1279
1280 if (not_near(sin(x),sqrt(0.5)) || not_near(sin(y),[sqrt(0.5),0.5]) ||
1281 not_near(cos(x),sqrt(0.5)) || not_near(cos(y),[-sqrt(0.5),sqrt(.75)]) ||
1282 not_near(tan(x),1) || not_near(tan(y),[-1,1/sqrt(3)])) {
1283 goofs++;
1284 "**FAILURE** of - sin, cos, tan, or sqrt function";
1285 }
1286
1287 if (not_near(asin(sqrt(0.5)),x) ||
1288 not_near(asin([sqrt(0.5),0.5]),y-[pi/2,0]) ||
1289 not_near(acos(sqrt(0.5)),x) || not_near(acos([-sqrt(0.5),sqrt(.75)]),y) ||
1290 not_near(atan(1),x) || not_near(atan([-1,1/sqrt(3)]),y-[pi,0])) {
1291 goofs++;
1292 "**FAILURE** of - asin, acos, atan, or sqrt function";
1293 }
1294
1295 if (not_near(atan(5,5),x) || not_near(atan([.1,1],[-.1,sqrt(3)]),y)) {
1296 goofs++;
1297 "**FAILURE** of - 2 argument atan function";
1298 }
1299
1300 if (not_near(exp(1i*x),cos(x)+1i*sin(x)) ||
1301 not_near(exp(1i*y),cos(y)+1i*sin(y)) ||
1302 not_near(cos(1i*x), 0.5*(exp(-x)+exp(x))) ||
1303 not_near(cos(1i*y), 0.5*(exp(-y)+exp(y))) ||
1304 not_near(sin(1i*x), 0.5i*(exp(x)-exp(-x))) ||
1305 not_near(sin(1i*y), 0.5i*(exp(y)-exp(-y))) ||
1306 not_near(tan(1i*x), 1i*(exp(x)-exp(-x))/(exp(-x)+exp(x))) ||
1307 not_near(tan(1i*y), 1i*(exp(y)-exp(-y))/(exp(-y)+exp(y)))) {
1308 goofs++;
1309 "**FAILURE** of - (complex) exp, sin, cos, or tan function";
1310 }
1311
1312 if (not_near(exp(1),2.718281828459) ||
1313 not_near(exp([-.5,2.5]), [1,exp(1)^3]/sqrt(exp(1))) ||
1314 not_near(exp(x),cosh(x)+sinh(x)) ||
1315 not_near(exp(y),cosh(y)+sinh(y)) ||
1316 not_near(cosh(x), 0.5*(exp(-x)+exp(x))) ||
1317 not_near(cosh(y), 0.5*(exp(-y)+exp(y))) ||
1318 not_near(sinh(x), 0.5*(exp(x)-exp(-x))) ||
1319 not_near(sinh(y), 0.5*(exp(y)-exp(-y))) ||
1320 not_near(tanh(x), (exp(x)-exp(-x))/(exp(-x)+exp(x))) ||
1321 not_near(tanh(y), (exp(y)-exp(-y))/(exp(-y)+exp(y)))) {
1322 goofs++;
1323 "**FAILURE** of - exp, sinh, cosh, or tanh function";
1324 }
1325
1326 if (not_near(sech(x), 2/(exp(-x)+exp(x))) ||
1327 not_near(sech(y), 2/(exp(-y)+exp(y))) ||
1328 not_near(csch(x), 2/(exp(x)-exp(-x))) ||
1329 not_near(csch(y), 2/(exp(y)-exp(-y))) ||
1330 anyof(sech([1.e6,-1.e6])) || anyof(csch([1.e6,-1.e6]))) {
1331 goofs++;
1332 "**FAILURE** of - sech or csch function";
1333 }
1334
1335 if (not_near(acosh(cosh(x)), x) || not_near(acosh(cosh(y)), y) ||
1336 not_near(asinh(sinh(x)), x) || not_near(asinh(sinh(y)), y) ||
1337 not_near(atanh(tanh(x)), x) || not_near(atanh(tanh(y)), y)) {
1338 goofs++;
1339 "**FAILURE** of - acosh, asinh, or atanh function";
1340 }
1341
1342 if (not_near(exp(1i*x),cosh(1i*x)+sinh(1i*x)) ||
1343 not_near(exp(1i*y),cosh(1i*y)+sinh(1i*y)) ||
1344 not_near(cosh(1i*x), 0.5*(exp(-1i*x)+exp(1i*x))) ||
1345 not_near(cosh(1i*y), 0.5*(exp(-1i*y)+exp(1i*y))) ||
1346 not_near(sinh(1i*x), 0.5*(exp(1i*x)-exp(-1i*x))) ||
1347 not_near(sinh(1i*y), 0.5*(exp(1i*y)-exp(-1i*y))) ||
1348 not_near(tanh(1i*x), (exp(1i*x)-exp(-1i*x))/(exp(-1i*x)+exp(1i*x))) ||
1349 not_near(tanh(1i*y), (exp(1i*y)-exp(-1i*y))/(exp(-1i*y)+exp(1i*y)))) {
1350 goofs++;
1351 "**FAILURE** of - (complex) exp, sinh, cosh, or tanh function";
1352 }
1353
1354 if (not_near(log(exp(x)), x) || not_near(log(exp(y)), y) ||
1355 not_near(log10(10^x), x) || not_near(log10(10^y), y) ||
1356 not_near(log10(x*y),log10(x)+log10(y)) ||
1357 not_near(log(x*y),log(x)+log(y)) ||
1358 not_near(exp(x+y),exp(x)*exp(y)) ||
1359 not_near(log10([1.e5,1.e-7]),[5,-7]) ||
1360 not_near(log(10),1/log10(exp(1))) ||
1361 not_near(log(10)*log10(x),log(x)) || not_near(log(10)*log10(y),log(y))) {
1362 goofs++;
1363 "**FAILURE** of - log, log10, or exp function";
1364 }
1365
1366 if (anyof(abs(x)!=x) || anyof(abs(-x)!=x) ||
1367 anyof(abs(y)!=y) || anyof(abs(-y)!=y)) {
1368 goofs++;
1369 "**FAILURE** of - abs function";
1370 }
1371
1372 if (anyof(ceil(3.7)!=4) || anyof(ceil([-3.7,2.1])!=[-3,3]) ||
1373 anyof(floor(3.7)!=3) || anyof(floor([-3.7,2.1])!=[-4,2])) {
1374 goofs++;
1375 "**FAILURE** of - ceil or floor function";
1376 }
1377
1378 if (not_near(abs(x,y,x,y),sqrt(2*(x^2+y^2)))) {
1379 goofs++;
1380 "**FAILURE** of - multiargument abs function";
1381 }
1382
1383 if (anyof(sign(x)!=1) || anyof(sign(-x)!=-1) ||
1384 anyof(sign(y)!=1) || anyof(sign(-y)!=-1) ||
1385 sign(0)!=1 || sign(0.0)!=1 || sign(0i)!=1 ||
1386 not_near(sign(exp(1i*y+x)),exp(1i*y))) {
1387 goofs++;
1388 "**FAILURE** of - sign function";
1389 }
1390
1391 if (conj(x+1i)!=x-1i || anyof(conj(y+1i)!=y-1i)) {
1392 goofs++;
1393 "**FAILURE** of - conj function";
1394 }
1395
1396 if (random()<0.0 || random()>1.0 ||
1397 anyof(dimsof(random(3,4,2))!=[3,3,4,2])) {
1398 goofs++;
1399 "**FAILURE** of - random function";
1400 }
1401
1402 if (min(x)!=x || min(y)!=pi/6 || anyof(min(x,y)!=[pi/4,pi/6]) ||
1403 max(x)!=x || max(y)!=3*pi/4 || anyof(max(x,y)!=[3*pi/4,pi/4])) {
1404 goofs++;
1405 "**FAILURE** of - min or max function";
1406 }
1407
1408 if (sum(x)!=x || not_near(sum(y), 11*pi/12) ||
1409 avg(x)!=x || not_near(avg(y), 11*pi/24)) {
1410 goofs++;
1411 "**FAILURE** of - sum or avg function";
1412 }
1413
1414 if (allof([1,0]) || !allof([1,1]) || anyof([0,0]) || !anyof([1,0]) ||
1415 noneof([1,0]) || !noneof([0,0]) || nallof([1,1]) || !nallof([1,0])) {
1416 goofs++;
1417 "**FAILURE** of - allof, anyof, noneof, or nallof function";
1418 }
1419
1420 if (anyof(where([[0,1,0,0],[0,0,0,1]])!=[2,8]) ||
1421 anyof(where2([[0,1,0,0],[0,0,0,1]])!=[[2,1],[4,2]])) {
1422 goofs++;
1423 "**FAILURE** of - where or where2 function";
1424 }
1425
1426 x= Stest(a='A', b=13, c=[2,-4,6,-8],
1427 d=[[-1,2],[-3,4],[-5,6]], e=[10,20,30,40,50], f=[1i,2-2i]);
1428 y= array(x, 2);
1429 y(1).b= 8; y(2).b=19;
1430 if (anyof(merge(cA,iS,[1,1,0])!=[1,2,1]) ||
1431 anyof(merge(lS,sA,[0,0,1])!=[1,2,1]) ||
1432 anyof(merge(iA,dS,[1,0,1])!=[1,1,2]) ||
1433 anyof(merge(lA,fA,[[1,1],[0,0]])!=[[1,2],[1,2]]) ||
1434 anyof(merge(zA,dA,[[1,0],[0,1]])!=[[1,1],[2,2]]) ||
1435 anyof(merge(cA,cA,[[1,0],[0,1]])!=[[1,1],[2,2]]) ||
1436 anyof(merge(sA,sA,[[1,0],[0,1]])!=[[1,1],[2,2]]) ||
1437 anyof(merge(y,x,[1,0,1])!=[y(1),x,y(2)]) ||
1438 anyof(merge(dA,[],[1,1])!=dA) ||
1439 anyof(merge([],lA,[0,0])!=lA) ||
1440 anyof(merge2(lA,zA(::-1),[1,0])!=[1,1])) {
1441 goofs++;
1442 "**FAILURE** of - merge or merge2 function";
1443 }
1444 x= y= [];
1445
1446 if (do_stats) "K "+print(yorick_stats());
1447
1448 /* ------------------------------------------------------------------------- */
1449
1450 write, "Test informational functions...";
1451
1452 /* Test informational functions. */
1453
1454 if (structof(3.5)!=double || structof('\61')!=char ||
1455 structof([4,5,6])!=long || structof([1n,-1n])!=int ||
1456 structof([3s,4s])!=short || structof(4.4f)!=float ||
1457 structof(1i)!=complex || structof(array(Stest,2,2))!=Stest ||
1458 structof([&[1,2,3],&[],&[3.5,1.2]])!=pointer || structof("yo")!=string) {
1459 goofs++;
1460 "**FAILURE** of - structof function or structure != operation";
1461 }
1462
1463 if (anyof(dimsof([[2,4,6],[1,3,5]])!=[2,3,2]) || anyof(dimsof(5)!=[0]) ||
1464 anyof(dimsof(array(short,5,-4:-1,3:5,0:1))!=[4,5,4,3,2]) ||
1465 anyof(dimsof([1,2,3](-,),[1,2])!=[2,2,3])) {
1466 goofs++;
1467 "**FAILURE** of - dimsof function";
1468 }
1469
1470 dummy= use_origins(1);
1471 if (anyof(orgsof([[2,4,6],[1,3,5]])!=[2,indgen(0),indgen(0)]) ||
1472 anyof(orgsof(array(short,5,-4:-1,3:5,0:1))!=[4,indgen(0),-4,3,0])) {
1473 goofs++;
1474 "**FAILURE** of - orgsof function";
1475 }
1476 dummy= [];
1477
1478 if (numberof([[2,4,6],[1,3,5]])!=6 || numberof(3.5)!=1 || numberof([])!=0 ||
1479 numberof(array(short,5,-4:-1,3:5,0:1))!=120) {
1480 goofs++;
1481 "**FAILURE** of - numberof function";
1482 }
1483
1484 if (sizeof([[2,4,6],[1,3,5]])!=6*sizeof(long) || sizeof(3.5)!=sizeof(double) ||
1485 sizeof(array(short,5,-4:-1,3:5,0:1))!=120*sizeof(short)) {
1486 goofs++;
1487 "**FAILURE** of - sizeof function";
1488 }
1489
1490 if (typeof(3.5)!="double" || typeof('\61')!="char" ||
1491 typeof([4,5,6])!="long" || typeof([1n,-1n])!="int" ||
1492 typeof([3s,4s])!="short" || typeof(4.4f)!="float" ||
1493 typeof(1i)!="complex" || typeof(array(Stest,2,2))!="struct_instance" ||
1494 typeof(Stest)!="struct_definition" || typeof(3:52:4)!="range" ||
1495 typeof([])!="void" || typeof()!="void" || typeof("yo")!="string" ||
1496 typeof(&[3,4])!="pointer") {
1497 goofs++;
1498 "**FAILURE** of - typeof function";
1499 }
1500
1501 if (nameof(Stest)!="Stest" || nameof(not_near)!="not_near") {
1502 goofs++;
1503 "**FAILURE** of - nameof function";
1504 }
1505
1506 if (!is_array([3,4]) || !is_array(0) || is_array() || is_array(not_near) ||
1507 is_array(Stest)) {
1508 goofs++;
1509 "**FAILURE** of - is_array function";
1510 }
1511
1512 if (is_void(7) || !is_void() || !is_void([]) || is_void(not_near)) {
1513 goofs++;
1514 "**FAILURE** of - is_void function";
1515 }
1516
1517 if (is_func(7) || is_func() || !is_func(not_near) || is_func(Stest)) {
1518 goofs++;
1519 "**FAILURE** of - is_func function";
1520 }
1521
1522 if (is_struct(7) || is_struct() || is_struct(not_near) ||
1523 !is_struct(Stest)) {
1524 goofs++;
1525 "**FAILURE** of - is_struct function";
1526 }
1527
1528 if (is_range(7) || is_range() || is_range(not_near) ||
1529 is_range(Stest) || !is_range(3:4)) {
1530 goofs++;
1531 "**FAILURE** of - is_range function";
1532 }
1533
junk(x)1534 func junk(x)
1535 {
1536 extern junk_test;
1537 return junk_test= am_subroutine();
1538 }
1539 junk_test= 0;
1540 junk;
1541 if (!junk_test || junk()) {
1542 goofs++;
1543 "**FAILURE** of - am_subroutine function";
1544 }
1545
1546 if (do_stats) "L "+print(yorick_stats());
1547
1548 /* ------------------------------------------------------------------------- */
1549
1550 write, "Test func declarations...";
1551
1552 /* Test func declarations. */
1553
1554 func junk(&w,x,&y,z,..,k=,l=,m=)
1555 {
1556 rslt= [w,x,y,z,k,l,m];
1557 while (more_args()) grow, rslt, next_arg();
1558 w=x=y=z=k=l=m=16;
1559 return rslt;
1560 }
1561 a= b= c= d= -2;
1562 if (anyof(junk(k=5,a,b,m=c,3,4,8,9,l=d,10,11)!=[-2,-2,3,4,5,-2,-2,8,9,10,11])
1563 || a!=16 || b!=-2 || c!=-2 || d!=-2) {
1564 goofs++;
1565 "**FAILURE** of - complicated func declaration";
1566 }
1567 junk= [];
1568
1569 /* ------------------------------------------------------------------------- */
1570
1571 write, "Test binary I/O functions...";
1572
1573 /* Test binary I/O functions. */
1574
1575 f= createb("junkb.pdb");
1576
1577 if (is_stream(7) || is_stream() || is_stream(not_near) ||
1578 is_stream(Stest) || !is_stream(f)) {
1579 goofs++;
1580 "**FAILURE** of - is_stream function";
1581 }
1582
1583 x= ["whoa", "okay"];
1584 y= [&(1+0), &[1.5,2.5,3.5], &[]];
1585 z= Stest(a='A', b=13, c=[2,-4,6,-8],
1586 d=[[-1,2],[-3,4],[-5,6]], e=[10,20,30,40,50], f=[1i,2-2i]);
1587
1588 save, f, x, y, z;
1589 close, f;
1590 f= updateb("junkb.pdb");
1591 save, f, iS, lS, dS;
1592 save, f, cA, sA, iA, lA, fA, dA, zA;
1593 f.sA= [-91,57];
1594 close, f;
1595
1596 f= openb("junkb.pdb");
1597 x= y= z= [];
1598 restore, f, x, y, z;
1599 if (typeof(x)!="string" || typeof(y)!="pointer" ||
1600 anyof(dimsof(x)!=[1,2]) || anyof(dimsof(y)!=[1,3]) ||
1601 anyof(x!=["whoa", "okay"]) || typeof(*y(1))!="long" ||
1602 !is_void(*y(3)) || anyof(*y(2)!=[1.5,2.5,3.5]) ||
1603 structof(z)!=Stest || z.a!='A' || anyof(dimsof(z.d)!=[2,2,3]) ||
1604 anyof(dimsof(z.f)!=[1,2]) || anyof(z.f!=[1i,2-2i])) {
1605 goofs++;
1606 "**FAILURE** of - restore or save function";
1607 }
1608 if (f.iS!=iS || f.lS!=lS || f.dS!=dS ||
1609 anyof(f.cA!=cA) || anyof(f.sA!=[-91,57]) || anyof(f.iA!=iA) ||
1610 anyof(f.lA!=lA) || anyof(f.fA!=fA) || anyof(f.dA!=dA) ||
1611 anyof(f.zA!=zA) || typeof(f.cA)!="char" || typeof(f.sA)!="short" ||
1612 typeof(f.iA)!="int" || typeof(f.lA)!="long" || typeof(f.fA)!="float" ||
1613 typeof(f.dA)!="double" || typeof(f.zA)!="complex") {
1614 goofs++;
1615 "**FAILURE** of - f.var syntax or save function";
1616 }
1617 close, f;
1618
1619 remove, "junkb.pdb";
1620
1621 /* try reading and writing a netCDF file */
1622 write, "Test binary I/O to netCDF...";
1623
1624 require, "netcdf.i";
1625 f= nc_create("junkb.nc");
1626 nc_vardef,f, "lS", template=lS, record=1;
1627 nc_vardef,f, "dS", template=dS;
1628 nc_vardef,f, "cA", template=cA;
1629 nc_vardef,f, "sA", template=sA;
1630 nc_vardef,f, "lA", template=lA, record=1;
1631 nc_vardef,f, "fA", template=fA;
1632 nc_vardef,f, "dA", template=dA, record=1;
1633 f= nc_enddef(f);
1634 f.dS= dS; f.cA= cA; f.sA= sA; f.fA= fA;
1635 nc_addrec, f;
1636 save,f, lS,lA,dA;
1637 nc_addrec, f;
1638 save,f, lS,lA,dA;
1639 nc_addrec, f;
1640 save,f, lS,lA,dA;
1641 close, f;
1642 remove, "junkb.ncL";
1643
1644 f= openb("junkb.nc");
1645 if (f.lS!=lS || f.dS!=dS ||
1646 anyof(f.cA!=cA) || anyof(f.sA!=sA) ||
1647 anyof(f.lA!=lA) || anyof(f.fA!=fA) || anyof(f.dA!=dA) ||
1648 typeof(f.cA)!="char" || typeof(f.sA)!="short" ||
1649 typeof(f.lA)!="long" || typeof(f.fA)!="float" ||
1650 typeof(f.dA)!="double") {
1651 goofs++;
1652 "**FAILURE** of - f.var syntax or save to netCDF";
1653 }
1654
1655 jr,f, 3;
1656 if (f.lS!=lS || anyof(f.lA!=lA) || anyof(f.dA!=dA)) {
1657 goofs++;
1658 "**FAILURE** of - f.var syntax or save to netCDF";
1659 }
1660
1661 close, f;
1662 remove, "junkb.nc";
1663
1664 if (do_stats) "M "+print(yorick_stats());
1665
1666 /* ------------------------------------------------------------------------- */
1667
1668 write, "Test ASCII I/O functions...";
1669
1670 /* Test ASCII I/O functions. */
1671
1672 f= open("junkt.txt", "w");
1673 write,f, "The first line.";
1674 write,f, dA;
1675 write,f, sA-7, fA+5;
1676 write,f, format="blah %s %d %e\n", "wow", lA+6, dA-20;
1677 close,f;
1678
1679 f= open("junkt.txt", "r+");
1680 if (rdline(f)!=" The first line.") {
1681 goofs++;
1682 "**FAILURE** of - rdline or write function";
1683 }
1684 backup, f;
1685 if (rdline(f)!=" The first line.") {
1686 goofs++;
1687 "**FAILURE** of - backup function";
1688 }
1689 mark= bookmark(f);
1690 x= 0*dA;
1691 if (read(f,x)!=2 || anyof(x!=dA)) {
1692 goofs++;
1693 "**FAILURE** of - read or write function";
1694 }
1695 y= 0*sA;
1696 if (read(f,y,x)!=4 || anyof(y!=sA-7) || anyof(x!=fA+5)) {
1697 goofs++;
1698 "**FAILURE** of - read or write function ";
1699 }
1700 y= 0*lA;
1701 mark2= bookmark(f);
1702 if (read(f, format="blah wow %d %e\n", y,x)!=4 ||
1703 anyof(y!=lA+6) || anyof(x!=dA-20)) {
1704 backup, f, mark2;
1705 if (read(f, format="blah wow %d %e", y,x)!=4 ||
1706 anyof(y!=lA+6) || anyof(x!=dA-20)) {
1707 goofs++;
1708 "**FAILURE** of - formatted read or write function";
1709 } else {
1710 /* this OS does not like trailing \n in read formats */
1711 "**WARNING** Yorick formatted read peculiarity -- see testp.i";
1712 }
1713 }
1714 backup, f, mark;
1715 if (read(f,x)!=2 || anyof(x!=dA)) {
1716 goofs++;
1717 "**FAILURE** of - bookmark or backup function";
1718 }
1719 write,f, "Last line.";
1720 close, f;
1721 f= open("junkt.txt");
1722 if (rdline(f,7)(7)!=" Last line.") {
1723 goofs++;
1724 "**FAILURE** of - write to append to end of text";
1725 }
1726 close, f;
1727
1728 remove, "junkt.txt";
1729
1730 if (do_stats) "N "+print(yorick_stats());
1731
1732 /* ------------------------------------------------------------------------- */
1733
1734 write, "Test string manipulation functions...";
1735
1736 /* Test string manipulation functions. */
1737
1738 if (strlen("abc")!=3 ||
1739 anyof(strlen([[string(),"","a"],["axx","ab","abcd"]])!=
1740 [[0,0,1],[3,2,4]])) {
1741 goofs++;
1742 "**FAILURE** of - strlen function";
1743 }
1744
1745 if (anyof(strtok("abc 1.23 xxx")!=["abc", " 1.23 xxx"]) ||
1746 anyof(strtok(["abc 1.23 xxx","c","1.5"], "\t c")!=
1747 [["ab", " 1.23 xxx"],string(),["1.5",string()]])) {
1748 goofs++;
1749 "**FAILURE** of - strtok function";
1750 }
1751
1752 if (!strmatch("abc", "b") || strmatch("abc", "B") ||
1753 !strmatch("abc", "B", 1) ||
1754 anyof(strmatch(["abc","aBC"], "B")!=[0,1])) {
1755 goofs++;
1756 "**FAILURE** of - strmatch function";
1757 }
1758
1759 if (strpart("abc", 1:1)!="a" || strpart("abc", 2:10)!="bc" ||
1760 strpart("abc", :-1)!="ab" || strpart("abc", :-5)!="" ||
1761 anyof(strpart(["abc","yowza"],3:)!=["c","wza"])) {
1762 goofs++;
1763 "**FAILURE** of - strpart function";
1764 }
1765
1766 if (do_stats) "O "+print(yorick_stats());
1767
1768 /* ------------------------------------------------------------------------- */
1769
1770 write, "Test list functions...";
1771
1772 l= _lst(1.5, structof(z), _lst([],z), _prt);
1773 #if 0
1774 write, "<Begin output from _prt list (15 lines gibberish)>";
1775 _prt, l;
1776 write, "<End output from _prt list (15 lines gibberish)>";
1777 #endif
1778 if (_len(l)!=4) {
1779 goofs++;
1780 "**FAILURE** of - _lst or _len function";
1781 }
1782 if (_car(l)!=1.5 || _car(l,1)!=1.5 || _car(l,2)!=Stest ||
1783 typeof(_car(l,3))!="list" || _car(l,4)!=_prt ||
1784 !is_void(_car(_car(l,3)))) {
1785 goofs++;
1786 "**FAILURE** of - _lst or _car function";
1787 }
1788 if (_car(_cdr(l))!=Stest || _car(_cdr(l,3))!=_prt ||
1789 !is_void(_cdr(l,4))) {
1790 goofs++;
1791 "**FAILURE** of - _cdr function";
1792 }
1793 m= _cpy(l,2);
1794 if (_len(m)!=2 || _car(m)!=1.5 || _car(m,2)!=Stest || _len(_cpy(l))!=4) {
1795 goofs++;
1796 "**FAILURE** of - _cpy function";
1797 }
1798 if (_car(m,2,2.5)!=Stest || _car(l,2)!=Stest || _car(m,2)!=2.5) {
1799 goofs++;
1800 "**FAILURE** of - _car set function";
1801 }
1802 n= _cat(m, _cpy(_cdr(l,2)));
1803 if (n!=m || _len(m)!=4 || _len(n)!=4 || _car(n,4)!=_prt) {
1804 goofs++;
1805 "**FAILURE** of - _cat function";
1806 }
1807 if (_car(_cdr(m,3,[]))!=_prt || !is_void(_cdr(n,3)) ||
1808 !is_void(_cdr(n,3,_lst(_len))) || _car(m,4)!=_len ||
1809 _car(l,4)!=_prt) {
1810 goofs++;
1811 "**FAILURE** of - _cdr set function";
1812 }
1813 n= _map(typeof, m);
1814 if (_car(n)!="double" || _car(n,2)!="double" ||
1815 _car(n,3)!="list" || _car(n,4)!="builtin") {
1816 goofs++;
1817 "**FAILURE** of - _map set function";
1818 }
1819 m= _rev(m);
1820 if (_car(m,4)!=1.5 || _car(m,3)!=2.5 ||
1821 typeof(_car(m,2))!="list" || _car(m)!=_len ||
1822 !is_void(_car(_car(m,2)))) {
1823 goofs++;
1824 "**FAILURE** of - _rev function";
1825 }
1826 l= m= n= [];
1827
1828 if (do_stats) "P "+print(yorick_stats());
1829
1830 /* ------------------------------------------------------------------------- */
1831
1832 write, "Test catch function...";
1833
junk(type)1834 func junk(type)
1835 {
1836 if (catch(0x01)) {
1837 if (type!=0x01) {
1838 goofs++;
1839 "**FAILURE** of - catch function - misidentified error as math";
1840 }
1841 return 0x01;
1842 }
1843 if (catch(0x02)) {
1844 if (type!=0x02) {
1845 goofs++;
1846 "**FAILURE** of - catch function - misidentified error as io";
1847 }
1848 return 0x02;
1849 }
1850 if (catch(0x04)) {
1851 if (type!=0x04) {
1852 goofs++;
1853 "**FAILURE** of - catch function - misidentified error as C-c";
1854 }
1855 return 0x04;
1856 }
1857 if (catch(0x08)) {
1858 if (type!=0x08) {
1859 goofs++;
1860 "**FAILURE** of - catch function - misidentified error as YError";
1861 }
1862 return 0x08;
1863 }
1864 if (catch(0x10)) {
1865 if (type!=0x10) {
1866 goofs++;
1867 "**FAILURE** of - catch function - misidentified error as interpreted";
1868 } else if (catch_message!="---test error, should be caught---") {
1869 goofs++;
1870 "**FAILURE** of - catch function - catch_message set incorrectly";
1871 }
1872 return 0x10;
1873 }
1874 if (type==0x01) x= 1.0/0.0;
1875 if (type==0x02) f= open("no-such-file-ever-existed");
1876 if (type==0x04) return 0x04; /* need user to hit C-c */
1877 if (type==0x08) x= 1.0*[];
1878 if (type==0x10) error, "---test error, should be caught---";
1879 return 0;
1880 }
1881
1882 if (!junk(0x01)) "**WARNING** 1.0/0.0 does not trigger SIGFPE";
1883 if (!junk(0x02)) {
1884 goofs++;
1885 "**FAILURE** of - catch function - I/O error not caught";
1886 }
1887 if (!junk(0x08)) {
1888 goofs++;
1889 "**FAILURE** of - catch function - compiled error not caught";
1890 }
1891 if (!junk(0x10)) {
1892 goofs++;
1893 "**FAILURE** of - catch function - interpreted error not caught";
1894 }
1895
1896 junk= [];
1897
1898 if (do_stats) "Q "+print(yorick_stats());
1899
1900 /* ------------------------------------------------------------------------- */
1901
1902 iS= lS= dS= cA= sA= iA= lA= fA= dA= zA= [];
1903 write, format= "End of Yorick parser test, %d goofs\n", goofs;
1904
1905 #include "teststr.i"
1906 #include "testoxy.i"
1907
1908 if (!skip_testb) {
1909 require, "testb.i";
1910 write,"\n Zeroth test is pdtest files:"; pdcheck2; write,"";
1911 testb;
1912 }
1913
1914 /* write if tests twice so that include actually takes place */
1915 if (!skip_test1) include, "test1.i";
1916 if (!skip_test1) { write,"\nShock tracker timing test:"; test1, 20; }
1917
1918 if (!skip_test2) include, "test2.i";
1919 if (!skip_test2) { write,"\nEscape factor timing test:"; test2, 15; }
1920
1921 if (!skip_test3) include, "test3.i";
1922 if (!skip_test3) { write,"\nZone generator timing test:"; test3, 100; }
1923