i/testp

Home Manual Packages Global Index Keywords Quick Reference |
    /*
       TESTP.I
       Test of Yorick parser

       $Id: testp.i,v 1.1 1993/08/27 18:50:06 munro Exp munro $
     */
    /*    Copyright (c) 1994.  The Regents of the University of California.
                        All rights reserved.  */

    goofs= 0;  /* cumulative tally of errors detected */
    write, "Begin Yorick parser test...";

    if (do_stats) "A "+print(yorick_stats());

    /* ------------------------------------------------------------------------- */

    /* First function is pure parser test, exercising many yucky language
       features, but not producing any usable procedure.  Check disassembled
       function to be sure code is correct.  */
    func parser_test(pos1, pos2, pos3, .., key1=, key2=, key3=)
    {
      pos1= '\0';
      pos2= 1s;
      pos3= 2n;
      loc1= 3L;
      loc2= 4.0e0F;
      loc3= 5.0;
      loc4= 6.0i;
      loc5= "A string with ' and /* inside.";

      /* Blank lines, then a short comment with imbedded " character */

      /* A multiline comment with blank lines and various types of
         quote characters,

         such as " and ',

         all of which should be completely ignored... */

    #if 0
    Try commenting something out with #if 0/#endif sequence
    #  if 0
         These should nest properly...
    #  endif
    ...So this line should still be commented out.
    #endif
    #  if 0
      Be sure indented style works.
    #  endif

    // Comment out something with C++-style comment
                // ... and another comment
    /*
    // Nested comment test
    terrible syntax error
    */
    //  first commented out line;  /* nested normal comment */
    //  second bad line;
    //   third bad line;
    //   fourth bad line;   /* final nested comment

      key1= pos3;   // C++ comment
      /* initial comment */ key2 /* imbedded comment */ = 0 /* repeated

         constant */ + 6.;  /* followed by a second repeated constant */

      key3= ext1;  /* first example of an external variable // nest test */

      local loc6;  local loc7, loc8, loc9;  // C++ style comment /* nesting */
      extern ext2, ext3;  extern ext4;

      ext2= -1;  /* negative of existing constant */
      loc6= - /* nasty imbedded
    	     comment */ 7.0;

      ext3= "multiline string also tests escape sequences: \
    \\n\n, \\t\t, \\a\a, \\f\f, \\r\r, \\v\v, \\b\b, \', \"\n\
    \?, \q, C-a\1, C-b\02, C-c\003, C-d\0041 (should C-d1), C-z\x1A,\
    DEL\x7f";  /* Note: \? and \q should just give ? and q */

      loc7= ext4+1;
      loc8= ext5();   /* should push nil argument */
      ext5(pos1);
      ext5(pos1, key1, loc1);
      ext5(pos1, key1, .., loc1);
      ext5;
      ext5, pos1;
      ext5, pos1, key1, loc1, ext1, /* final argument nil */;

      /* Try lines with implicit semi-colon terminators: */
      loc7(3:, 6*loc1+loc2, ::loc2+loc3)=
        5
      loc8= loc7 + 7*
        loc6(3,
    	 )

      if (loc1) ext5
      else ext5, 1

      if (loc1) ext5
      ext5, 1

      /* Try several popular styles */
      if (loc1) {
        ext3;
      } else if (!loc2) {
        ext3, 1;
      } else if (loc3) {
        ext3, 1;
        ext3, 2;
      } else {
        ext3, 3;
      }

      if (loc1)
      {
        ext4;
      }
      else if (loc2)
      {
        ext4, 1;
      }
      else if (!loc3)
      {
        ext4, 1;
        ext4, 2;
      }
      else
      {
        ext4, 3;
      }

      if (!loc1) ext5;
      else if (loc2) ext5, 1;
      else if (loc3) { ext5, 1; ext5, 2; }
      else ext5, 3;

      while (loc1--) {
        ext6;
        ext6, 2;
      };            /* check that extraneous trailing semi-colon is OK */

     backward:
      do {
        ext6;
        if (ext1) break;
        if (ext2) continue;
        ext6, 2;
      } while (--loc1);

      if (ext6) goto forward;
      if (ext3) goto backward;

      for (loc1=0 ; loc1<8 ; loc1++) {
        ext5;
        ext5, 2;
      }

     forward:
      for (loc1=0, loc2=loc3=0 ;
           loc1<8 ;
           loc1++, loc2+=2, loc3+=3) {
        if (ext4>=9) continue;
        ext5;
        do {
          ext6;
          if (ext1!=3) break;
          for (loc1=0 ; loc1<8 ; loc1++) {
    	ext5;
    	if (ext3<=2) break;
    	if (ext4==7) continue;
    	if (!ext1) goto inloop;
    	ext5, 2;
          }
          if (ext2) continue;
          ext6, 2;
        } while (--loc1);
        if (ext3>3) break;
        ext5, 2;
      inloop:
      }

      if (loc1 || loc2 && loc3) goto backward;

      return 3*loc1(3:12:3, ptp, avg:9:21)? 3+ext1 : 2-ext2;
    }

    if (do_stats) "B "+print(yorick_stats());

    #if 0

    Here is the correct disassemble output for parser_test:
    func parser_test(pos1,pos2,pos3,..,key1=,key2=,key3=)
      17 sp->1    PushChar(0x00)
      19 sp0>1    Define(pos1)
      21 sp->0    DropTop
      22 sp+>1    PushShort(1)
      24 sp0>1    Define(pos2)
      26 sp->0    DropTop
      27 sp+>1    PushInt(2)
      29 sp0>1    Define(pos3)
      31 sp->0    DropTop
      32 sp+>1    PushLong(3)
      34 sp0>1    Define(loc1)
      36 sp->0    DropTop
      37 sp+>1    PushFloat(4)
      39 sp0>1    Define(loc2)
      41 sp->0    DropTop
      42 sp+>1    PushDouble(5)
      44 sp0>1    Define(loc3)
      46 sp->0    DropTop
      47 sp+>1    PushImaginary(6i)
      49 sp0>1    Define(loc4)
      51 sp->0    DropTop
      52 sp+>1    PushString("A string with ' and /* i"...)
      54 sp0>1    Define(loc5)
      56 sp->0    DropTop
      57 sp+>1    PushVariable(pos3)
      59 sp0>1    Define(key1)
      61 sp->0    DropTop
      62 sp+>1    PushLong(0)
      64 sp+>2    PushDouble(6)
      66 sp->1    Add
      67 sp0>1    Define(key2)
      69 sp->0    DropTop
      70 sp+>1    PushVariable(ext1)
      72 sp0>1    Define(key3)
      74 sp->0    DropTop
      75 sp+>1    PushLong(-1)
      77 sp0>1    Define(ext2)
      79 sp->0    DropTop
      80 sp+>1    PushDouble(-7)
      82 sp0>1    Define(loc6)
      84 sp->0    DropTop
      85 sp+>1    PushString("multiline string also te"...)
      87 sp0>1    Define(ext3)
      89 sp->0    DropTop
      90 sp+>1    PushVariable(ext4)
      92 sp+>2    PushLong(1)
      94 sp->1    Add
      95 sp0>1    Define(loc7)
      97 sp->0    DropTop
      98 sp+>1    PushVariable(ext5)
     100 sp+>2    PushNil
     101 sp->1    Eval(1)
     103 sp0>1    Define(loc8)
     105 sp->0    DropTop
     106 sp+>1    PushVariable(ext5)
     108 sp+>2    PushReference(pos1)
     110 sp->1    Eval(1)
     112 sp0>1    Print
     113 sp->0    DropTop
     114 sp+>1    PushVariable(ext5)
     116 sp+>2    PushReference(pos1)
     118 sp+>3    PushReference(key1)
     120 sp+>4    PushReference(loc1)
     122 sp->1    Eval(3)
     124 sp0>1    Print
     125 sp->0    DropTop
     126 sp+>1    PushVariable(ext5)
     128 sp+>2    PushReference(pos1)
     130 sp+>3    PushReference(key1)
     132 sp+>4    FormRangeFlag(..)
     134 sp+>5    PushReference(loc1)
     136 sp->1    Eval(4)
     138 sp0>1    Print
     139 sp->0    DropTop
     140 sp+>1    PushVariable(ext5)
     142 sp0>1    Print
     143 sp->0    DropTop
     144 sp+>1    PushVariable(ext5)
     146 sp+>2    PushReference(pos1)
     148 sp->1    Eval(1)
     150 sp->0    DropTop
     151 sp+>1    PushVariable(ext5)
     153 sp+>2    PushReference(pos1)
     155 sp+>3    PushReference(key1)
     157 sp+>4    PushReference(loc1)
     159 sp+>5    PushReference(ext1)
     161 sp+>6    PushNil
     162 sp->1    Eval(5)
     164 sp->0    DropTop
     165 sp+>1    PushVariable(loc7)
     167 sp+>2    PushLong(3)
     169 sp+>3    PushNil
     170 sp->2    FormRange(2)
     172 sp+>3    PushLong(6)
     174 sp+>4    PushVariable(loc1)
     176 sp->3    Multiply
     177 sp+>4    PushVariable(loc2)
     179 sp->3    Add
     180 sp+>4    PushNil
     181 sp+>5    PushNil
     182 sp+>6    PushVariable(loc2)
     184 sp+>7    PushVariable(loc3)
     186 sp->6    Add
     187 sp->4    FormRange(3)
     189 sp->1    Eval(3)
     191 sp+>2    PushLong(5)
     193 sp->1    Assign
     194 sp->0    DropTop
     195 sp+>1    PushVariable(loc7)
     197 sp+>2    PushLong(7)
     199 sp+>3    PushVariable(loc6)
     201 sp+>4    PushLong(3)
     203 sp+>5    PushNil
     204 sp->3    Eval(2)
     206 sp->2    Multiply
     207 sp->1    Add
     208 sp0>1    Define(loc8)
     210 sp->0    DropTop
     211 sp+>1    PushVariable(loc1)
     213 sp->0    BranchFalse to pc= 221
     215 sp+>1    PushVariable(ext5)
     217 sp0>1    Print
     218 sp->0    DropTop
     219 sp0>0    Branch to pc= 228
     221 sp+>1    PushVariable(ext5)
     223 sp+>2    PushLong(1)
     225 sp->1    Eval(1)
     227 sp->0    DropTop
     228 sp+>1    PushVariable(loc1)
     230 sp->0    BranchFalse to pc= 236
     232 sp+>1    PushVariable(ext5)
     234 sp0>1    Print
     235 sp->0    DropTop
     236 sp+>1    PushVariable(ext5)
     238 sp+>2    PushLong(1)
     240 sp->1    Eval(1)
     242 sp->0    DropTop
     243 sp+>1    PushVariable(loc1)
     245 sp->0    BranchFalse to pc= 253
     247 sp+>1    PushVariable(ext3)
     249 sp0>1    Print
     250 sp->0    DropTop
     251 sp0>0    Branch to pc= 293
     253 sp+>1    PushVariable(loc2)
     255 sp->0    BranchTrue to pc= 266
     257 sp+>1    PushVariable(ext3)
     259 sp+>2    PushLong(1)
     261 sp->1    Eval(1)
     263 sp->0    DropTop
     264 sp0>0    Branch to pc= 293
     266 sp+>1    PushVariable(loc3)
     268 sp->0    BranchFalse to pc= 286
     270 sp+>1    PushVariable(ext3)
     272 sp+>2    PushLong(1)
     274 sp->1    Eval(1)
     276 sp->0    DropTop
     277 sp+>1    PushVariable(ext3)
     279 sp+>2    PushLong(2)
     281 sp->1    Eval(1)
     283 sp->0    DropTop
     284 sp0>0    Branch to pc= 293
     286 sp+>1    PushVariable(ext3)
     288 sp+>2    PushLong(3)
     290 sp->1    Eval(1)
     292 sp->0    DropTop
     293 sp+>1    PushVariable(loc1)
     295 sp->0    BranchFalse to pc= 303
     297 sp+>1    PushVariable(ext4)
     299 sp0>1    Print
     300 sp->0    DropTop
     301 sp0>0    Branch to pc= 343
     303 sp+>1    PushVariable(loc2)
     305 sp->0    BranchFalse to pc= 316
     307 sp+>1    PushVariable(ext4)
     309 sp+>2    PushLong(1)
     311 sp->1    Eval(1)
     313 sp->0    DropTop
     314 sp0>0    Branch to pc= 343
     316 sp+>1    PushVariable(loc3)
     318 sp->0    BranchTrue to pc= 336
     320 sp+>1    PushVariable(ext4)
     322 sp+>2    PushLong(1)
     324 sp->1    Eval(1)
     326 sp->0    DropTop
     327 sp+>1    PushVariable(ext4)
     329 sp+>2    PushLong(2)
     331 sp->1    Eval(1)
     333 sp->0    DropTop
     334 sp0>0    Branch to pc= 343
     336 sp+>1    PushVariable(ext4)
     338 sp+>2    PushLong(3)
     340 sp->1    Eval(1)
     342 sp->0    DropTop
     343 sp+>1    PushVariable(loc1)
     345 sp->0    BranchTrue to pc= 353
     347 sp+>1    PushVariable(ext5)
     349 sp0>1    Print
     350 sp->0    DropTop
     351 sp0>0    Branch to pc= 393
     353 sp+>1    PushVariable(loc2)
     355 sp->0    BranchFalse to pc= 366
     357 sp+>1    PushVariable(ext5)
     359 sp+>2    PushLong(1)
     361 sp->1    Eval(1)
     363 sp->0    DropTop
     364 sp0>0    Branch to pc= 393
     366 sp+>1    PushVariable(loc3)
     368 sp->0    BranchFalse to pc= 386
     370 sp+>1    PushVariable(ext5)
     372 sp+>2    PushLong(1)
     374 sp->1    Eval(1)
     376 sp->0    DropTop
     377 sp+>1    PushVariable(ext5)
     379 sp+>2    PushLong(2)
     381 sp->1    Eval(1)
     383 sp->0    DropTop
     384 sp0>0    Branch to pc= 393
     386 sp+>1    PushVariable(ext5)
     388 sp+>2    PushLong(3)
     390 sp->1    Eval(1)
     392 sp->0    DropTop
     393 sp+>1    PushVariable(loc1)
     395 sp+>2    Push1
     396 sp+>3    DupUnder
     397 sp->2    Subtract
     398 sp0>2    Define(loc1)
     400 sp->1    DropTop
     401 sp->0    BranchFalse to pc= 416
     403 sp+>1    PushVariable(ext6)
     405 sp0>1    Print
     406 sp->0    DropTop
     407 sp+>1    PushVariable(ext6)
     409 sp+>2    PushLong(2)
     411 sp->1    Eval(1)
     413 sp->0    DropTop
     414 sp0>0    Branch to pc= 393
     416 sp+>1    PushVariable(ext6)
     418 sp0>1    Print
     419 sp->0    DropTop
     420 sp+>1    PushVariable(ext1)
     422 sp->0    BranchFalse to pc= 426
     424 sp0>0    Branch to pc= 447
     426 sp+>1    PushVariable(ext2)
     428 sp->0    BranchFalse to pc= 432
     430 sp0>0    Branch to pc= 439
     432 sp+>1    PushVariable(ext6)
     434 sp+>2    PushLong(2)
     436 sp->1    Eval(1)
     438 sp->0    DropTop
     439 sp+>1    PushVariable(loc1)
     441 sp+>2    Push1
     442 sp->1    Subtract
     443 sp0>1    Define(loc1)
     445 sp->0    BranchTrue to pc= 416
     447 sp+>1    PushVariable(ext6)
     449 sp->0    BranchFalse to pc= 453
     451 sp0>0    Branch to pc= 493
     453 sp+>1    PushVariable(ext3)
     455 sp->0    BranchFalse to pc= 459
     457 sp0>0    Branch to pc= 416
     459 sp+>1    PushLong(0)
     461 sp0>1    Define(loc1)
     463 sp->0    DropTop
     464 sp+>1    PushVariable(loc1)
     466 sp+>2    PushLong(8)
     468 sp->1    Less
     469 sp->0    BranchFalse to pc= 493
     471 sp+>1    PushVariable(ext5)
     473 sp0>1    Print
     474 sp->0    DropTop
     475 sp+>1    PushVariable(ext5)
     477 sp+>2    PushLong(2)
     479 sp->1    Eval(1)
     481 sp->0    DropTop
     482 sp+>1    PushVariable(loc1)
     484 sp+>2    Push1
     485 sp+>3    DupUnder
     486 sp->2    Add
     487 sp0>2    Define(loc1)
     489 sp->1    DropTop
     490 sp->0    DropTop
     491 sp0>0    Branch to pc= 464
     493 sp+>1    PushLong(0)
     495 sp0>1    Define(loc1)
     497 sp->0    DropTop
     498 sp+>1    PushLong(0)
     500 sp0>1    Define(loc3)
     502 sp0>1    Define(loc2)
     504 sp->0    DropTop
     505 sp+>1    PushVariable(loc1)
     507 sp+>2    PushLong(8)
     509 sp->1    Less
     510 sp->0    BranchFalse to pc= 660
     512 sp+>1    PushVariable(ext4)
     514 sp+>2    PushLong(9)
     516 sp->1    GreaterEQ
     517 sp->0    BranchFalse to pc= 521
     519 sp0>0    Branch to pc= 633
     521 sp+>1    PushVariable(ext5)
     523 sp0>1    Print
     524 sp->0    DropTop
     525 sp+>1    PushVariable(ext6)
     527 sp0>1    Print
     528 sp->0    DropTop
     529 sp+>1    PushVariable(ext1)
     531 sp+>2    PushLong(3)
     533 sp->1    NotEqual
     534 sp->0    BranchFalse to pc= 538
     536 sp0>0    Branch to pc= 617
     538 sp+>1    PushLong(0)
     540 sp0>1    Define(loc1)
     542 sp->0    DropTop
     543 sp+>1    PushVariable(loc1)
     545 sp+>2    PushLong(8)
     547 sp->1    Less
     548 sp->0    BranchFalse to pc= 596
     550 sp+>1    PushVariable(ext5)
     552 sp0>1    Print
     553 sp->0    DropTop
     554 sp+>1    PushVariable(ext3)
     556 sp+>2    PushLong(2)
     558 sp->1    LessEQ
     559 sp->0    BranchFalse to pc= 563
     561 sp0>0    Branch to pc= 596
     563 sp+>1    PushVariable(ext4)
     565 sp+>2    PushLong(7)
     567 sp->1    Equal
     568 sp->0    BranchFalse to pc= 572
     570 sp0>0    Branch to pc= 585
     572 sp+>1    PushVariable(ext1)
     574 sp->0    BranchTrue to pc= 578
     576 sp0>0    Branch to pc= 633
     578 sp+>1    PushVariable(ext5)
     580 sp+>2    PushLong(2)
     582 sp->1    Eval(1)
     584 sp->0    DropTop
     585 sp+>1    PushVariable(loc1)
     587 sp+>2    Push1
     588 sp+>3    DupUnder
     589 sp->2    Add
     590 sp0>2    Define(loc1)
     592 sp->1    DropTop
     593 sp->0    DropTop
     594 sp0>0    Branch to pc= 543
     596 sp+>1    PushVariable(ext2)
     598 sp->0    BranchFalse to pc= 602
     600 sp0>0    Branch to pc= 609
     602 sp+>1    PushVariable(ext6)
     604 sp+>2    PushLong(2)
     606 sp->1    Eval(1)
     608 sp->0    DropTop
     609 sp+>1    PushVariable(loc1)
     611 sp+>2    Push1
     612 sp->1    Subtract
     613 sp0>1    Define(loc1)
     615 sp->0    BranchTrue to pc= 525
     617 sp+>1    PushVariable(ext3)
     619 sp+>2    PushLong(3)
     621 sp->1    Greater
     622 sp->0    BranchFalse to pc= 626
     624 sp0>0    Branch to pc= 660
     626 sp+>1    PushVariable(ext5)
     628 sp+>2    PushLong(2)
     630 sp->1    Eval(1)
     632 sp->0    DropTop
     633 sp+>1    PushVariable(loc1)
     635 sp+>2    Push1
     636 sp+>3    DupUnder
     637 sp->2    Add
     638 sp0>2    Define(loc1)
     640 sp->1    DropTop
     641 sp->0    DropTop
     642 sp+>1    PushVariable(loc2)
     644 sp+>2    PushLong(2)
     646 sp->1    Add
     647 sp0>1    Define(loc2)
     649 sp->0    DropTop
     650 sp+>1    PushVariable(loc3)
     652 sp+>2    PushLong(3)
     654 sp->1    Add
     655 sp0>1    Define(loc3)
     657 sp->0    DropTop
     658 sp0>0    Branch to pc= 505
     660 sp+>1    PushVariable(loc1)
     662 sp->0    BranchTrue to pc= 673
     664 sp+>1    PushVariable(loc2)
     666 sp->0    BranchFalse to pc= 671
     668 sp+>1    PushVariable(loc3)
     670 sp==0    AndOrLogical for &&
     671 sp+>1    Push0
     672 sp==0    AndOrLogical for ||
     673 sp+>1    Push1
     674 sp->0    BranchFalse to pc= 678
     676 sp0>0    Branch to pc= 416
     678 sp+>1    PushLong(3)
     680 sp+>2    PushVariable(loc1)
     682 sp+>3    PushLong(3)
     684 sp+>4    PushLong(12)
     686 sp+>5    PushLong(3)
     688 sp->3    FormRange(3)
     690 sp+>4    FormRangeFunc(ptp:)
     692 sp+>5    PushLong(9)
     694 sp+>6    PushLong(21)
     696 sp->5    FormRange(2)
     698 sp0>5    AddRangeFunc(avg:)
     700 sp->2    Eval(3)
     702 sp->1    Multiply
     703 sp->0    BranchFalse to pc= 712
     705 sp+>1    PushLong(3)
     707 sp+>2    PushVariable(ext1)
     709 sp->1    Add
     710 sp0>1    Branch to pc= 717
     712 sp+>1    PushLong(2)
     714 sp+>2    PushVariable(ext2)
     716 sp->1    Subtract
     717 sp->0    Return
     718 sp==0    Halt-Virtual-Machine
    #endif

    /* Try reinstated line */
    junk= 1;
    #if 1
    junk= 0;
    #  if 0
    junk= 2;
    #  endif
    #endif
    if (junk) {
      goofs++;
      "**FAILURE** #if / #endif construction broken";
    }

    /* ------------------------------------------------------------------------- */

    f= open("../i/testp.i", "r", 1);

    if (is_void(f)) f= open(Y_SITE+"i/testp.i", "r", 1);
    if (f) {

      while (!strmatch((line= rdline(f)), "Here is the correct disassemble"));
      correct= [];

      while (!strmatch((line= rdline(f)), "#endif")) grow, correct, line;
      close, f;

      if (anyof(disassemble(parser_test)!=correct)) {
        goofs++;
        "**FAILURE** of the parser_test disassembly";
        "            -- writing disassmbly of parser_test to pjunk.jnk";
        f= open("pjunk.jnk", "w");

        write, f, format="%s\n", disassemble(parser_test);
        close, f;
      }
      correct= [];
    } else {

      "WARNING-- skipping disassembly check, include/testp.i not present";
    }
    parser_test= [];

    /* Check for limitation on yacc-parser stack depth.

       If this fails with a SYNTAX error like "yacc stack overflow", see
       top of yorick.y source-- your yacc may have a switch to fix it.  */
    { if (1) x= [1, 2];
      else if (1) x= [1, 2]; else if (1) x= [1, 2]; else if (1) x= [1, 2];
      else if (1) x= [1, 2]; else if (1) x= [1, 2]; else if (1) x= [1, 2];
      else if (1) x= [1, 2]; else if (1) x= [1, 2]; else if (1) x= [1, 2];
      else if (1) x= [1, 2]; else if (1) x= [1, 2]; else if (1) x= [1, 2];
      else if (1) x= [1, 2]; else if (1) x= [1, 2]; else if (1) x= [1, 2];
      else if (1) x= [1, 2]; else if (1) x= [1, 2]; else if (1) x= [1, 2];
      else if (1) x= [1, 2]; else if (1) x= [1, 2]; else if (1) x= [1, 2];
      else if (1) x= [1, 2]; else if (1) x= [1, 2]; else if (1) x= [1, 2];
      else if (1) x= [1, 2]; else if (1) x= [1, 2]; else if (1) x= [1, 2];
      else if (1) x= [1, 2]; else if (1) x= [1, 2]; else if (1) x= [1, 2];
      else if (1) x= [1, 2]; else if (1) x= [1, 2]; else if (1) x= [1, 2];
      else if (1) x= [1, 2]; else if (1) x= [1, 2]; else if (1) x= [1, 2];
      else if (1) x= [1, 2]; else if (1) x= [1, 2]; else if (1) x= [1, 2];
      else if (1) x= [1, 2]; else if (1) x= [1, 2]; else if (1) x= [1, 2];
      else x= [1,2]; }

    x= [];

    /* If following lines give syntax errors, something is wrong with
       the NumberValue routine in Yorick/yorick.c */

    if (abs(100000000000000000000.0-1.e20)>1.e11)

      write, "**WARNING** problem with numeric conversions";
    if (0xffffffff != ((0xffff<<16)|0xffff))

      write, "**WARNING** problem with strtoul?";

    /* test basic flow control statements */
    i= 0;
    do { i++; } while (i<20);
    if (i!=20)

      error, "***PARSER BUG*** try recompiling Yorick/parse.c unoptimized";
    for (i=0 ; i<20 ; ++i);
    if (i!=20)

      error, "***PARSER BUG*** try recompiling Yorick/parse.c unoptimized";
    i= 0;
    while (i<20) ++i;
    if (i!=20)

      error, "***PARSER BUG*** try recompiling Yorick/parse.c unoptimized";
    i= j= 0;

    do { i++; if (i>15) break; else if (i>5) continue; j++; } while (i<20);
    if (i!=16 || j!=5)

      error, "***PARSER BUG*** try recompiling Yorick/parse.c unoptimized";
    for (i=j=0 ; i<20 ; ++i) { if (i>15) break; if (i>10) continue; ++j; }
    if (i!=16 || j!=11)

      error, "***PARSER BUG*** try recompiling Yorick/parse.c unoptimized";
    i= j= 0;
    while (i<20) { ++i; if (i>15) break; if (i>10) continue; ++j; }
    if (i!=16 || j!=10)

      error, "***PARSER BUG*** try recompiling Yorick/parse.c unoptimized";

    if (do_stats) "C "+print(yorick_stats());

    /* ------------------------------------------------------------------------- */

    write, "Test 17x10x10 binary operators...";

    /* Test all binary operations.  There are 10 data types and
       17 operators, so the complete test involves 1700 function calls... */
    iS= 1n;  lS= 1;  dS= 1.0
    cA= ['\1', '\2'];  sA= [1s, 2s];  iA= [1n, 2n];  lA= [1, 2];
    fA= [1.0f, 2.0f];  dA= [1., 2.];  zA= [1+0i, 2+0i];

    func op_test(SS, AS, SA, AA, op_name) /* SS, .. AA are correct answers */
    {
      extern op;               /* the function to be tested */

      goof= array(1, 10, 10);  /* array to hold any mistakes */

      except_complex= only_integer= goof;
      except_complex(10,)= except_complex(,10)= 0;
      only_integer(3,)= only_integer(,3)= 0;
      only_integer(8:,)= 0;  only_integer(,8:)= 0;

      answer= SS;
      op,iS,iS,1,1; op,lS,iS,2,1; op,dS,iS,3,1;
      op,iS,lS,1,2; op,lS,lS,2,2; op,dS,lS,3,2;
      op,iS,dS,1,3; op,lS,dS,2,3; op,dS,dS,3,3;

      answer= AS;
      op,cA,iS,4,1; op,sA,iS,5,1; op,iA,iS,6,1; op,lA,iS,7,1;
      op,fA,iS,8,1; op,dA,iS,9,1; op,zA,iS,10,1;
      op,cA,lS,4,2; op,sA,lS,5,2; op,iA,lS,6,2; op,lA,lS,7,2;
      op,fA,lS,8,2; op,dA,lS,9,2; op,zA,lS,10,2;
      op,cA,dS,4,3; op,sA,dS,5,3; op,iA,dS,6,3; op,lA,dS,7,3;
      op,fA,dS,8,3; op,dA,dS,9,3; op,zA,dS,10,3;

      answer= SA;
      op,iS,cA,1,4; op,iS,sA,1,5; op,iS,iA,1,6; op,iS,lA,1,7;
      op,iS,fA,1,8; op,iS,dA,1,9; op,iS,zA,1,10;
      op,lS,cA,2,4; op,lS,sA,2,5; op,lS,iA,2,6; op,lS,lA,2,7;
      op,lS,fA,2,8; op,lS,dA,2,9; op,lS,zA,2,10;
      op,dS,cA,3,4; op,dS,sA,3,5; op,dS,iA,3,6; op,dS,lA,3,7;
      op,dS,fA,3,8; op,dS,dA,3,9; op,dS,zA,3,10;

      answer= AA;
      op,cA,cA,4,4; op,cA,sA,4,5; op,cA,iA,4,6; op,cA,lA,4,7;
      op,cA,fA,4,8; op,cA,dA,4,9; op,cA,zA,4,10;
      op,sA,cA,5,4; op,sA,sA,5,5; op,sA,iA,5,6; op,sA,lA,5,7;
      op,sA,fA,5,8; op,sA,dA,5,9; op,sA,zA,5,10;
      op,iA,cA,6,4; op,iA,sA,6,5; op,iA,iA,6,6; op,iA,lA,6,7;
      op,iA,fA,6,8; op,iA,dA,6,9; op,iA,zA,6,10;
      op,lA,cA,7,4; op,lA,sA,7,5; op,lA,iA,7,6; op,lA,lA,7,7;
      op,lA,fA,7,8; op,lA,dA,7,9; op,lA,zA,7,10;
      op,fA,cA,8,4; op,fA,sA,8,5; op,fA,iA,8,6; op,fA,lA,8,7;
      op,fA,fA,8,8; op,fA,dA,8,9; op,fA,zA,8,10;
      op,dA,cA,9,4; op,dA,sA,9,5; op,dA,iA,9,6; op,dA,lA,9,7;
      op,dA,fA,9,8; op,dA,dA,9,9; op,dA,zA,9,10;
      op,zA,cA,10,4; op,zA,sA,10,5; op,zA,iA,10,6; op,zA,lA,10,7;
      op,zA,fA,10,8; op,zA,dA,10,9; op,zA,zA,10,10;

      if (anyof(goof)) {
        goofs++;
        "**FAILURE** of the following operations "+op_name+":";
        where2(goof);
      }
    }

    if (do_stats) "D "+print(yorick_stats());

    func op(l, r, il, ir)

    { goof(il, ir)= anyof((l + r)!=answer); }
    op_test, 2, [2, 3], [2, 3], [2, 4], "+";

    func op(l, r, il, ir)

    { goof(il, ir)= anyof((l - r)!=answer); }
    op_test, 0, [0, 1], [0, -1], [0, 0], "-";

    func op(l, r, il, ir)

    { goof(il, ir)= anyof((l * r)!=answer); }
    op_test, 1, [1, 2], [1, 2], [1, 4], "*";

    func op(l, r, il, ir)
    {

      if (structof(l+r)!=structof(l+r+0.0f))

        goof(il, ir)= anyof((l / r)!=structof(l+r)(answer));
      else /* otherwise fails on Crays because division is inexact */

        goof(il, ir)= anyof(abs((l / r) - answer) > 1.e-6);
    }
    op_test, 1, [1, 2], [1, 0.5], [1, 1], "/";

    func op(l, r, il, ir)
    {

      if (structof(r)!=structof(r+0.0f))

        goof(il, ir)= anyof((l ^ r)!=answer);
      else /* otherwise fails on MacIntosh for unknown reason */

        goof(il, ir)= anyof(abs((l ^ r) - answer) > 1.e-6);
    }
    op_test, 1, [1, 2], [1, 1], [1, 4], "^";

    func op(l, r, il, ir)

    { goof(il, ir)= anyof((l == r)!=answer); }
    op_test, 1, [1, 0], [1, 0], [1, 1], "==";

    func op(l, r, il, ir)

    { goof(il, ir)= anyof((l != r)!=answer); }
    op_test, 0, [0, 1], [0, 1], [0, 0], "!=";

    func op(l, r, il, ir)

    { goof(il, ir)= except_complex(il, ir) && anyof((l % r)!=answer); }
    op_test, 0, [0, 0], [0, 1], [0, 0], "%";

    func op(l, r, il, ir)

    { goof(il, ir)= except_complex(il, ir) && anyof((l > r)!=answer); }
    op_test, 0, [0, 1], [0, 0], [0, 0], ">";

    func op(l, r, il, ir)

    { goof(il, ir)= except_complex(il, ir) && anyof((l <= r)!=answer); }
    op_test, 1, [1, 0], [1, 1], [1, 1], "<=";

    func op(l, r, il, ir)

    { goof(il, ir)= except_complex(il, ir) && anyof((l < r)!=answer); }
    op_test, 0, [0, 0], [0, 1], [0, 0], "<";

    func op(l, r, il, ir)

    { goof(il, ir)= except_complex(il, ir) && anyof((l >= r)!=answer); }
    op_test, 1, [1, 1], [1, 0], [1, 1], ">=";

    func op(l, r, il, ir)

    { goof(il, ir)= only_integer(il, ir) && anyof((l << r)!=answer); }
    op_test, 2, [2, 4], [2, 4], [2, 8], "<<";

    func op(l, r, il, ir)

    { goof(il, ir)= only_integer(il, ir) && anyof((l >> r)!=answer); }
    op_test, 0, [0, 1], [0, 0], [0, 0], ">>";

    func op(l, r, il, ir)

    { goof(il, ir)= only_integer(il, ir) && anyof((l & r)!=answer); }
    op_test, 1, [1, 0], [1, 0], [1, 2], "&";

    func op(l, r, il, ir)

    { goof(il, ir)= only_integer(il, ir) && anyof((l | r)!=answer); }
    op_test, 1, [1, 3], [1, 3], [1, 2], "|";

    func op(l, r, il, ir)

    { goof(il, ir)= only_integer(il, ir) && anyof((l ~ r)!=answer); }
    op_test, 0, [0, 3], [0, 3], [0, 0], "~";

    op= op_test= [];

    if (do_stats) "E "+print(yorick_stats());

    /* ------------------------------------------------------------------------- */

    write, "Test unary operators...";

    /* Test all unary operators. */

    func op_test(SS, AA, op_name) /* SS, AA are correct answers */
    {
      extern op;               /* the function to be tested */

      goof= array(1, 10);      /* array to hold any mistakes */

      except_complex= only_integer= goof;
      except_complex(10)= 0;
      only_integer(3)= 0;
      only_integer(8:)= 0;

      answer= SS;
      op,iS,1; op,lS,2; op,dS,3;

      answer= AA&0xff;
      op,cA,4;
      answer= AA;
      op,sA,5; op,iA,6; op,lA,7; op,fA,8; op,dA,9; op,zA,10;

      if (anyof(goof)) {
        goofs++;
        "**FAILURE** of the following operations "+op_name+":";
        where2(goof);
      }
    }

    if (do_stats) "F "+print(yorick_stats());

    func op(l, il)
    { goof(il)= anyof((+ l)!=answer); }
    op_test, 1, [1, 2], "+";

    func op(l, il)
    { goof(il)= anyof((- l)!=answer); }
    op_test, -1, [-1, -2], "-";

    func op(l, il)

    { goof(il)= anyof((! (l-1))!=answer); }
    op_test, 1, [1, 0], "!";

    func op(l, il)

    { goof(il)= only_integer(il) && anyof((~ l)!=answer); }
    op_test, -2, [-2, -3], "~";

    op= op_test= [];

    if (do_stats) "G "+print(yorick_stats());

    /* ------------------------------------------------------------------------- */

    write, "Test array manipulation functions...";

    /* Test array manipulation functions. */

    func not_near (x,y)
    {

      return anyof(abs(x-y)>1.e-9);
    }

    x= [0,1](-,) + [0,10,20](-,-,) + [0,100,200,300](-,-,-,) +
       [0,1000,2000,3000,4000](-,-,-,-,) +
       [0,10000,20000,30000,40000,50000](-,-,-,-,-,);
    if (x(1,2,3,4,5,6)!=54321 || x(1,2,1,1,3,4)!=32001) {
      goofs++;
      "**FAILURE** of - subscript or broadcasting";
    }

    y= [];
    grow, y, -2;
    if (anyof(y!=-2)) {
      goofs++;
      "**FAILURE** of grow test 1";
    }
    grow, y, [1,2,3];
    if (anyof(y!=[-2,1,2,3])) {
      goofs++;
      "**FAILURE** of grow test 2";
    }
    grow, y, [6,5,4];
    if (anyof(y!=[-2,1,2,3,6,5,4])) {
      goofs++;
      "**FAILURE** of grow test 3";
    }
    y= [[1,2,3],[4,5,6]];
    grow, y, -1;

    if (anyof(y!=[[1,2,3],[4,5,6],[-1,-1,-1]])) {
      goofs++;
      "**FAILURE** of grow test 4";
    }
    grow, y, [6,5,4];

    if (anyof(y!=[[1,2,3],[4,5,6],[-1,-1,-1],[6,5,4]])) {
      goofs++;
      "**FAILURE** of grow test 5";
    }

    if (indgen(0)!=orgsof([1])(1) ||

        anyof(indgen(5)!=[0,1,2,3,4]+indgen(0))) {
      goofs++;
      "**FAILURE** of indgen function";
    }

    if (not_near(span(1,4,4), [1,2,3,4]) ||

        not_near(span(0,[2,4],3), [[0,1,2],[0,2,4]]) ||

        not_near(span(0,[2,4],3,0), [[0,0],[1,2],[2,4]]) ||

        not_near(spanl(1,8,4), [1,2,4,8]) ||

        not_near(spanl(1,[4,16],3,0), [[1,1],[2,4],[4,16]])) {
      goofs++;

      "**FAILURE** of span or spanl function";
    }

    y= [0., 1, 2, 3, 4, 5, 6, 7, 8, 9];
    if (digitize(3.5, y)!=5 ||

        anyof(digitize([[-5, 8.5],[11,5],[.5,-.5]],y)!=[[1,10],[11,7],[2,1]]) ||

        anyof(digitize([[-5, 8.5],[11,5],[.5,-.5]],y(::-1))!=
    	  [[11,2],[1,5],[10,11]])) {
      goofs++;

      "**FAILURE** of digitize function";
    }

    if (interp(y, y, 3.5)!=3.5 ||

        anyof(interp(y,y,[[-5, 8.5],[11,5],[.5,-.5]])!=[[0,8.5],[9,5],[.5,0]]) ||

        anyof(interp([y,y],y,[[-5, 8.5],[11,5],[.5,-.5]])!=
    	  [[[0,8.5],[9,5],[.5,0]],[[0,8.5],[9,5],[.5,0]]]) ||

        anyof(interp(transpose([y,y]),y,[[-5, 8.5],[11,5],[.5,-.5]],0)!=
    	  [[[0,0],[8.5,8.5]],[[9,9],[5,5]],[[.5,.5],[0,0]]])) {
      goofs++;
      "**FAILURE** of interp function";
    }

    if (not_near(integ(y, y, 3.5), 0.5*3.5^2) ||

        not_near(integ(y,y,[[-5, 8.5],[11,5],[.5,-.5]]),
    	     0.5*[[0,8.5],[9,5],[.5,0]]^2)) {
      goofs++;
      "**FAILURE** of integ function";
    }

    if (anyof(histogram([1,5,2,1,1,5,2,1,4,5])!=[4,2,0,1,3]) ||

        anyof(histogram([1,5,2,1,1,5,2,1,4,5],top=7)!=[4,2,0,1,3,0,0]) ||

        anyof(histogram([1,5,2,1,1,5,2,1,4,5],y,top=7)!=
    	  [14.,8.,0.,8.,15.,0.,0.])) {
      goofs++;

      "**FAILURE** of histogram function";
    }

    if (anyof(poly([0.,1.,2.], 1,-2,1)!=[1.,0.,1.]) ||

        anyof(poly([0.,1.,2.], 1,[-2,-1,0],1)!=[1.,1.,5.])) {
      goofs++;
      "**FAILURE** of poly function";
    }

    if (anyof(sort([5,1,7,3])!=[2,4,1,3]) ||

        anyof(sort([5.,1.,7.,3.])!=[2,4,1,3]) ||

        anyof(sort(["go", "a", "stay", "abc"])!=[2,4,1,3]) ||

        median([5.,1.,7.,3.])!=4 || median([5.,1.,7.,3.,-2500.])!=3 ||

        anyof(median([[5.,1.,7.,3.],[5.,1.,99.,3.]])!=[4,4]) ||

        anyof(median([[5.,5.],[-55.,1.],[7.,99.],[3.,3.]],0)!=[4,4])) {
      goofs++;

      "**FAILURE** of sort or median function";
    }

    if (anyof(dimsof(x)                          != [6, 1,2,3,4,5,6]) ||

        anyof(dimsof(transpose(x))               != [6, 6,2,3,4,5,1]) ||

        anyof(dimsof(transpose(x,[1,2]))         != [6, 2,1,3,4,5,6]) ||

        anyof(dimsof(transpose(x,[1,0]))         != [6, 6,2,3,4,5,1]) ||

        anyof(dimsof(transpose(x,2))             != [6, 6,1,2,3,4,5]) ||

        anyof(dimsof(transpose(x,0))             != [6, 2,3,4,5,6,1]) ||

        anyof(dimsof(transpose(x,3))             != [6, 5,6,1,2,3,4]) ||

        anyof(dimsof(transpose(x,[4,6,3],[2,5])) != [6, 1,5,6,3,2,4])) {
      goofs++;

      "**FAILURE** of transpose test 1";
    }
    y= transpose(x,[4,6,3],[2,5]);
    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)) {
      goofs++;

      "**FAILURE** of transpose test 2";
    }

    x= y= [];

    if (do_stats) "H "+print(yorick_stats());

    /* ------------------------------------------------------------------------- */

    write, "Test struct instancing and indexing...";

    /* Test structs. */

    struct Stest {
      char a;
      short b;
      double c(4);
      int d(2,3), e(5);
      complex f(2);
    }

    x= Stest(a='A', b=13, c=[2,-4,6,-8],
    	 d=[[-1,2],[-3,4],[-5,6]], e=[10,20,30,40,50], f=[1i,2-2i]);

    if (x.a!='A' || x.b!=13 || anyof(x.c!=[2.,-4.,6.,-8.]) ||

        anyof(x.d!=[[-1,2],[-3,4],[-5,6]]) || anyof(x.e!=[10,20,30,40,50]) ||
        anyof(x.f!=[1i,2-2i])) {
      goofs++;
      "**FAILURE** of - struct instance declaration";
    }

    y= array(Stest, 2);
    y(..)= x;
    y.a(2)= 'B';
    y(2).b= -x.b;
    y.c(..,2)= x.c(::-1);

    y(2).d(,1:2)= transpose(x.d(,1:2));
    y.e(::-1,2)= x.e;
    y(2).f= conj(x.f);

    if (x!=y(1) || y(2).a!='B' || y(2).b!=-13 || anyof(y(2).c!=[-8.,6.,-4.,2.]) ||

        anyof(y(2).d!=[[-1,-3],[2,4],[-5,6]]) ||

        anyof(y(2).e!=[50,40,30,20,10]) || anyof(y(2).f!=[-1i,2+2i])) {
      goofs++;

      "**FAILURE** of - struct instance array indexing";
    }

    x= y= [];

    if (do_stats) "I "+print(yorick_stats());

    /* ------------------------------------------------------------------------- */

    write, "Test range functions...";

    /* Test range functions. */

    x= [[[3,7,5],[-4,2,-6]], [[-1,-4,-2],[0,4,8]],
        [[-1,-5,2],[1,0,0]], [[9,8,7],[-9,9,-6]]];
    y= x+0.5;

    if (anyof(x(,-:1:2,,1)!=[[[3,7,5],[3,7,5]],[[-4,2,-6],[-4,2,-6]]])) {
      goofs++;

      "**FAILURE** of - pseudo range function (-)";
    }

    if (anyof(x(,..)!=x) || anyof(x(..,:)!=x) || anyof(x(,*)!=x(,1:8)) ||
        anyof(x(*,)!=x(1:6,1,))) {
      goofs++;

      "**FAILURE** of - rubber range function (.. or *)";
    }

    if (anyof(x(,pcen,)(,uncp,)!=x) || anyof(y(,pcen,)(,uncp,)!=y)) {
      goofs++;

      "**FAILURE** of - uncp range function";
    }

    if (anyof(x(,pcen,)(,2:-1,)!=x(,zcen,)) ||

        anyof(x(,pcen,)(,1,)!=x(,1,)) || anyof(x(,pcen,)(,0,)!=x(,0,)) ||
        anyof(y(,pcen,)!=x(,pcen,)+0.5)) {
      goofs++;

      "**FAILURE** of - pcen range function";
    }

    if (anyof(x(,zcen,)!=[[[-.5,4.5,-.5]],[[-.5,0,3]],
    		      [[0,-2.5,1]],[[0,8.5,.5]]]) ||

        anyof(y(,zcen,)!=[[[-.5,4.5,-.5]],[[-.5,0,3]],
    		      [[0,-2.5,1]],[[0,8.5,.5]]] + 0.5)) {
      goofs++;

      "**FAILURE** of - zcen range function";
    }

    if (anyof(x(,dif,)!=[[[-7,-5,-11]],[[1,8,10]],[[2,5,-2]],[[-18,1,-13]]]) ||

        anyof(y(,dif,)!=[[[-7,-5,-11]],[[1,8,10]],[[2,5,-2]],[[-18,1,-13]]])) {
      goofs++;

      "**FAILURE** of - dif range function";
    }

    if (anyof(x(,psum,)!=[[[3,7,5],[-1,9,-1]], [[-1,-4,-2],[-1,0,6]],
    		      [[-1,-5,2],[0,-5,2]], [[9,8,7],[0,17,1]]]) ||

        anyof(y(,psum,)!=[[[3,7,5],[-1,9,-1]], [[-1,-4,-2],[-1,0,6]],
    		      [[-1,-5,2],[0,-5,2]], [[9,8,7],[0,17,1]]] +
    	  [0.5,1.0](-,))) {
      goofs++;

      "**FAILURE** of - psum range function";
    }

    if (anyof(x(,cum,)!=[[[0,0,0],[3,7,5],[-1,9,-1]],
    		     [[0,0,0],[-1,-4,-2],[-1,0,6]],
    		     [[0,0,0],[-1,-5,2],[0,-5,2]],
    		     [[0,0,0],[9,8,7],[0,17,1]]]) ||

        anyof(y(,cum,)!=[[[0,0,0],[3,7,5],[-1,9,-1]],
    		     [[0,0,0],[-1,-4,-2],[-1,0,6]],
    		     [[0,0,0],[-1,-5,2],[0,-5,2]],
    		     [[0,0,0],[9,8,7],[0,17,1]]] +
    	  [0.0,0.5,1.0](-,))) {
      goofs++;

      "**FAILURE** of - cum range function";
    }

    if (anyof(x(zcen,dif,)!=[[[-6,-8]],[[4.5,9]],[[3.5,1.5]],[[-8.5,-6]]]) ||

        anyof(y(zcen,dif,)!=[[[-6,-8]],[[4.5,9]],[[3.5,1.5]],[[-8.5,-6]]])) {
      goofs++;

      "**FAILURE** of - zcen,dif multiple range function";
    }

    if (anyof(x(min,,max)!=[7,0]) || anyof(y(,,max)(min,)!=[7,1]+0.5)) {
      goofs++;

      "**FAILURE** of - min or max range function";
    }

    if (anyof(x(,ptp,)!=[[-7,-5,-11],[1,8,10],[2,5,-2],[-18,1,-13]]) ||

        anyof(y(,ptp,)!=[[-7,-5,-11],[1,8,10],[2,5,-2],[-18,1,-13]])) {
      goofs++;

      "**FAILURE** of - ptp range function";
    }

    if (anyof(x(,mnx,)!=[[2, 2, 2], [1, 1, 1], [1, 1, 2], [2, 1, 2]]) ||

        anyof(y(,mnx,)!=[[2, 2, 2], [1, 1, 1], [1, 1, 2], [2, 1, 2]])) {
      goofs++;

      "**FAILURE** of - mnx range function";
    }

    if (anyof(x(,mxx,)!=3-x(,mnx,)) ||
        anyof(y(,mxx,)!=3-y(,mnx,))) {
      goofs++;

      "**FAILURE** of - mxx range function";
    }

    if (anyof(x(,sum,)!=x(,1,)+x(,2,)) ||

        anyof(y(,sum,)!=y(,1,)+y(,2,))) {
      goofs++;

      "**FAILURE** of - sum range function";
    }

    if (anyof(x(,avg,)!=0.5*(x(,1,)+x(,2,))) ||

        anyof(y(,avg,)!=0.5*(y(,1,)+y(,2,)))) {
      goofs++;

      "**FAILURE** of - avg range function";
    }

    if (anyof(abs(x(,rms,)-0.5*abs(x(,1,)-x(,2,)))>1.e-10) ||

        anyof(abs(y(,rms,)-0.5*abs(y(,1,)-y(,2,)))>1.e-10)) {
      goofs++;

      "**FAILURE** of - rms range function";
    }

    x= [[1,2,3],[-5,5,-8]];
    y= [[1,1],[-1,-1],[0,1]];

    if (anyof(x(+,)*y(,+) != [[-1,-10],[2,-18]]) ||

        anyof(x(,+)*y(+,) != [[-4,7,-5],[4,-7,5],[-5,5,-8]])) {
      goofs++;
      "**FAILURE** of + matrix multiply function";
    }

    x+= 0i;

    if (anyof(x(+,)*y(,+) != [[-1,-10],[2,-18]]) ||

        anyof(x(,+)*y(+,) != [[-4,7,-5],[4,-7,5],[-5,5,-8]])) {
      goofs++;
      "**FAILURE** of + complex matrix multiply function";
    }

    /* first test matrix multiply conformability rules
       -- this will just blow up if there's a problem */
    rop= lop= array(0., 4, 3, 2);

    dst= lop(+,,)*rop(+,,) + array(0., 3,2,3,2);

    dst= lop(,+,)*rop(,+,) + array(0., 4,2,4,2);

    dst= lop(,,+)*rop(,,+) + array(0., 4,3,4,3);
    rop= transpose(rop, 2);

    dst= lop(+,,)*rop(,+,) + array(0., 3,2,2,3);

    dst= lop(,+,)*rop(,,+) + array(0., 4,2,2,4);

    dst= lop(,,+)*rop(+,,) + array(0., 4,3,4,3);
    rop= transpose(rop, 2);

    dst= lop(+,,)*rop(,,+) + array(0., 3,2,3,2);

    dst= lop(,+,)*rop(+,,) + array(0., 4,2,2,4);

    dst= lop(,,+)*rop(,+,) + array(0., 4,3,3,4);

    /* next, try to exercise all the branches of the matrix
       multiply routines -- test all five dimensions,

       plus unit length leading dimension (special branch) */
    lop= [[[1,2],[3,4]],[[5,6],[7,8]]];
    rop= lop+10;
    dst1= lop(,+,)*rop(,+,);
    dst2= lop(1,+,)*rop(,+,);
    if (anyof(dst1!=
    	  [[[[50,74],[146,170]],[[54,80], [158,184]]],
    	  [[[66,98],[194,226]],[[70,104],[206,240]]]]) ||
        anyof(dst2!=
    	  [[[50,146],[54,158]],[[66,194],[70,206]]])) {
      goofs++;
      "**FAILURE** of + matrix multiply function";
    }

    lop+= 0i;
    rop+= 0i;

    dst1= lop(,+,)*rop(,+,);
    dst2= lop(1,+,)*rop(,+,);
    if (anyof(dst1!=
    	  [[[[50,74],[146,170]],[[54,80], [158,184]]],
    	  [[[66,98],[194,226]],[[70,104],[206,240]]]]) ||
        anyof(dst2!=
    	  [[[50,146],[54,158]],[[66,194],[70,206]]])) {
      goofs++;
      "**FAILURE** of + complex matrix multiply function";
    }

    x= y= lop= rop= dst1= dst2= [];

    if (do_stats) "J "+print(yorick_stats());

    /* ------------------------------------------------------------------------- */

    write, "Test math functions...";

    /* Test math functions. */

    x= pi/4;  y= [3*pi/4, pi/6];

    if (not_near(sin(x),sqrt(0.5)) || not_near(sin(y),[sqrt(0.5),0.5]) ||

        not_near(cos(x),sqrt(0.5)) || not_near(cos(y),[-sqrt(0.5),sqrt(.75)]) ||

        not_near(tan(x),1) || not_near(tan(y),[-1,1/sqrt(3)])) {
      goofs++;

      "**FAILURE** of - sin, cos, tan, or sqrt function";
    }

    if (not_near(asin(sqrt(0.5)),x) ||

        not_near(asin([sqrt(0.5),0.5]),y-[pi/2,0]) ||

        not_near(acos(sqrt(0.5)),x) || not_near(acos([-sqrt(0.5),sqrt(.75)]),y) ||

        not_near(atan(1),x) || not_near(atan([-1,1/sqrt(3)]),y-[pi,0])) {
      goofs++;

      "**FAILURE** of - asin, acos, atan, or sqrt function";
    }

    if (not_near(atan(5,5),x) || not_near(atan([.1,1],[-.1,sqrt(3)]),y)) {
      goofs++;

      "**FAILURE** of - 2 argument atan function";
    }

    if (not_near(exp(1i*x),cos(x)+1i*sin(x)) ||

        not_near(exp(1i*y),cos(y)+1i*sin(y)) ||

        not_near(cos(1i*x), 0.5*(exp(-x)+exp(x))) ||

        not_near(cos(1i*y), 0.5*(exp(-y)+exp(y))) ||

        not_near(sin(1i*x), 0.5i*(exp(x)-exp(-x))) ||

        not_near(sin(1i*y), 0.5i*(exp(y)-exp(-y))) ||

        not_near(tan(1i*x), 1i*(exp(x)-exp(-x))/(exp(-x)+exp(x))) ||

        not_near(tan(1i*y), 1i*(exp(y)-exp(-y))/(exp(-y)+exp(y)))) {
      goofs++;

      "**FAILURE** of - (complex) exp, sin, cos, or tan function";
    }

    if (not_near(exp(1),2.718281828459) ||

        not_near(exp([-.5,2.5]), [1,exp(1)^3]/sqrt(exp(1))) ||

        not_near(exp(x),cosh(x)+sinh(x)) ||

        not_near(exp(y),cosh(y)+sinh(y)) ||

        not_near(cosh(x), 0.5*(exp(-x)+exp(x))) ||

        not_near(cosh(y), 0.5*(exp(-y)+exp(y))) ||

        not_near(sinh(x), 0.5*(exp(x)-exp(-x))) ||

        not_near(sinh(y), 0.5*(exp(y)-exp(-y))) ||

        not_near(tanh(x), (exp(x)-exp(-x))/(exp(-x)+exp(x))) ||

        not_near(tanh(y), (exp(y)-exp(-y))/(exp(-y)+exp(y)))) {
      goofs++;

      "**FAILURE** of -  exp, sinh, cosh, or tanh function";
    }

    if (not_near(sech(x), 2/(exp(-x)+exp(x))) ||

        not_near(sech(y), 2/(exp(-y)+exp(y))) ||

        not_near(csch(x), 2/(exp(x)-exp(-x))) ||

        not_near(csch(y), 2/(exp(y)-exp(-y))) ||

        anyof(sech([1.e6,-1.e6])) || anyof(csch([1.e6,-1.e6]))) {
      goofs++;

      "**FAILURE** of -  sech or csch function";
    }

    if (not_near(acosh(cosh(x)), x) || not_near(acosh(cosh(y)), y) ||

        not_near(asinh(sinh(x)), x) || not_near(asinh(sinh(y)), y) ||

        not_near(atanh(tanh(x)), x) || not_near(atanh(tanh(y)), y)) {
      goofs++;

      "**FAILURE** of -  acosh, asinh, or atanh function";
    }

    if (not_near(exp(1i*x),cosh(1i*x)+sinh(1i*x)) ||

        not_near(exp(1i*y),cosh(1i*y)+sinh(1i*y)) ||

        not_near(cosh(1i*x), 0.5*(exp(-1i*x)+exp(1i*x))) ||

        not_near(cosh(1i*y), 0.5*(exp(-1i*y)+exp(1i*y))) ||

        not_near(sinh(1i*x), 0.5*(exp(1i*x)-exp(-1i*x))) ||

        not_near(sinh(1i*y), 0.5*(exp(1i*y)-exp(-1i*y))) ||

        not_near(tanh(1i*x), (exp(1i*x)-exp(-1i*x))/(exp(-1i*x)+exp(1i*x))) ||

        not_near(tanh(1i*y), (exp(1i*y)-exp(-1i*y))/(exp(-1i*y)+exp(1i*y)))) {
      goofs++;

      "**FAILURE** of -  (complex) exp, sinh, cosh, or tanh function";
    }

    if (not_near(log(exp(x)), x) || not_near(log(exp(y)), y) ||

        not_near(log10(10^x), x) || not_near(log10(10^y), y) ||

        not_near(log10(x*y),log10(x)+log10(y)) ||

        not_near(log(x*y),log(x)+log(y)) ||

        not_near(exp(x+y),exp(x)*exp(y)) ||

        not_near(log10([1.e5,1.e-7]),[5,-7]) ||

        not_near(log(10),1/log10(exp(1))) ||

        not_near(log(10)*log10(x),log(x)) || not_near(log(10)*log10(y),log(y))) {
      goofs++;

      "**FAILURE** of -  log, log10, or exp function";
    }

    if (anyof(abs(x)!=x) || anyof(abs(-x)!=x) ||

        anyof(abs(y)!=y) || anyof(abs(-y)!=y)) {
      goofs++;
      "**FAILURE** of -  abs function";
    }

    if (anyof(ceil(3.7)!=4) || anyof(ceil([-3.7,2.1])!=[-3,3]) ||

        anyof(floor(3.7)!=3) || anyof(floor([-3.7,2.1])!=[-4,2])) {
      goofs++;

      "**FAILURE** of -  ceil or floor function";
    }

    if (not_near(abs(x,y,x,y),sqrt(2*(x^2+y^2)))) {
      goofs++;

      "**FAILURE** of -  multiargument abs function";
    }

    if (anyof(sign(x)!=1) || anyof(sign(-x)!=-1) ||

        anyof(sign(y)!=1) || anyof(sign(-y)!=-1) ||

        sign(0)!=1 || sign(0.0)!=1 || sign(0i)!=1 ||

        not_near(sign(exp(1i*y+x)),exp(1i*y))) {
      goofs++;
      "**FAILURE** of -  sign function";
    }

    if (conj(x+1i)!=x-1i || anyof(conj(y+1i)!=y-1i)) {
      goofs++;
      "**FAILURE** of -  conj function";
    }

    if (random()<0.0 || random()>1.0 ||

        anyof(dimsof(random(3,4,2))!=[3,3,4,2])) {
      goofs++;

      "**FAILURE** of -  random function";
    }

    if (min(x)!=x || min(y)!=pi/6 || anyof(min(x,y)!=[pi/4,pi/6]) ||

        max(x)!=x || max(y)!=3*pi/4 || anyof(max(x,y)!=[3*pi/4,pi/4])) {
      goofs++;

      "**FAILURE** of -  min or max function";
    }

    if (sum(x)!=x || not_near(sum(y), 11*pi/12) ||

        avg(x)!=x || not_near(avg(y), 11*pi/24)) {
      goofs++;

      "**FAILURE** of -  sum or avg function";
    }

    if (allof([1,0]) || !allof([1,1]) || anyof([0,0]) || !anyof([1,0]) ||

        noneof([1,0]) || !noneof([0,0]) || nallof([1,1]) || !nallof([1,0])) {
      goofs++;

      "**FAILURE** of -  allof, anyof, noneof, or nallof function";
    }

    if (anyof(where([[0,1,0,0],[0,0,0,1]])!=[2,8]) ||

        anyof(where2([[0,1,0,0],[0,0,0,1]])!=[[2,1],[4,2]])) {
      goofs++;

      "**FAILURE** of -  where or where2 function";
    }

    x= Stest(a='A', b=13, c=[2,-4,6,-8],
    	 d=[[-1,2],[-3,4],[-5,6]], e=[10,20,30,40,50], f=[1i,2-2i]);
    y= array(x, 2);
    y(1).b= 8;  y(2).b=19;

    if (anyof(merge(cA,iS,[1,1,0])!=[1,2,1]) ||

        anyof(merge(lS,sA,[0,0,1])!=[1,2,1]) ||

        anyof(merge(iA,dS,[1,0,1])!=[1,1,2]) ||

        anyof(merge(lA,fA,[[1,1],[0,0]])!=[[1,2],[1,2]]) ||

        anyof(merge(zA,dA,[[1,0],[0,1]])!=[[1,1],[2,2]]) ||

        anyof(merge(cA,cA,[[1,0],[0,1]])!=[[1,1],[2,2]]) ||

        anyof(merge(sA,sA,[[1,0],[0,1]])!=[[1,1],[2,2]]) ||

        anyof(merge(y,x,[1,0,1])!=[y(1),x,y(2)]) ||

        anyof(merge(dA,[],[1,1])!=dA) ||

        anyof(merge([],lA,[0,0])!=lA) ||

        anyof(merge2(lA,zA(::-1),[1,0])!=[1,1])) {
      goofs++;

      "**FAILURE** of -  merge or merge2 function";
    }
    x= y= [];

    if (do_stats) "K "+print(yorick_stats());

    /* ------------------------------------------------------------------------- */

    write, "Test informational functions...";

    /* Test informational functions. */

    if (structof(3.5)!=double || structof('\61')!=char ||

        structof([4,5,6])!=long || structof([1n,-1n])!=int ||

        structof([3s,4s])!=short || structof(4.4f)!=float ||

        structof(1i)!=complex || structof(array(Stest,2,2))!=Stest ||

        structof([&[1,2,3],&[],&[3.5,1.2]])!=pointer || structof("yo")!=string) {
      goofs++;

      "**FAILURE** of - structof function or structure != operation";
    }

    if (anyof(dimsof([[2,4,6],[1,3,5]])!=[2,3,2]) || anyof(dimsof(5)!=[0]) ||

        anyof(dimsof(array(short,5,-4:-1,3:5,0:1))!=[4,5,4,3,2]) ||

        anyof(dimsof([1,2,3](-,),[1,2])!=[2,2,3])) {
      goofs++;
      "**FAILURE** of - dimsof function";
    }

    dummy= use_origins(1);

    if (anyof(orgsof([[2,4,6],[1,3,5]])!=[2,indgen(0),indgen(0)]) ||

        anyof(orgsof(array(short,5,-4:-1,3:5,0:1))!=[4,indgen(0),-4,3,0])) {
      goofs++;
      "**FAILURE** of - orgsof function";
    }
    dummy= [];

    if (numberof([[2,4,6],[1,3,5]])!=6 || numberof(3.5)!=1 || numberof([])!=0 ||

        numberof(array(short,5,-4:-1,3:5,0:1))!=120) {
      goofs++;

      "**FAILURE** of - numberof function";
    }

    if (sizeof([[2,4,6],[1,3,5]])!=6*sizeof(long) || sizeof(3.5)!=sizeof(double) ||

        sizeof(array(short,5,-4:-1,3:5,0:1))!=120*sizeof(short)) {
      goofs++;
      "**FAILURE** of - sizeof function";
    }

    if (typeof(3.5)!="double" || typeof('\61')!="char" ||

        typeof([4,5,6])!="long" || typeof([1n,-1n])!="int" ||

        typeof([3s,4s])!="short" || typeof(4.4f)!="float" ||

        typeof(1i)!="complex" || typeof(array(Stest,2,2))!="struct_instance" ||

        typeof(Stest)!="struct_definition" || typeof(3:52:4)!="range" ||

        typeof([])!="void" || typeof()!="void" || typeof("yo")!="string" ||
        typeof(&[3,4])!="pointer") {
      goofs++;
      "**FAILURE** of - typeof function";
    }

    if (nameof(Stest)!="Stest" || nameof(not_near)!="not_near") {
      goofs++;
      "**FAILURE** of - nameof function";
    }

    if (!is_array([3,4]) || !is_array(0) || is_array() || is_array(not_near) ||

        is_array(Stest)) {
      goofs++;

      "**FAILURE** of - is_array function";
    }

    if (is_void(7) || !is_void() || !is_void([]) || is_void(not_near)) {
      goofs++;

      "**FAILURE** of - is_void function";
    }

    if (is_func(7) || is_func() || !is_func(not_near) || is_func(Stest)) {
      goofs++;

      "**FAILURE** of - is_func function";
    }

    if (is_struct(7) || is_struct() || is_struct(not_near) ||

        !is_struct(Stest)) {
      goofs++;

      "**FAILURE** of - is_struct function";
    }

    if (is_range(7) || is_range() || is_range(not_near) ||

        is_range(Stest) || !is_range(3:4)) {
      goofs++;

      "**FAILURE** of - is_range function";
    }

    func junk(x)
    {
      extern junk_test;

      return junk_test= am_subroutine();
    }
    junk_test= 0;
    junk;
    if (!junk_test || junk()) {
      goofs++;

      "**FAILURE** of - am_subroutine function";
    }

    if (do_stats) "L "+print(yorick_stats());

    /* ------------------------------------------------------------------------- */

    write, "Test func declarations...";

    /* Test func declarations. */

    func junk(&w,x,&y,z,..,k=,l=,m=)
    {
      rslt= [w,x,y,z,k,l,m];

      while (more_args()) grow, rslt, next_arg();
      w=x=y=z=k=l=m=16;
      return rslt;
    }
    a= b= c= d= -2;

    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])
        || a!=16 || b!=-2 || c!=-2 || d!=-2) {
      goofs++;
      "**FAILURE** of - complicated func declaration";
    }
    junk= [];

    /* ------------------------------------------------------------------------- */

    write, "Test binary I/O functions...";

    /* Test binary I/O functions. */

    f= createb("junkb.pdb");

    if (is_stream(7) || is_stream() || is_stream(not_near) ||

        is_stream(Stest) || !is_stream(f)) {
      goofs++;

      "**FAILURE** of - is_stream function";
    }

    x= ["whoa", "okay"];
    y= [&(1+0), &[1.5,2.5,3.5], &[]];
    z= Stest(a='A', b=13, c=[2,-4,6,-8],
    	 d=[[-1,2],[-3,4],[-5,6]], e=[10,20,30,40,50], f=[1i,2-2i]);

    save, f, x, y, z;
    close, f;
    f= updateb("junkb.pdb");
    save, f, iS, lS, dS;
    save, f, cA, sA, iA, lA, fA, dA, zA;
    f.sA= [-91,57];
    close, f;

    f= openb("junkb.pdb");
    x= y= z= [];
    restore, f, x, y, z;

    if (typeof(x)!="string" || typeof(y)!="pointer" ||

        anyof(dimsof(x)!=[1,2]) || anyof(dimsof(y)!=[1,3]) ||

        anyof(x!=["whoa", "okay"]) || typeof(*y(1))!="long" ||

        !is_void(*y(3)) || anyof(*y(2)!=[1.5,2.5,3.5]) ||

        structof(z)!=Stest || z.a!='A' || anyof(dimsof(z.d)!=[2,2,3]) ||

        anyof(dimsof(z.f)!=[1,2]) || anyof(z.f!=[1i,2-2i])) {
      goofs++;

      "**FAILURE** of - restore or save function";
    }
    if (f.iS!=iS || f.lS!=lS || f.dS!=dS ||

        anyof(f.cA!=cA) || anyof(f.sA!=[-91,57]) || anyof(f.iA!=iA) ||

        anyof(f.lA!=lA) || anyof(f.fA!=fA) || anyof(f.dA!=dA) ||

        anyof(f.zA!=zA) || typeof(f.cA)!="char" || typeof(f.sA)!="short" ||

        typeof(f.iA)!="int" || typeof(f.lA)!="long" || typeof(f.fA)!="float" ||

        typeof(f.dA)!="double" || typeof(f.zA)!="complex") {
      goofs++;

      "**FAILURE** of - f.var syntax or save function";
    }
    close, f;

    remove, "junkb.pdb";

    /* try reading and writing a netCDF file */
    write, "Test binary I/O to netCDF...";

    require, "netcdf.i";
    f= nc_create("junkb.nc");

    nc_vardef,f, "lS", template=lS, record=1;
    nc_vardef,f, "dS", template=dS;
    nc_vardef,f, "cA", template=cA;
    nc_vardef,f, "sA", template=sA;

    nc_vardef,f, "lA", template=lA, record=1;
    nc_vardef,f, "fA", template=fA;

    nc_vardef,f, "dA", template=dA, record=1;
    f= nc_enddef(f);
    f.dS= dS;  f.cA= cA;  f.sA= sA;  f.fA= fA;
    nc_addrec, f;
    save,f, lS,lA,dA;
    nc_addrec, f;
    save,f, lS,lA,dA;
    nc_addrec, f;
    save,f, lS,lA,dA;
    close, f;
    remove, "junkb.ncL";

    f= openb("junkb.nc");
    if (f.lS!=lS || f.dS!=dS ||

        anyof(f.cA!=cA) || anyof(f.sA!=sA) ||

        anyof(f.lA!=lA) || anyof(f.fA!=fA) || anyof(f.dA!=dA) ||

        typeof(f.cA)!="char" || typeof(f.sA)!="short" ||

        typeof(f.lA)!="long" || typeof(f.fA)!="float" ||
        typeof(f.dA)!="double") {
      goofs++;

      "**FAILURE** of - f.var syntax or save to netCDF";
    }

    jr,f, 3;

    if (f.lS!=lS ||  anyof(f.lA!=lA) || anyof(f.dA!=dA)) {
      goofs++;

      "**FAILURE** of - f.var syntax or save to netCDF";
    }

    close, f;
    remove, "junkb.nc";

    if (do_stats) "M "+print(yorick_stats());

    /* ------------------------------------------------------------------------- */

    write, "Test ASCII I/O functions...";

    /* Test ASCII I/O functions. */

    f= open("junkt.txt", "w");
    write,f, "The first line.";
    write,f, dA;
    write,f, sA-7, fA+5;

    write,f, format="blah %s %d %e\n", "wow", lA+6, dA-20;
    close,f;

    f= open("junkt.txt", "r+");
    if (rdline(f)!=" The first line.") {
      goofs++;

      "**FAILURE** of - rdline or write function";
    }
    backup, f;
    if (rdline(f)!=" The first line.") {
      goofs++;
      "**FAILURE** of - backup function";
    }
    mark= bookmark(f);
    x= 0*dA;

    if (read(f,x)!=2 || anyof(x!=dA)) {
      goofs++;

      "**FAILURE** of - read or write function";
    }
    y= 0*sA;

    if (read(f,y,x)!=4 || anyof(y!=sA-7) || anyof(x!=fA+5)) {
      goofs++;

      "**FAILURE** of - read or write function ";
    }
    y= 0*lA;
    mark2= bookmark(f);

    if (read(f, format="blah wow %d %e\n", y,x)!=4 ||

        anyof(y!=lA+6) || anyof(x!=dA-20)) {
      backup, f, mark2;

      if (read(f, format="blah wow %d %e", y,x)!=4 ||

          anyof(y!=lA+6) || anyof(x!=dA-20)) {
        goofs++;

        "**FAILURE** of -  formatted read or write function";
      } else {

        /* this OS does not like trailing \n in read formats */

        "**WARNING** Yorick formatted read peculiarity -- see testp.i";
      }
    }
    backup, f, mark;

    if (read(f,x)!=2 || anyof(x!=dA)) {
      goofs++;

      "**FAILURE** of -  bookmark or backup function";
    }
    write,f, "Last line.";
    close, f;
    f= open("junkt.txt");
    if (rdline(f,7)(7)!=" Last line.") {
      goofs++;

      "**FAILURE** of -  write to append to end of text";
    }
    close, f;

    remove, "junkt.txt";

    if (do_stats) "N "+print(yorick_stats());

    /* ------------------------------------------------------------------------- */

    write, "Test string manipulation functions...";

    /* Test string manipulation functions. */

    if (strlen("abc")!=3 ||

        anyof(strlen([[string(),"","a"],["axx","ab","abcd"]])!=
    	  [[0,0,1],[3,2,4]])) {
      goofs++;
      "**FAILURE** of - strlen function";
    }

    if (anyof(strtok("abc    1.23    xxx")!=["abc", "   1.23    xxx"]) ||

        anyof(strtok(["abc    1.23    xxx","c","1.5"], "\t c")!=
    	  [["ab", "    1.23    xxx"],string(),["1.5",string()]])) {
      goofs++;
      "**FAILURE** of - strtok function";
    }

    if (!strmatch("abc", "b") || strmatch("abc", "B") ||
        !strmatch("abc", "B", 1) ||

        anyof(strmatch(["abc","aBC"], "B")!=[0,1])) {
      goofs++;

      "**FAILURE** of - strmatch function";
    }

    if (strpart("abc", 1:1)!="a" || strpart("abc", 2:10)!="bc" ||

        strpart("abc", :-1)!="ab" || strpart("abc", :-5)!="" ||

        anyof(strpart(["abc","yowza"],3:)!=["c","wza"])) {
      goofs++;

      "**FAILURE** of - strpart function";
    }

    if (do_stats) "O "+print(yorick_stats());

    /* ------------------------------------------------------------------------- */

    write, "Test list functions...";

    l= _lst(1.5, structof(z), _lst([],z), _prt);
    #if 0

    write, "<Begin output from _prt list (15 lines gibberish)>";
    _prt, l;

    write, "<End output from _prt list (15 lines gibberish)>";
    #endif
    if (_len(l)!=4) {
      goofs++;

      "**FAILURE** of - _lst or _len function";
    }

    if (_car(l)!=1.5 || _car(l,1)!=1.5 || _car(l,2)!=Stest ||

        typeof(_car(l,3))!="list" || _car(l,4)!=_prt ||

        !is_void(_car(_car(l,3)))) {
      goofs++;

      "**FAILURE** of - _lst or _car function";
    }

    if (_car(_cdr(l))!=Stest || _car(_cdr(l,3))!=_prt ||

        !is_void(_cdr(l,4))) {
      goofs++;
      "**FAILURE** of - _cdr function";
    }
    m= _cpy(l,2);

    if (_len(m)!=2 || _car(m)!=1.5 || _car(m,2)!=Stest || _len(_cpy(l))!=4) {
      goofs++;
      "**FAILURE** of - _cpy function";
    }

    if (_car(m,2,2.5)!=Stest || _car(l,2)!=Stest || _car(m,2)!=2.5) {
      goofs++;
      "**FAILURE** of - _car set function";
    }

    n= _cat(m, _cpy(_cdr(l,2)));

    if (n!=m || _len(m)!=4 || _len(n)!=4 || _car(n,4)!=_prt) {
      goofs++;
      "**FAILURE** of - _cat function";
    }

    if (_car(_cdr(m,3,[]))!=_prt || !is_void(_cdr(n,3)) ||

        !is_void(_cdr(n,3,_lst(_len))) || _car(m,4)!=_len ||

        _car(l,4)!=_prt) {
      goofs++;
      "**FAILURE** of - _cdr set function";
    }

    n= _map(typeof, m);

    if (_car(n)!="double" || _car(n,2)!="double" ||

        _car(n,3)!="list" || _car(n,4)!="builtin") {
      goofs++;
      "**FAILURE** of - _map set function";
    }
    m= _rev(m);

    if (_car(m,4)!=1.5 || _car(m,3)!=2.5 ||

        typeof(_car(m,2))!="list" || _car(m)!=_len ||

        !is_void(_car(_car(m,2)))) {
      goofs++;
      "**FAILURE** of - _rev function";
    }
    l= m= n= [];

    if (do_stats) "P "+print(yorick_stats());

    /* ------------------------------------------------------------------------- */

    write, "Test catch function...";

    func junk(type)
    {
      if (catch(0x01)) {
        if (type!=0x01) {
          goofs++;

          "**FAILURE** of - catch function - misidentified error as math";
        }
        return 0x01;
      }
      if (catch(0x02)) {
        if (type!=0x02) {
          goofs++;

          "**FAILURE** of - catch function - misidentified error as io";
        }
        return 0x02;
      }
      if (catch(0x04)) {
        if (type!=0x04) {
          goofs++;

          "**FAILURE** of - catch function - misidentified error as C-c";
        }
        return 0x04;
      }
      if (catch(0x08)) {
        if (type!=0x08) {
          goofs++;

          "**FAILURE** of - catch function - misidentified error as YError";
        }
        return 0x08;
      }
      if (catch(0x10)) {
        if (type!=0x10) {
          goofs++;

          "**FAILURE** of - catch function - misidentified error as interpreted";

        } else if (catch_message!="---test error, should be caught---") {
          goofs++;

          "**FAILURE** of - catch function - catch_message set incorrectly";
        }
        return 0x10;
      }
      if (type==0x01) x= 1.0/0.0;

      if (type==0x02) f= open("no-such-file-ever-existed");

      if (type==0x04) return 0x04; /* need user to hit C-c */
      if (type==0x08) x= 1.0*[];

      if (type==0x10) error, "---test error, should be caught---";
      return 0;
    }

    if (!junk(0x01)) "**WARNING** 1.0/0.0 does not trigger SIGFPE";
    if (!junk(0x02)) {
      goofs++;

      "**FAILURE** of - catch function - I/O error not caught";
    }
    if (!junk(0x08)) {
      goofs++;

      "**FAILURE** of - catch function - compiled error not caught";
    }
    if (!junk(0x10)) {
      goofs++;

      "**FAILURE** of - catch function - interpreted error not caught";
    }

    junk= [];

    if (do_stats) "Q "+print(yorick_stats());

    /* ------------------------------------------------------------------------- */

    iS= lS= dS= cA= sA= iA= lA= fA= dA= zA= [];

    write, format= "End of Yorick parser test, %d goofs\n", goofs;

    if (!skip_testb) {
      require, "testb.i";

      write,"\n Zeroth test is pdtest files:";  pdcheck2;  write,"";
      testb;
    }

    /* write if tests twice so that include actually takes place */
    if (!skip_test1) include, "test1.i";

    if (!skip_test1) { write,"\nShock tracker timing test:";  test1, 20; }

    if (!skip_test2) include, "test2.i";

    if (!skip_test2) { write,"\nEscape factor timing test:";  test2, 15; }

    if (!skip_test3) include, "test3.i";

    if (!skip_test3) { write,"\nZone generator timing test:";  test3, 100; }