home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 June / SIMTEL_0692.cdr / msdos / snobol4 / aisnobol.arc / TEST.SPT < prev    next >
Encoding:
Text File  |  1987-10-11  |  17.6 KB  |  818 lines
  1. * TEST.SPT - SPITBOL VERSION
  2. *
  3. * To run this test program:
  4. *     a)  have copies of test.spt, snocore.spt, and snolib.spt
  5. *         under your default directory.
  6. *     b)  type
  7. *           spitbol spitcore.spt test.spt <test.in
  8. *
  9. *
  10. * Tests of single-argument numerical functions
  11. *     SNOLISPIST
  12. *
  13. * PAWS = *?( |'' |'Press ENTER to continue.'
  14. *+     |'' IN()    |(COLLECT() * 4 ' bytes available' |'') |'' )
  15.  PAWS = *?( |'' )
  16.  DEXP('PAUSE() = EVAL(PAWS)')
  17. *
  18.  ||''
  19.  ?( |'Single-argument numerical functions' |'' )
  20.  |'Incidentally uses MAPC, DEXP with LAMBDA, and EVALCODE'
  21.  |''
  22.  MAPC(DEXP('LAMBDA(EXPR) = '
  23. +          '|("     " EVALCODE( |EXPR))' ),
  24. +     'ABS(-15.9999)' ~
  25. +     'SIGN(0 - 4444.4444)' ~
  26. +     'ADD1(-1)' ~
  27. +     'SUB1(14456.9765)' ~
  28. +     'FLOAT(13 + 15 + 17)' ~
  29. +     'DFLOAT(17 - 15 - 13)' ~
  30. +     'FIX(P...I.)' ~
  31. +     'MINUS(LN...10.)' ~
  32. +     'ROUND(-8.5)' ~ NIL)
  33. *
  34.  PAUSE()
  35. *
  36. *
  37. * Tests of binary numerical functions
  38. *     SNOLISPIST
  39. *
  40. *
  41.  ||''
  42.  |'Binary numerical functions'
  43.  |''
  44.  MAPC(DEXP('LAMBDA(EXPR) = '
  45. +          '|("    " EVALCODE( |EXPR))' ),
  46. +     'ADD(P...I.,LN...10.)' ~
  47. +     'SUB(P...I.,LN...10.)' ~
  48. +     'MULT(P...I.,LN...10.)' ~
  49. +     'DIV(P...I.,LN...10.)' ~
  50. +     'MAX(1,-1)' ~
  51. +     'MIN(1,-1)' ~
  52. +     'REMAINDER(-44444444,119)' ~ NIL)
  53. *
  54.  PAUSE()
  55. *
  56. *
  57. * Tests of list-argument numerical functions
  58. *     SNOLISPIST
  59. *
  60.  ||''
  61.  |'List-argument numerical functions'
  62.  |''
  63.  |'Incidentally uses MAPCAR, LREVERSE, and READ'
  64.  |''
  65.  ARGUMENT.LIST =
  66. +     MAPCAR(.DFLOAT,
  67. +        LREVERSE(
  68. +             #'(1 1 2 -3 5 8 -13 21)' ))
  69.  ?( |'Here is the argument list: ' |'' )
  70.  |ARGUMENT.LIST
  71. *
  72.  PAUSE()
  73. *
  74.  MAPC(DEXP('LAMBDA(FUNCTION) = '
  75. +          '|("     " APPLY( |FUNCTION, ARGUMENT.LIST))' ),
  76. +     .PLUS ~
  77. +     .DIFFERENCE ~
  78. +     .TIMES ~
  79. +     .QUOTIENT ~
  80. +     NIL)
  81. *
  82.  PAUSE()
  83. *
  84. *
  85. * Tests of extended numerical functions
  86. *     SNOLISPIST
  87. *
  88. *
  89.  |''
  90.  |'Extended numerical functions'
  91.  |''
  92.  ?( |'Testing FLOOR' |'' )
  93.  AL = #'(-10.9 -7.9 -6.01 -0.00001 0.00001 6.01 7.9 10.9)'
  94.  |'Argument list = '
  95.  ?( |("     "   !AL) |'' )
  96.  |MAPCAR(.FLOOR,AL)
  97. *
  98.  PAUSE()
  99. *
  100.  |''
  101.  ?( |'Testing CEIL' |'' )
  102.  |'Argument list = '
  103.  ?( |("     "   !AL) |'' )
  104.  |MAPCAR(.CEIL,AL)
  105. *
  106.  PAUSE()
  107. *
  108.  |''
  109.  ?( |'Testing SQRT by inverse mapping' |'' )
  110.  AL = #'(1 10 100 1000 10000 100000 1000000 10000000)'
  111.  |'Argument list = '
  112.  ?( |("     "   !AL) |'' )
  113.  |MAPCAR(DEXP('LAMBDA(A) = ROUND(A * A)'),
  114. +     MAPCAR(.SQRT,AL))
  115. *
  116.  PAUSE()
  117. *
  118.  |''
  119.  |'Testing trigonometric and inverse trigonometric functions'
  120.  ?( |('     by inverse mapping') |'' )
  121.  AL = #( '(5 15 25 35 45 55 65 75 85 95 105 115 125 '
  122. +     '135 145 155 165 175 185 195 205 215 225 235 245 '
  123. +     '255 265 275 285 295 305 315 325 335 345 355)' )
  124.  |'Argument list = '
  125.  ?( |("     "   !AL) |'' )
  126.  ?( |'SIN and ASIN' |'' )
  127.  |MAPCAR(.ROUND,
  128. +     MAPCAR(.DEG,
  129. +        MAPCAR(.ASIN,
  130. +             MAPCAR(.SIN,
  131. +                  MAPCAR(.RAD,AL)))))
  132. *
  133.  PAUSE()
  134. *
  135.  ?( |'COS and ACOS' |'' )
  136.  |MAPCAR(.ROUND,
  137. +     MAPCAR(.DEG,
  138. +        MAPCAR(.ACOS,
  139. +             MAPCAR(.COS,
  140. +                  MAPCAR(.RAD,AL)))))
  141. *
  142.  PAUSE()
  143. *
  144.  ?( |'TAN and ATAN' |'' )
  145.  |MAPCAR(.ROUND,
  146. +     MAPCAR(.DEG,
  147. +        MAPCAR(.ATAN,
  148. +             MAPCAR(.TAN,
  149. +                  MAPCAR(.RAD,AL)))))
  150. *
  151.  PAUSE()
  152. *
  153.  |''
  154.  |'Logarithms to the base 2 of the first 30 powers of 2'
  155.  |''
  156.  I = 0 ; AL  = NIL  ; TWP = 1
  157. TWO.LOOP
  158.       I = LT(I,30) I + 1      :F(TWO.LOOP.END)
  159.       TWP = 2 * TWP
  160.       AL = TWP ~ AL      :(TWO.LOOP)
  161. TWO.LOOP.END
  162.       AL =  LREVERSE(AL)
  163. *
  164.  |MAPCAR(DEXP('LAMBDA(Z) = ROUND(LOG(Z,2))'), AL)
  165. *
  166.  PAUSE()
  167. *
  168.  |''
  169.  ?( |'The first 10 powers of e' |'' )
  170.  |MAPCAR(DEXP('LAMBDA(Z) = RAISE(NAT...BASE.,Z)' ),
  171. +     #'(1 2 3 4 5 6 7 8 9 10)' )
  172. *
  173.  PAUSE()
  174. *
  175.  |''
  176.  ?( |'The first 10 negative powers of e' |'' )
  177.  |MAPCAR(DEXP('LAMBDA(X) = RAISE(NAT...BASE., -X)' ),
  178. +     #'(1 2 3 4 5 6 7 8 9 10)' )
  179. *
  180.  PAUSE()
  181. *
  182. *
  183. * Test program for all compound CAR/CDR
  184. * functions in SNOLISPIST
  185. *
  186.  MNMNM = #'(1 2 3 4)'
  187. *
  188. * Build a reasonably hairy list
  189. *
  190.  LKLKL = #'((((\MNMNM) \MNMNM) \MNMNM) \MNMNM)'
  191.  MNMNM = #'(\LKLKL \LKLKL \LKLKL \LKLKL)'
  192.  LKLKL = LCOPY(MNMNM)
  193. *
  194.  ||''
  195.  |('LKLKL = ' !LKLKL)
  196.  |''
  197.  MAPC(DEXP('LAMBDA(S) = '
  198. +          '|EVAL( |(  "C" S "R(LKLKL)" ))' ),
  199. +     #('(A D AA AD DA DD '
  200. +       ' AAA AAD ADA DAA '
  201. +       ' ADD DAD DDA DDD '
  202. +       ' AAAA AAAD AADA ADAA DAAA '
  203. +       ' AADD ADAD DAAD ADDA DADA DDAA '
  204. +       ' ADDD DADD DDAD DDDA DDDD)' ))
  205. *
  206.  PAUSE()
  207. *
  208. *
  209. * SNOLISPIST I/O test program
  210. *
  211.      A = 'C' ; B = 'L' ; C = 'R'
  212. *
  213.      (|(11 % 'C.A') |'Centered.' ||'')
  214.      (|(11 % 'L.B') |'Left justified.'  ||'')
  215.      (|(11 % 'R.C') |'Right justified.'  ||'')
  216.   L = #'(A CENTERED LIST)'
  217. *
  218.   (|(72 % 'C.L') |'A centered list.' ||'')
  219. *
  220.  (|'Test of indentation via % operator.' |'')
  221.  ?( |'Outline Level I' |'' )
  222.  ?( |(5 % ' '   'Outline Level I.A') |'' )
  223.  ?( |(10 % ' '   'Outline Level I.A.1') |'' )
  224.  ?( |(15 % ' '   'Outline Level I.A.1.a') ||'' )
  225. *
  226.  PAUSE()
  227. *
  228.  |'Input test:   Should print echo of next input line.'
  229.  |''
  230.  |IN()
  231. *
  232.  PAUSE()
  233. *
  234. *
  235. * Tests of recursively defined list processing functIons
  236. *   SNOLISPIST
  237. *
  238. *
  239.  ||''
  240.  |'Recursively defined list processing functions'
  241.  |''
  242.  ?( |'Test LCOPY' |'' )
  243.  ORIGINAL = #'((O . R) (I . G) (I . N) (A . L))'
  244.  COPY = LCOPY(ORIGINAL)
  245.  |'Here is the original:'
  246.  ?( |(62 % 'C.ORIGINAL') |'' )
  247.  |'Here is the copy:'
  248.  ?( |(62 % 'C.COPY') |'' )
  249.  |'Are they EQU?'
  250.  ?( |("     "   ~EQU(COPY,ORIGINAL) 'No.') |'' )
  251.  |'Are they EQUAL?'
  252.  ?( |("     "   EQUAL(COPY,ORIGINAL) 'Yes.') |'' )
  253. *
  254.  PAUSE()
  255. *
  256.  ?( |'Test SUBST' |'' )
  257.  TEST.LIST = #'(1 (2) (3 . 4) ((5 . 6) 7) 1 2 3 4 5 6 7)'
  258.  SUBST.LIST = #'(S I X)'
  259.  |'Here is the original list:'
  260.  ?( |(62 % 'C.TEST.LIST') |'' )
  261.  ?( |'Here is the target sublist:  6' |'' )
  262.  |'Here is the result:'
  263.  ?( |(62 % 'C.SUBST(TEST.LIST,6,SUBST.LIST)' ) |'' )
  264. *
  265.  PAUSE()
  266. *
  267.  ?( |'Test REMOVE' |'' )
  268.  TEST.LIST = #'(A (B (C . D) E (F . G)) H A I R)'
  269.  REM.LIST = #'(C . D)'
  270.  |'Here is the test list:'
  271.  ?( |(62 % 'C.TEST.LIST') |'' )
  272.  |'Here is the list to be removed:'
  273.  ?( |(62 % 'C.REM.LIST') |'' )
  274.  |'Here is the result:'
  275.  ?( |(62 % 'C.REMOVE(TEST.LIST,REM.LIST)' ) |'' )
  276. *
  277.  PAUSE()
  278. *
  279.  ?( |'Test FIND' |'' )
  280.  TEST.LIST = #'(H A Y ((N . E) (E . D) (L . E)) S T A C K)'
  281.  FIND.LIST = #'(E . D)'
  282.  |'Here is the test list:'
  283.  ?( |(62 % 'C.TEST.LIST') |'' )
  284.  |'Here is the list to be found:'
  285.  ?( |(62 % 'C.FIND.LIST') |'' )
  286.  |'Here is the result:'
  287.  ?( |(62 % 'C.FIND(FIND.LIST,TEST.LIST)' ) |'' )
  288. *
  289.  PAUSE()
  290. *
  291. * Tests of miscellaneous list processing functions
  292. *     SNOLISPIST
  293. *
  294.  ||''
  295.  |'Miscellaneous list processing functions'
  296.  |''
  297.  ?( |'Test EXPLODE and READLIST by inverse mapping' |'' )
  298.  |MAPCAR(.READLIST,
  299. +     MAPCAR(.EXPLODE,
  300. +        #'(1 AARDVARK (SUB LIST) (C (O (MPLEX))))' ))
  301. *
  302.  PAUSE()
  303. *
  304.  |''
  305.  ?( |'Test LENGTH' |'' )
  306.  |MAPLIST(.LENGTH,
  307. +     EXPLODE('abcdefghijklmnopqrstuvwxyz'))
  308. *
  309.  PAUSE()
  310. *
  311.  |''
  312.  |'Test SETL (SET indirectly)'
  313.  |''
  314.  DEFINE('PLACE(CH)A')    :(PLACE.END)
  315. PLACE
  316. +     &ALPHABET CH @A
  317.       PLACE = A     :(RETURN)
  318. PLACE.END
  319. *
  320.  DEFINE('INTERLEAVE(L1,L2)LL')      :(INTERLEAVE.END)
  321. INTERLEAVE
  322. +     LL = NIL
  323. INTERLEAVE1
  324. +     LL = POP( .L2) ~ POP( .L1) ~ LL
  325. +        :S(INTERLEAVE1)
  326.       INTERLEAVE = LREVERSE(LL)    :(RETURN)
  327. INTERLEAVE.END
  328. *
  329.       AA =  EXPLODE('abcdefghijklmnopqrstuvwxyz')
  330.       VV =  MAPCAR(.PLACE,AA)
  331.       SETL(INTERLEAVE(AA,VV))
  332.       MAPC(DEXP('LAMBDA(Z) = '
  333. +          '?|(Z " = " VALUE(Z))' ),  AA)
  334. *
  335.  PAUSE()
  336. *
  337. *
  338. *  Tests of set functions on lists
  339. *     SNOLISPIST
  340. *
  341. *
  342.  ||''
  343.  |'Set functions'
  344.  |''
  345.  EVEN  = #'(2 4 6 8 10 12 14 16 18 20)'
  346.  ODD   = #'(1 3 5 7 9 11 13 15 17 19)'
  347.  PRIME = #'(2 3 5 7 11 13 17 19)'
  348.  FIBONACCI = #'(1 1 2 3 5 8 13)'
  349.  UNIVERSE = UNION(EVEN,ODD)
  350.  NON.PRIME = EXCLUDE(UNIVERSE,PRIME)
  351.  EVEN.PRIME = INTERSECT(EVEN,PRIME)
  352.  PRIME.FIBO = INTERSECT(PRIME,FIBONACCI)
  353.  ODD.FIBO = INTERSECT(ODD,FIBONACCI)
  354.  PRIME.OR.FIBO = UNION(PRIME,FIBONACCI)
  355.  NEITHER.PRIME.NOR.FIBO = EXCLUDE(UNIVERSE,PRIME.OR.FIBO)
  356. *
  357.  MAPC(DEXP('LAMBDA(NAME) = |$|( |"" NAME )' ),
  358. +     #( '(EVEN ODD PRIME FIBONACCI UNIVERSE NON.PRIME '
  359. +          'EVEN.PRIME PRIME.FIBO ODD.FIBO PRIME.OR.FIBO '
  360. +          'NEITHER.PRIME.NOR.FIBO)' ))
  361. *
  362.  PAUSE()
  363. *
  364. *
  365. *  Tests of some functions for adding to a list
  366. *     SNOLISPIST
  367. *
  368. *
  369.  ||''
  370.  |'Functions which add elements to lists'
  371.  |''
  372.  LIST1 = EXPLODE('APPEND')
  373.  LIST2 = EXPLODE('NCONC')
  374.  LIST3 = EXPLODE('SNOC')
  375.  LIST4 = EXPLODE('INSERT')
  376. *
  377.  EXTRA.LIST = EXPLODE('EXTRA')
  378.  EXTRA.ATOM = CONCAT(EXTRA.LIST)
  379. *
  380.  ||''
  381.  ?( |'Test APPEND' |'' )
  382.  |(62 % 'C.APPEND(LIST1 ~ EXTRA.LIST ~ NIL)' )
  383. *
  384.  PAUSE()
  385. *
  386.  ?( |'Test NCONC' |'' )
  387.  |(62 % 'C.NCONC(LIST2 ~ EXTRA.LIST ~ NIL)' )
  388. *
  389.  PAUSE()
  390. *
  391.  ?( |'Test SNOC' |'' )
  392.  |(62 % 'C.SNOC(LIST3,EXTRA.ATOM)' )
  393. *
  394.  PAUSE()
  395. *
  396.  ?( |'Test INSERT' |'' )
  397.  |(62 % 'C.INSERT("R",LIST4)'  )
  398.  |''
  399.  |(62 % 'C.INSERT(EXTRA.ATOM,LIST4)' )
  400. *
  401.  PAUSE()
  402. *
  403. * Tests of replacement functions
  404. *     SNOLISPIST
  405. *
  406. *
  407.  ||''
  408.  |'Replacement functions'
  409.  |''
  410.  LST = READ(
  411. +     '(NOW IS THE TIME FOR ALL GOOD MEN '
  412. +     'TO COME TO THE AID OF THEIR PARTY)' )
  413.  |''
  414.  |'The test list is'
  415.  ?( |(62 % 'C.LST') |'' )
  416. *
  417.  PAUSE()
  418. *
  419.  ?( |'Reverse the CDR' |'' )
  420.  RPLACD(LST,LREVERSE(CDR(LST)))
  421.  ?( |(62 % 'C.LST') |'' )
  422. *
  423.  PAUSE()
  424. *
  425.  ?( |'Put it back like it was' |'' )
  426.  RPLACD(LST,LREVERSE(CDR(LST)))
  427.  ?( |(62 % 'C.LST') |'' )
  428. *
  429.  PAUSE()
  430. *
  431.  ?( |'Use RPLACA to change the first five words' |'' )
  432.  RPLACA(LST,'Now')
  433.  RPLACA(CDR(LST),'is')
  434.  RPLACA(CDDR(LST),'the')
  435.  RPLACA(CDDDR(LST),'time')
  436.  RPLACA(CDDDDR(LST),'for')
  437.  ?( |(62 % 'C.LST') |'' )
  438. *
  439.  PAUSE()
  440. *
  441.  ?( |'Change the last five words using RPLACN' |'' )
  442.  RPLACN(LST,-1,'party?')
  443.  RPLACN(LST,-2,'their')
  444.  RPLACN(LST,-3,'of')
  445.  RPLACN(LST,-4,'aid')
  446.  RPLACN(LST,-5,'the')
  447.  ?( |(62 % 'C.LST') |'' )
  448. *
  449.  PAUSE()
  450. *
  451.  |'Restore the original list; then reverse each '
  452.  ?( |("     "   'word, starting with the last.') |'' )
  453.  LST = READ(
  454. +     '(NOW IS THE TIME FOR ALL GOOD MEN '
  455. +     'TO COME TO THE AID OF THEIR PARTY)' )
  456.  |''
  457.  |'The test list is'
  458.  ?( |(62 % 'C.LST') |'' )
  459. *
  460.  PAUSE()
  461. *
  462.        N = LENGTH(LST)
  463.        I = 0
  464. LUPE
  465.        I = LT(I,N) I + 1       :F(LUPE.END)
  466.        K = -I
  467.        RPLACN(LST,K,REVERSE(CAR(NTH(LST,K))))
  468.        PRINT(LST)         :(LUPE)
  469. LUPE.END
  470. +     PAUSE()
  471. *
  472. *
  473. * Tests of sublist functions
  474. *     SNOLISPIST
  475. *
  476. *
  477.  ||''
  478.  |'Sublist functions'
  479.  |''
  480.  LST = READ(
  481. +     '(NEVER TRY TO GIVE NECESSARY AND SUFFICIENT '
  482. +     'CONDITIONS FOR ANYTHING -- Linsky)' )
  483.  |''
  484.  |'The test list is'
  485.  PRINT(LST)
  486.  PAUSE()
  487. *
  488.  |'The last element is'
  489.  PRINT(LAST(LST))
  490. *
  491.   PAUSE()
  492. *
  493.  ?( |'Here is a vertical listing, using NTH' |'' )
  494.       N = LENGTH(LST)
  495.       I = 0
  496. LOOP
  497. +     I = LT(I,N) I + 1       :F(LOOP.END)
  498.       PRINT(CAR(NTH(LST,I)))       :(LOOP)
  499. LOOP.END      PAUSE()
  500. *
  501.  |''
  502.  |'The first 8 elements are'
  503.  PRINT(PRELIST(LST,8))
  504.  PAUSE()
  505. *
  506.  |'The tail starting with element 4 is'
  507.  PRINT(SUFLIST(LST,3))
  508.  PAUSE()
  509. *
  510.  |'The sublist consisting of elements 4 through 8 is'
  511.  PRINT(PRELIST(SUFLIST(LST,3),5))
  512.  PAUSE()
  513. *
  514.  |'The RAC is'
  515.  PRINT(RAC(LST))
  516.  |'The RDC is'
  517.  PRINT(RDC(LST))
  518.  PAUSE()
  519. *
  520. *
  521. * Tests of list searching functions
  522. *      SNOLISPIST
  523. *
  524. *
  525.  ||''
  526.  |'Searching functions'
  527.  |''
  528.  ALIST = READ(
  529. +      '((1 BUN) '
  530. +      '(2 SHOE) '
  531. +      '(3 TREE) '
  532. +      '(4 DOOR BORE SHORE CORE) '
  533. +      '(5 HIVE JIVE) '
  534. +      '(6 SEX) '
  535. +      '(7 HEAVEN) '
  536. +      '(8 WAIT) '
  537. +      '(9 RESIGN) '
  538. +      '(10 WHEN?) )' )
  539. *
  540.  |'The test list is'
  541.  PRINT(ALIST)
  542.  PAUSE()
  543. *
  544.  ?( |'NIL followed-by beat poetry' |'' )
  545.  PRINT(ASSOC(95,ALIST))
  546.  PRINT(ASSOC(6,ALIST))
  547.  PRINT(ASSOC(9,ALIST))
  548.  PRINT(ASSOC(5,ALIST))
  549.  PRINT(ASSOC(10,ALIST))
  550. *
  551.  PAUSE()
  552. *
  553.  MESS = #'(47 ABC XYZ BUN WAIT 5 7 1 3)'
  554.  |''
  555.  |'The list of targets for ASSOCL is'
  556.  |''
  557.  |'LTRACE is also tested here.'
  558.  |''
  559.  PRINT(MESS)
  560.  PAUSE()
  561. *
  562.  LTRACE(2, .ASSOCL ~ NIL) ; &TRACE = 10000
  563.  PRINT(ASSOCL(MESS,ALIST))
  564.  LTRACE(0, .ASSOCL ~ NIL) ; &TRACE = 0
  565.  PAUSE()
  566. *
  567.  |'Here is the tail of MESS starting with BUN'
  568.  PRINT(MEMBER('BUN',MESS))
  569.  PAUSE()
  570. *
  571.  MEMQ('WAIT',MESS) ?|'This line should appear'
  572.  MEMQ('INCLINE',ALIST) ?|'This line should NOT appear'
  573. *
  574.  PAUSE()
  575. *
  576. * Tests of mapping functions
  577. *     SNOLISPIST
  578. *
  579. *
  580.  ||''
  581.  |'Mapping functions'
  582.  |''
  583.  ?( |'Unimaginative MAP test' |'' )
  584.  MAP(.PRINT,#'(A B C D 11 22 33 44 (5 . 5))' )
  585. *
  586.  PAUSE()
  587. *
  588.  ?( |'Unimaginative MAPC test' |'' )
  589.  MAPC(.PRINT,
  590. +     READ(
  591. +         '(Now is the time for all good men '
  592. +         'to come to the aid of their party)' ))
  593. *
  594.  PAUSE()
  595. *
  596.  ?( |'Unimaginative MAPLIST test' |'' )
  597.  PRINT(MAPLIST(.LENGTH,
  598. +     #'(10 9 8 7 6 5 4 pi 3 e 2 1 0 BLAST OFF!    i)' ))
  599. *
  600.  PAUSE()
  601. *
  602.  ?( |'MAPCON test -- What will happen???' |'' )
  603.  PRINT(MAPCON(.EXPLODE,
  604. +     #'(EVERY GOOD BOY DOES FINE)' ))
  605. *
  606.  PAUSE()
  607. *
  608.  ?( |'MAPCAN test -- What wlll happen?????' |'' )
  609.  PRINT(MAPCAN(.EXPLODE,
  610. +     #'(CINNAMON PERSIMMON SIMIAN)' ))
  611.  PAUSE()
  612. *
  613.  |'EVERY test (correct answer = NIL)'
  614.  PRINT(EVERY(.NUMBERP,
  615. +     #'(5 4 3 2 1 0 X)' ))
  616. *
  617.  PAUSE()
  618. *
  619.  |'EVLIS test'
  620.  |'Correct answer is (1 2 3 (LIST VALUE))'
  621.  SETL( #'(A 1 B 2 C 3 D (LIST VALUE))' )
  622.  PRINT(EVLIS(#'(A B C D)' ))
  623. *
  624.  PAUSE()
  625. *
  626.  |'SOME test (correct answer = NIL)'
  627.  PRINT(SOME(.ZEROP,
  628. +     #'(19 9 8 3 6 4 2 \P...I. \LN...10. 66 666 -1)' ))
  629. *
  630.  PAUSE()
  631. *
  632.  |'SUBSET test (should print only negative numbers)'
  633.  PRINT(SUBSET(.NEGP,
  634. +     #'(0 0 0 -1 -2 9 8 6.3 \-P...I. \LN...10. -5)' ))
  635. *
  636.  PAUSE()
  637. *
  638. *
  639. * Tests of non-numerical Predicates
  640. *     SNOLISPIST
  641. *
  642.       LLST = #'(A (SMALL (TEST (LIST))))'
  643.  ||''
  644.  |'A series of Ts'
  645.  |''
  646.  MAPC(DEXP('LAMBDA(EXPR) = |("      " !EVALCODE( |EXPR))' ),
  647. +     '/T' ~
  648. +     'NULLP(NIL)' ~
  649. +     'NOTP(NIL)' ~
  650. +     'ATOMP(13.965)' ~
  651. +     'NUMBERP(-13.965)' ~
  652. +     'EQP(13,"13.000000")' ~
  653. +     'EQUALP(LLST,LCOPY(LLST))' ~
  654. +     NIL)
  655. *
  656.  PAUSE()
  657. *
  658.  ||''
  659.  |'A series of NILs'
  660.  |''
  661.  LLST = #'(TWEEDLE (DEE . DUM))'
  662.  MAPC(DEXP('LAMBDA(EXPR) = |("    " !EVALCODE( |EXPR))' ),
  663. +    'NULLP(14 ~ NIL)' ~
  664. +    'NOTP(1 ~ 1)' ~
  665. +    'ATOMP(1 ~ 2 ~ 3 ~ NIL)' ~
  666. +    'NUMBERP("LINDA")' ~
  667. +    'EQP(LLST,LCOPY(LLST))' ~
  668. +    NIL)
  669. *
  670.  PAUSE()
  671. *
  672. *
  673. * Tests of numerical predicates
  674. *    SNOLISPIST
  675. *
  676. *
  677.  ||''
  678.  |'Alternating series of Ts and NILs'
  679.  |''
  680.  ?( |'Testing NEGP' |'' )
  681.  |MAPCAR(.NEGP,
  682. +    #'(-1 2 -3.0 4 -5.00 6.00 -7.7 8.8 -8.999 10.101010)')
  683. *
  684.  PAUSE()
  685. *
  686.  ?( |'Testing ZEROP' |'' )
  687.  |MAPCAR(.ZEROP,
  688. +    #'(0 14 0. -41 0.0 29 -0.0 2.99 00000 99999)')
  689. *
  690.  PAUSE()
  691. *
  692.  ?( |'Testing LESSP' |'' )
  693.  |LESSP( #'( \-P...I. 0.00 0.01 10000000)' )
  694.  |LESSP( #'( \-LN...10. 0.00 1.01 1.000000)' )
  695. *
  696.  PAUSE()
  697. *
  698.  |'Testing GREATERP.'
  699.  |''
  700.  |GREATERP( #'( \P...I. 3.1 -4  -19.84)' )
  701.  |GREATERP( #'( 6 16 7 17    14.82   )' )
  702. *
  703.  PAUSE()
  704. *
  705. *
  706. * Tests of the property-list functions
  707. *    SNOLISPIST
  708. *
  709. *
  710.  ||''
  711.  |'Property list functions'
  712.  |''
  713. *
  714. *
  715.  MAPC(DEXP('LAMBDA(XPR) = '
  716. +     '|("      " !EVAL( |( |"" XPR )))' ),
  717. +     'PUT(.DOG,"NUMBER.OF.LEGS",4)' ~
  718. +     'GET(.DOG,"NUMBER.OF.LEGS")' ~ 'PAUSE()' ~
  719. +     'REMPROP(.DOG,"NUMBER.OF.LEGS")' ~
  720. +     'GET(.DOG,"NUMBER.OF.LEGS")' ~ 'PAUSE()' ~
  721. +     'PUTL(#"(DOG CAT HORSE)","NUMBER.OF.LEGS",4)' ~
  722. +     'GET(.DOG,"NUMBER.OF.LEGS")' ~
  723. +     'GET(.CAT,"NUMBER.OF.LEGS")' ~
  724. +     'GET(.HORSE,"NUMBER.OF.LEGS")' ~
  725. +     'GET(.ARMADILLO,"NUMBER.OF.LEGS")' ~ 'PAUSE()' ~
  726. +     'PUTPROP(.DOG,3,"LEGS")' ~
  727. +     'PUTPROP(.DOG,2,"LEGS")' ~
  728. +     'PUTPROP(.DOG,1,"LEGS")' ~
  729. +     'PUTPROP(.DOG,1,"HEAD")' ~
  730. +     'GETL(.DOG,#"(LEGS HEAD)")' ~
  731. +     'GETL(.DOG,#"(HEAD)")' ~ 'PAUSE()' ~
  732. +     'ADDPROP(.DOG,3,"LEGS")' ~
  733. +     'GET(.DOG,"LEGS")' ~
  734. +     'ADDPROP(.DOG,"ANOMALY","LEGS")' ~
  735. +     'GET(.DOG,"LEGS")' ~ 'PAUSE()' ~
  736. +     'DEFPROP(.FISH,0,"LEGS")' ~
  737. +     'GETL(.FISH,#"(EYES ARMS TEETH LEGS)")' ~
  738. +     NIL )
  739. *
  740.  PAUSE()
  741. *
  742. *
  743.  |''
  744.  ?( |'Empty all property stacks' |'' )
  745.  ?( |'DOG -- "LEGS"' |'' )
  746. *
  747. LOOP1 TEMP = GETPROP( .DOG, 'LEGS' )
  748.       ?( PRINT(TEMP) DIFFER(TEMP,NIL) )     :S(LOOP1)
  749.  |''
  750.  PAUSE()
  751.  ?( |'DOG -- "NUMBER.OF.LEGS"' |'' )
  752. LOOP2   TEMP = GETPROP( .DOG, 'NUMBER.OF.LEGS' )
  753.         ?( PRINT(TEMP) DIFFER(TEMP,NIL) )     :S(LOOP2)
  754.  |''
  755.  PAUSE()
  756.  ?( |'DOG -- "HEAD"' |'' )
  757. LOOP3   TEMP = GETPROP( .DOG, 'HEAD' )
  758.         ?( PRINT(TEMP) DIFFER(TEMP,NIL) )       :S(LOOP3)
  759.  |''
  760.  PAUSE()
  761.  |'CAT -- "NUMBER.OF.LEGS"'
  762. LOOP4   TEMP = GETPROP( .CAT, 'NUMBER.OF.LEGS' )
  763.         ?( PRINT(TEMP) DIFFER(TEMP,NIL) )     :S(LOOP4)
  764.  |''
  765.  PAUSE()
  766.  ?( |'FISH -- "LEGS"' |'' )
  767. LOOP5 TEMP = GETPROP( .FISH, 'LEGS' )
  768.       ?( PRINT(TEMP) DIFFER(TEMP,NIL) )      :S(LOOP5)
  769.  |''
  770.  PAUSE()
  771.  ?( |'HORSE -- "NUMBER.OF.LEGS"' |''   )
  772. LOOP6 TEMP = GETPROP( .HORSE, 'NUMBER.OF.LEGS' )
  773.       ?( PRINT(TEMP) DIFFER(TEMP,NIL) )      :S(LOOP6)
  774. *
  775.  PAUSE()
  776. *
  777.  ||''
  778.  ?( |'A combined test of CLA, CAL, and SORT' |'' )
  779.  ?( |'Should print ABDENWSSREBA' |'' )
  780.  L = CLA(EXPLODE('BADNEWSBEARS'))
  781.  SORT.(L,7,12,'LGE')
  782.  SORT.(L,1,6,'LLE')
  783.  |READLIST(CAL(L))
  784. *
  785.  PAUSE()
  786. *
  787.  ||''
  788.  |'A further test of SORT/CAL/CLA:'
  789.  |'Make anagrams out of some six-letter names by'
  790.  |'alphabetizing their letters.'
  791.  |''
  792.  MAPC(
  793. + DEXP(
  794. +   'LAMBDA(X) = '
  795. +    'PRINT('
  796. +     'CONCAT('
  797. +      'CAL('
  798. +       'SORT.(CLA(EXPLODE(X)),1,6,.LLE) )))' ),
  799. +         ('MARVIN' ~
  800. +         'PACMAN' ~
  801. +         'LOLITA' ~
  802. +         'MERLIN' ~
  803. +         'ELIJAH' ~
  804. +         'SHAFTO' ~
  805. +         'SYLVIA' ~
  806. +         'ITALIA' ~
  807. +         'GEORGE' ~
  808. +         'GIMPEL' ~
  809. +         'BACKUS' ~ NIL) )
  810. *
  811.  PAUSE()
  812. *
  813.  ||''
  814.  |'TDUMP test:  Should print suitable error message.'
  815.  |''
  816.  |(72 % 'C.a=b+c?')
  817. END
  818.