Artifact
d03a123d61f75f7a72fd2a0c1e5b00618b997c99:
- File
tests/tests.scm
— part of check-in
[bf70f7cd40]
at
2011-09-04 20:12:52
on branch rollup
— Added rollup.
(user:
matt
size: 5200)
[more...]
0000: 28 75 73 65 20 74 65 73 74 29 0a 3b 3b 20 28 72 (use test).;; (r
0010: 65 71 75 69 72 65 2d 6c 69 62 72 61 72 79 20 61 equire-library a
0020: 72 67 73 29 0a 0a 28 69 6e 63 6c 75 64 65 20 22 rgs)..(include "
0030: 2e 2e 2f 6d 65 67 61 74 65 73 74 2e 73 63 6d 22 ../megatest.scm"
0040: 29 0a 28 69 6e 63 6c 75 64 65 20 22 2e 2e 2f 63 ).(include "../c
0050: 6f 6d 6d 6f 6e 2e 73 63 6d 22 29 0a 28 69 6e 63 ommon.scm").(inc
0060: 6c 75 64 65 20 22 2e 2e 2f 6b 65 79 73 2e 73 63 lude "../keys.sc
0070: 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 2e 2e m").(include "..
0080: 2f 64 62 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 /db.scm").(inclu
0090: 64 65 20 22 2e 2e 2f 63 6f 6e 66 69 67 66 2e 73 de "../configf.s
00a0: 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 2e cm").(include ".
00b0: 2e 2f 70 72 6f 63 65 73 73 2e 73 63 6d 22 29 0a ./process.scm").
00c0: 28 69 6e 63 6c 75 64 65 20 22 2e 2e 2f 6c 61 75 (include "../lau
00d0: 6e 63 68 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 nch.scm").(inclu
00e0: 64 65 20 22 2e 2e 2f 69 74 65 6d 73 2e 73 63 6d de "../items.scm
00f0: 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 2e 2e 2f ").(include "../
0100: 72 75 6e 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c runs.scm").(incl
0110: 75 64 65 20 22 2e 2e 2f 72 75 6e 63 6f 6e 66 69 ude "../runconfi
0120: 67 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 g.scm").(include
0130: 20 22 2e 2e 2f 6d 65 67 61 74 65 73 74 2d 76 65 "../megatest-ve
0140: 72 73 69 6f 6e 2e 73 63 6d 22 29 0a 0a 28 64 65 rsion.scm")..(de
0150: 66 69 6e 65 20 74 65 73 74 2d 77 6f 72 6b 2d 64 fine test-work-d
0160: 69 72 20 28 63 75 72 72 65 6e 74 2d 64 69 72 65 ir (current-dire
0170: 63 74 6f 72 79 29 29 0a 0a 28 64 65 66 69 6e 65 ctory))..(define
0180: 20 63 6f 6e 66 66 69 6c 65 20 23 66 29 0a 28 74 conffile #f).(t
0190: 65 73 74 20 22 52 65 61 64 20 61 20 63 6f 6e 66 est "Read a conf
01a0: 69 67 22 20 23 74 20 28 68 61 73 68 2d 74 61 62 ig" #t (hash-tab
01b0: 6c 65 3f 20 28 72 65 61 64 2d 63 6f 6e 66 69 67 le? (read-config
01c0: 20 22 74 65 73 74 2e 63 6f 6e 66 69 67 22 20 23 "test.config" #
01d0: 66 20 23 66 29 29 29 0a 28 74 65 73 74 20 22 52 f #f))).(test "R
01e0: 65 61 64 20 61 20 63 6f 6e 66 69 67 20 74 68 61 ead a config tha
01f0: 74 20 64 6f 65 73 6e 27 74 20 65 78 69 73 74 22 t doesn't exist"
0200: 20 23 74 20 28 68 61 73 68 2d 74 61 62 6c 65 3f #t (hash-table?
0210: 20 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 22 6e (read-config "n
0220: 61 64 61 2e 63 6f 6e 66 69 67 22 20 23 66 20 23 ada.config" #f #
0230: 66 29 29 29 0a 0a 28 73 65 74 21 20 63 6f 6e 66 f)))..(set! conf
0240: 66 69 6c 65 20 28 72 65 61 64 2d 63 6f 6e 66 69 file (read-confi
0250: 67 20 22 74 65 73 74 2e 63 6f 6e 66 69 67 22 20 g "test.config"
0260: 23 66 20 23 66 29 29 0a 28 74 65 73 74 20 22 47 #f #f)).(test "G
0270: 65 74 20 61 76 61 69 6c 61 62 6c 65 20 64 69 73 et available dis
0280: 6b 73 70 61 63 65 22 20 23 74 20 28 6e 75 6d 62 kspace" #t (numb
0290: 65 72 3f 20 28 67 65 74 2d 64 66 20 22 2e 2f 22 er? (get-df "./"
02a0: 29 29 29 0a 28 74 65 73 74 20 22 47 65 74 20 62 ))).(test "Get b
02b0: 65 73 74 20 64 69 72 22 20 23 74 20 28 6c 65 74 est dir" #t (let
02c0: 20 28 28 62 65 73 74 64 69 72 20 28 67 65 74 2d ((bestdir (get-
02d0: 62 65 73 74 2d 64 69 73 6b 20 63 6f 6e 66 66 69 best-disk conffi
02e0: 6c 65 29 29 29 0a 09 09 09 20 20 20 20 20 20 28 le))).... (
02f0: 6f 72 20 28 65 71 75 61 6c 3f 20 22 2e 2f 22 20 or (equal? "./"
0300: 20 20 62 65 73 74 64 69 72 29 0a 09 09 09 09 20 bestdir).....
0310: 20 28 65 71 75 61 6c 3f 20 22 2f 74 6d 70 22 20 (equal? "/tmp"
0320: 62 65 73 74 64 69 72 29 29 29 29 0a 28 74 65 73 bestdir)))).(tes
0330: 74 20 22 4d 75 6c 74 69 6c 69 6e 65 20 76 61 72 t "Multiline var
0340: 69 61 62 6c 65 22 20 34 20 28 6c 65 6e 67 74 68 iable" 4 (length
0350: 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 (string-split (
0360: 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 63 6f config-lookup co
0370: 6e 66 66 69 6c 65 20 22 6d 65 74 61 64 61 74 61 nffile "metadata
0380: 22 20 22 64 65 73 63 72 69 70 74 69 6f 6e 22 29 " "description")
0390: 20 22 5c 6e 22 29 29 29 0a 0a 3b 3b 20 64 62 0a "\n")))..;; db.
03a0: 28 64 65 66 69 6e 65 20 72 6f 77 20 20 20 20 28 (define row (
03b0: 76 65 63 74 6f 72 20 22 61 22 20 22 62 22 20 22 vector "a" "b" "
03c0: 63 22 20 22 62 6c 61 68 22 29 29 0a 28 64 65 66 c" "blah")).(def
03d0: 69 6e 65 20 68 65 61 64 65 72 20 28 6c 69 73 74 ine header (list
03e0: 20 22 63 6f 6c 31 22 20 22 63 6f 6c 32 22 20 22 "col1" "col2" "
03f0: 63 6f 6c 33 22 20 22 63 6f 6c 34 22 29 29 0a 28 col3" "col4")).(
0400: 74 65 73 74 20 22 47 65 74 20 72 6f 77 20 62 79 test "Get row by
0410: 20 68 65 61 64 65 72 22 20 22 62 6c 61 68 22 20 header" "blah"
0420: 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 (db:get-value-by
0430: 2d 68 65 61 64 65 72 20 72 6f 77 20 68 65 61 64 -header row head
0440: 65 72 20 22 63 6f 6c 34 22 29 29 0a 0a 3b 3b 20 er "col4"))..;;
0450: 28 64 65 66 69 6e 65 20 2a 74 6f 70 70 61 74 68 (define *toppath
0460: 2a 20 22 74 65 73 74 73 22 29 0a 28 64 65 66 69 * "tests").(defi
0470: 6e 65 20 2a 64 62 2a 20 23 66 29 0a 28 74 65 73 ne *db* #f).(tes
0480: 74 20 22 73 65 74 75 70 20 66 6f 72 20 72 75 6e t "setup for run
0490: 22 20 23 74 20 28 62 65 67 69 6e 20 28 73 65 74 " #t (begin (set
04a0: 75 70 2d 66 6f 72 2d 72 75 6e 29 0a 09 09 09 09 up-for-run).....
04b0: 28 73 74 72 69 6e 67 3f 20 28 67 65 74 65 6e 76 (string? (getenv
04c0: 20 22 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f "MT_RUN_AREA_HO
04d0: 4d 45 22 29 29 29 29 0a 28 74 65 73 74 20 22 6f ME")))).(test "o
04e0: 70 65 6e 2d 64 62 22 20 23 74 20 28 62 65 67 69 pen-db" #t (begi
04f0: 6e 0a 09 09 20 20 20 20 20 28 73 65 74 21 20 2a n... (set! *
0500: 64 62 2a 20 28 6f 70 65 6e 2d 64 62 29 29 0a 09 db* (open-db))..
0510: 09 20 20 20 20 20 28 69 66 20 2a 64 62 2a 20 23 . (if *db* #
0520: 74 20 23 66 29 29 29 0a 0a 3b 3b 20 71 75 69 74 t #f)))..;; quit
0530: 20 77 61 73 74 69 6e 67 20 74 69 6d 65 2c 20 49 wasting time, I
0540: 27 6d 20 63 68 61 6e 67 69 6e 67 20 2a 64 62 2a 'm changing *db*
0550: 20 74 6f 20 64 62 0a 28 64 65 66 69 6e 65 20 64 to db.(define d
0560: 62 20 2a 64 62 2a 29 0a 0a 28 74 65 73 74 20 22 b *db*)..(test "
0570: 67 65 74 20 63 70 75 20 6c 6f 61 64 22 20 23 74 get cpu load" #t
0580: 20 28 6e 75 6d 62 65 72 3f 20 28 67 65 74 2d 63 (number? (get-c
0590: 70 75 2d 6c 6f 61 64 29 29 29 0a 28 74 65 73 74 pu-load))).(test
05a0: 20 22 67 65 74 20 75 6e 61 6d 65 22 20 20 20 20 "get uname"
05b0: 23 74 20 28 73 74 72 69 6e 67 3f 20 28 67 65 74 #t (string? (get
05c0: 2d 75 6e 61 6d 65 29 29 29 0a 0a 28 74 65 73 74 -uname)))..(test
05d0: 20 22 67 65 74 20 76 61 6c 69 64 76 61 6c 75 65 "get validvalue
05e0: 73 20 61 73 20 6c 69 73 74 22 20 28 6c 69 73 74 s as list" (list
05f0: 20 22 73 74 61 72 74 22 20 22 65 6e 64 22 20 22 "start" "end" "
0600: 63 6f 6d 70 6c 65 74 65 64 22 29 0a 20 20 20 20 completed").
0610: 20 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 (string-split
0620: 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 2a (config-lookup *
0630: 63 6f 6e 66 69 67 64 61 74 2a 20 22 76 61 6c 69 configdat* "vali
0640: 64 76 61 6c 75 65 73 22 20 22 73 74 61 74 65 22 dvalues" "state"
0650: 29 29 29 0a 0a 28 66 6f 72 2d 65 61 63 68 20 28 )))..(for-each (
0660: 6c 61 6d 62 64 61 20 28 69 74 65 6d 29 0a 09 20 lambda (item)..
0670: 20 20 20 28 74 65 73 74 20 28 63 6f 6e 63 20 22 (test (conc "
0680: 67 65 74 20 76 61 6c 69 64 20 69 74 65 6d 73 20 get valid items
0690: 28 22 20 69 74 65 6d 20 22 29 22 29 0a 09 09 20 (" item ")")...
06a0: 20 69 74 65 6d 20 28 63 68 65 63 6b 2d 76 61 6c item (check-val
06b0: 69 64 2d 69 74 65 6d 73 20 22 73 74 61 74 65 22 id-items "state"
06c0: 20 69 74 65 6d 29 29 29 0a 09 20 20 28 6c 69 73 item))).. (lis
06d0: 74 20 22 73 74 61 72 74 22 20 22 65 6e 64 22 20 t "start" "end"
06e0: 22 63 6f 6d 70 6c 65 74 65 64 22 29 29 0a 0a 28 "completed"))..(
06f0: 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 for-each (lambda
0700: 20 28 69 74 65 6d 29 0a 09 20 20 20 20 28 74 65 (item).. (te
0710: 73 74 20 28 63 6f 6e 63 20 22 67 65 74 20 76 61 st (conc "get va
0720: 6c 69 64 20 69 74 65 6d 73 20 28 22 20 69 74 65 lid items (" ite
0730: 6d 20 22 29 22 29 0a 09 09 20 20 69 74 65 6d 20 m ")")... item
0740: 28 63 68 65 63 6b 2d 76 61 6c 69 64 2d 69 74 65 (check-valid-ite
0750: 6d 73 20 22 73 74 61 74 75 73 22 20 69 74 65 6d ms "status" item
0760: 29 29 29 0a 09 20 20 28 6c 69 73 74 20 22 70 61 ))).. (list "pa
0770: 73 73 22 20 22 66 61 69 6c 22 20 22 6e 2f 61 22 ss" "fail" "n/a"
0780: 29 29 0a 0a 28 74 65 73 74 20 22 77 72 69 74 65 ))..(test "write
0790: 20 65 6e 76 20 66 69 6c 65 73 22 20 22 6e 61 64 env files" "nad
07a0: 61 2e 63 73 68 22 20 28 62 65 67 69 6e 0a 20 20 a.csh" (begin.
07b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
07c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
07d0: 20 20 20 20 28 73 61 76 65 2d 65 6e 76 69 72 6f (save-enviro
07e0: 6e 6d 65 6e 74 2d 61 73 2d 66 69 6c 65 73 20 22 nment-as-files "
07f0: 6e 61 64 61 22 29 0a 20 20 20 20 20 20 20 20 20 nada").
0800: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0810: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 6e (an
0820: 64 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 d (file-exists?
0830: 22 6e 61 64 61 2e 73 68 22 29 0a 20 20 20 20 09 "nada.sh"). .
0840: 09 09 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ..
0850: 20 20 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f (file-exists?
0860: 20 22 6e 61 64 61 2e 63 73 68 22 29 29 29 29 0a "nada.csh")))).
0870: 0a 28 74 65 73 74 20 22 67 65 74 20 61 6c 6c 20 .(test "get all
0880: 6c 65 67 61 6c 20 74 65 73 74 73 22 20 28 6c 69 legal tests" (li
0890: 73 74 20 22 72 75 6e 66 69 72 73 74 22 20 22 72 st "runfirst" "r
08a0: 75 6e 77 69 74 68 66 69 72 73 74 22 20 22 73 69 unwithfirst" "si
08b0: 6e 67 6c 65 74 65 73 74 22 20 22 73 69 6e 67 6c ngletest" "singl
08c0: 65 74 65 73 74 32 22 20 22 73 71 6c 69 74 65 73 etest2" "sqlites
08d0: 70 65 65 64 22 29 20 28 73 6f 72 74 20 28 67 65 peed") (sort (ge
08e0: 74 2d 61 6c 6c 2d 6c 65 67 61 6c 2d 74 65 73 74 t-all-legal-test
08f0: 73 29 20 73 74 72 69 6e 67 3c 3d 3f 29 29 0a 0a s) string<=?))..
0900: 28 74 65 73 74 20 22 72 65 67 69 73 74 65 72 2d (test "register-
0910: 74 65 73 74 2c 20 74 65 73 74 20 69 6e 66 6f 22 test, test info"
0920: 20 22 4e 4f 54 5f 53 54 41 52 54 45 44 22 0a 20 "NOT_STARTED".
0930: 20 20 20 20 20 28 62 65 67 69 6e 0a 09 28 72 65 (begin..(re
0940: 67 69 73 74 65 72 2d 74 65 73 74 20 2a 64 62 2a gister-test *db*
0950: 20 31 20 22 6e 61 64 61 22 20 22 22 20 27 28 22 1 "nada" "" '("
0960: 74 61 67 31 22 20 22 74 61 67 32 22 20 22 74 61 tag1" "tag2" "ta
0970: 67 33 22 29 29 0a 09 28 74 65 73 74 3a 67 65 74 g3"))..(test:get
0980: 2d 73 74 61 74 65 20 28 64 62 3a 67 65 74 2d 74 -state (db:get-t
0990: 65 73 74 2d 69 6e 66 6f 20 2a 64 62 2a 20 31 20 est-info *db* 1
09a0: 22 6e 61 64 61 22 20 22 22 29 29 29 29 0a 0a 28 "nada" ""))))..(
09b0: 74 65 73 74 20 22 67 65 74 2d 6b 65 79 73 22 20 test "get-keys"
09c0: 22 73 79 73 6e 61 6d 65 22 20 28 6b 65 79 3a 67 "sysname" (key:g
09d0: 65 74 2d 66 69 65 6c 64 6e 61 6d 65 20 28 63 61 et-fieldname (ca
09e0: 72 20 28 73 6f 72 74 20 28 64 62 2d 67 65 74 2d r (sort (db-get-
09f0: 6b 65 79 73 20 2a 64 62 2a 29 28 6c 61 6d 62 64 keys *db*)(lambd
0a00: 61 20 28 61 20 62 29 28 73 74 72 69 6e 67 3e 3d a (a b)(string>=
0a10: 3f 20 28 76 65 63 74 6f 72 2d 72 65 66 20 61 20 ? (vector-ref a
0a20: 30 29 28 76 65 63 74 6f 72 2d 72 65 66 20 62 20 0)(vector-ref b
0a30: 30 29 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 0)))))))..(defin
0a40: 65 20 72 65 6d 61 72 67 73 20 28 61 72 67 73 3a e remargs (args:
0a50: 67 65 74 2d 61 72 67 73 0a 09 09 20 27 28 22 62 get-args... '("b
0a60: 61 72 22 20 22 66 6f 6f 22 20 22 3a 72 75 6e 6e ar" "foo" ":runn
0a70: 61 6d 65 22 20 22 62 6f 62 22 20 22 3a 73 79 73 ame" "bob" ":sys
0a80: 6e 61 6d 65 22 20 22 75 62 75 6e 74 75 22 20 22 name" "ubuntu" "
0a90: 3a 66 73 6e 61 6d 65 22 20 22 6e 66 73 22 20 22 :fsname" "nfs" "
0aa0: 3a 64 61 74 61 70 61 74 68 22 20 22 62 6c 61 68 :datapath" "blah
0ab0: 2f 66 6f 6f 22 20 22 6e 61 64 61 22 29 0a 09 09 /foo" "nada")...
0ac0: 20 28 6c 69 73 74 20 22 3a 72 75 6e 6e 61 6d 65 (list ":runname
0ad0: 22 20 22 3a 73 74 61 74 65 22 20 22 3a 73 74 61 " ":state" ":sta
0ae0: 74 75 73 22 29 0a 09 09 20 28 6c 69 73 74 20 22 tus")... (list "
0af0: 2d 68 22 29 0a 09 09 20 61 72 67 73 3a 61 72 67 -h")... args:arg
0b00: 2d 68 61 73 68 0a 09 09 20 30 29 29 0a 0a 28 74 -hash... 0))..(t
0b10: 65 73 74 20 22 72 65 67 69 73 74 65 72 2d 72 75 est "register-ru
0b20: 6e 22 20 23 74 20 28 6e 75 6d 62 65 72 3f 20 28 n" #t (number? (
0b30: 72 65 67 69 73 74 65 72 2d 72 75 6e 20 2a 64 62 register-run *db
0b40: 2a 20 28 64 62 2d 67 65 74 2d 6b 65 79 73 20 2a * (db-get-keys *
0b50: 64 62 2a 29 29 29 29 0a 28 64 65 66 69 6e 65 20 db*)))).(define
0b60: 6b 65 79 73 20 28 64 62 2d 67 65 74 2d 6b 65 79 keys (db-get-key
0b70: 73 20 2a 64 62 2a 29 29 0a 0a 3b 3b 28 74 65 73 s *db*))..;;(tes
0b80: 74 20 22 75 70 64 61 74 65 2d 74 65 73 74 2d 69 t "update-test-i
0b90: 6e 66 6f 22 20 23 74 20 28 74 65 73 74 2d 75 70 nfo" #t (test-up
0ba0: 64 61 74 65 2d 6d 65 74 61 2d 69 6e 66 6f 20 2a date-meta-info *
0bb0: 64 62 2a 20 31 20 22 6e 61 64 61 22 20 0a 28 73 db* 1 "nada" .(s
0bc0: 65 74 65 6e 76 20 22 42 4c 41 48 46 4f 4f 22 20 etenv "BLAHFOO"
0bd0: 22 31 32 33 34 22 29 0a 28 75 6e 73 65 74 65 6e "1234").(unseten
0be0: 76 20 22 4e 41 44 41 46 4f 4f 22 29 0a 28 74 65 v "NADAFOO").(te
0bf0: 73 74 20 22 65 6e 76 20 74 65 6d 70 20 6f 76 65 st "env temp ove
0c00: 72 72 69 64 65 73 22 20 22 78 79 7a 22 20 28 6c rrides" "xyz" (l
0c10: 65 74 20 28 28 70 72 65 76 76 61 6c 73 20 28 61 et ((prevvals (a
0c20: 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 20 27 list->env-vars '
0c30: 28 28 22 42 4c 41 48 46 4f 4f 22 20 34 33 32 31 (("BLAHFOO" 4321
0c40: 29 28 22 4e 41 44 41 46 4f 4f 22 20 78 79 7a 29 )("NADAFOO" xyz)
0c50: 29 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 )))..... (
0c60: 72 65 73 75 6c 74 20 20 20 28 67 65 74 2d 65 6e result (get-en
0c70: 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 vironment-variab
0c80: 6c 65 20 22 4e 41 44 41 46 4f 4f 22 29 29 29 0a le "NADAFOO"))).
0c90: 09 09 09 09 20 20 20 20 28 61 6c 69 73 74 2d 3e .... (alist->
0ca0: 65 6e 76 2d 76 61 72 73 20 70 72 65 76 76 61 6c env-vars prevval
0cb0: 73 29 0a 09 09 09 09 20 20 20 20 72 65 73 75 6c s)..... resul
0cc0: 74 29 29 0a 0a 28 74 65 73 74 20 22 65 6e 76 20 t))..(test "env
0cd0: 72 65 73 74 6f 72 65 64 22 20 22 31 32 33 34 22 restored" "1234"
0ce0: 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e (get-environmen
0cf0: 74 2d 76 61 72 69 61 62 6c 65 20 22 42 4c 41 48 t-variable "BLAH
0d00: 46 4f 4f 22 29 29 0a 0a 0a 28 74 65 73 74 20 22 FOO"))...(test "
0d10: 49 74 65 6d 73 20 61 73 73 6f 63 22 20 22 45 6c Items assoc" "El
0d20: 65 70 68 61 6e 74 22 20 28 63 61 64 61 72 20 28 ephant" (cadar (
0d30: 63 61 64 72 20 28 69 74 65 6d 2d 61 73 73 6f 63 cadr (item-assoc
0d40: 2d 3e 69 74 65 6d 2d 6c 69 73 74 20 27 28 28 22 ->item-list '(("
0d50: 41 4e 49 4d 41 4c 22 20 22 45 6c 65 70 68 61 6e ANIMAL" "Elephan
0d60: 74 20 4c 69 6f 6e 22 29 28 22 53 45 41 53 4f 4e t Lion")("SEASON
0d70: 22 20 22 53 70 72 69 6e 67 20 46 61 6c 6c 22 29 " "Spring Fall")
0d80: 29 29 29 29 29 0a 28 73 65 74 21 20 2a 76 65 72 ))))).(set! *ver
0d90: 62 6f 73 69 74 79 2a 20 36 29 0a 28 74 65 73 74 bosity* 6).(test
0da0: 20 22 49 74 65 6d 73 20 61 73 73 6f 63 22 20 27 "Items assoc" '
0db0: 28 29 28 69 74 65 6d 2d 61 73 73 6f 63 2d 3e 69 ()(item-assoc->i
0dc0: 74 65 6d 2d 6c 69 73 74 20 27 28 28 22 61 22 20 tem-list '(("a"
0dd0: 22 61 20 62 20 63 20 64 22 29 28 22 62 22 20 22 "a b c d")("b" "
0de0: 63 20 64 20 65 22 29 28 22 63 22 20 22 22 29 28 c d e")("c" "")(
0df0: 22 64 22 29 29 29 29 0a 28 73 65 74 21 20 2a 76 "d")))).(set! *v
0e00: 65 72 62 6f 73 69 74 79 2a 20 2d 31 29 0a 28 74 erbosity* -1).(t
0e10: 65 73 74 20 22 49 74 65 6d 73 20 61 73 73 6f 63 est "Items assoc
0e20: 20 65 6d 70 74 79 20 69 74 65 6d 73 22 20 27 28 empty items" '(
0e30: 29 20 20 20 28 69 74 65 6d 2d 61 73 73 6f 63 2d ) (item-assoc-
0e40: 3e 69 74 65 6d 2d 6c 69 73 74 20 27 28 28 22 41 >item-list '(("A
0e50: 22 29 29 29 29 0a 28 73 65 74 21 20 2a 76 65 72 ")))).(set! *ver
0e60: 62 6f 73 69 74 79 2a 20 31 29 0a 28 74 65 73 74 bosity* 1).(test
0e70: 20 22 49 74 65 6d 73 20 74 61 62 6c 65 22 20 22 "Items table" "
0e80: 53 45 41 53 4f 4e 22 20 28 63 61 61 64 61 72 20 SEASON" (caadar
0e90: 28 69 74 65 6d 2d 74 61 62 6c 65 2d 3e 69 74 65 (item-table->ite
0ea0: 6d 2d 6c 69 73 74 20 27 28 28 22 41 4e 49 4d 41 m-list '(("ANIMA
0eb0: 4c 22 20 22 45 6c 65 70 68 61 6e 74 20 4c 69 6f L" "Elephant Lio
0ec0: 6e 22 29 28 22 53 45 41 53 4f 4e 22 20 22 53 70 n")("SEASON" "Sp
0ed0: 72 69 6e 67 20 57 69 6e 74 65 72 22 29 29 29 29 ring Winter"))))
0ee0: 29 0a 28 74 65 73 74 20 22 49 74 65 6d 73 20 74 ).(test "Items t
0ef0: 61 62 6c 65 20 65 6d 70 74 79 20 69 74 65 6d 73 able empty items
0f00: 20 49 22 20 27 28 29 20 28 69 74 65 6d 2d 74 61 I" '() (item-ta
0f10: 62 6c 65 2d 3e 69 74 65 6d 2d 6c 69 73 74 20 27 ble->item-list '
0f20: 28 28 22 41 22 29 29 29 29 0a 28 74 65 73 74 20 (("A")))).(test
0f30: 22 49 74 65 6d 73 20 74 61 62 6c 65 20 65 6d 70 "Items table emp
0f40: 74 79 20 69 74 65 6d 73 20 49 49 22 20 27 28 29 ty items II" '()
0f50: 20 28 69 74 65 6d 2d 74 61 62 6c 65 2d 3e 69 74 (item-table->it
0f60: 65 6d 2d 6c 69 73 74 20 27 28 28 22 41 22 20 22 em-list '(("A" "
0f70: 22 29 29 29 29 0a 0a 3b 3b 20 54 65 73 74 20 6f "))))..;; Test o
0f80: 75 74 20 74 68 65 20 73 74 65 70 73 20 63 6f 64 ut the steps cod
0f90: 65 0a 0a 28 64 65 66 69 6e 65 20 74 65 73 74 2d e..(define test-
0fa0: 69 64 20 23 66 29 0a 0a 3b 3b 20 66 6f 72 63 65 id #f)..;; force
0fb0: 20 6b 65 65 70 67 6f 69 6e 67 0a 3b 20 28 68 61 keepgoing.; (ha
0fc0: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 61 72 sh-table-set! ar
0fd0: 67 73 3a 61 72 67 2d 68 61 73 68 20 22 2d 6b 65 gs:arg-hash "-ke
0fe0: 65 70 67 6f 69 6e 67 22 20 23 74 29 0a 28 68 61 epgoing" #t).(ha
0ff0: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 61 72 sh-table-set! ar
1000: 67 73 3a 61 72 67 2d 68 61 73 68 20 22 2d 69 74 gs:arg-hash "-it
1010: 65 6d 70 61 74 74 22 20 22 25 22 29 0a 28 68 61 empatt" "%").(ha
1020: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 61 72 sh-table-set! ar
1030: 67 73 3a 61 72 67 2d 68 61 73 68 20 22 2d 74 65 gs:arg-hash "-te
1040: 73 74 70 61 74 74 22 20 22 25 22 29 0a 28 74 65 stpatt" "%").(te
1050: 73 74 20 22 53 65 74 75 70 20 66 6f 72 20 61 20 st "Setup for a
1060: 72 75 6e 22 20 20 20 20 20 20 20 23 74 20 28 62 run" #t (b
1070: 65 67 69 6e 20 28 73 65 74 75 70 2d 66 6f 72 2d egin (setup-for-
1080: 72 75 6e 29 20 23 74 29 29 0a 28 74 65 73 74 20 run) #t)).(test
1090: 22 52 65 6d 6f 76 65 20 74 68 65 20 72 6f 6c 6c "Remove the roll
10a0: 75 70 20 72 75 6e 22 20 23 74 20 28 62 65 67 69 up run" #t (begi
10b0: 6e 20 28 72 65 6d 6f 76 65 2d 72 75 6e 73 29 20 n (remove-runs)
10c0: 23 74 29 29 0a 28 74 65 73 74 20 22 52 75 6e 20 #t)).(test "Run
10d0: 61 20 74 65 73 74 22 20 23 74 20 28 67 65 6e 65 a test" #t (gene
10e0: 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 09 09 ral-run-call ...
10f0: 20 20 20 20 20 20 20 22 2d 72 75 6e 74 65 73 74 "-runtest
1100: 73 22 20 0a 09 09 20 20 20 20 20 20 20 22 72 75 s" ... "ru
1110: 6e 20 61 20 74 65 73 74 22 20 0a 09 09 20 20 20 n a test" ...
1120: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 64 62 20 (lambda (db
1130: 6b 65 79 73 20 6b 65 79 6e 61 6d 65 73 20 6b 65 keys keynames ke
1140: 79 76 61 6c 6c 73 74 29 0a 09 09 09 20 28 6c 65 yvallst).... (le
1150: 74 20 28 28 74 65 73 74 2d 6e 61 6d 65 73 20 27 t ((test-names '
1160: 28 22 72 75 6e 66 69 72 73 74 22 29 29 29 0a 09 ("runfirst")))..
1170: 09 09 20 20 20 28 72 75 6e 2d 74 65 73 74 73 20 .. (run-tests
1180: 64 62 20 74 65 73 74 2d 6e 61 6d 65 73 29 29 29 db test-names)))
1190: 29 29 0a 0a 28 63 68 61 6e 67 65 2d 64 69 72 65 ))..(change-dire
11a0: 63 74 6f 72 79 20 74 65 73 74 2d 77 6f 72 6b 2d ctory test-work-
11b0: 64 69 72 29 0a 28 74 65 73 74 20 22 41 64 64 20 dir).(test "Add
11c0: 61 20 73 74 65 70 22 20 20 23 74 0a 20 20 20 20 a step" #t.
11d0: 20 20 28 62 65 67 69 6e 0a 09 28 74 65 73 74 73 (begin..(tests
11e0: 74 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 20 tep-set-status!
11f0: 64 62 20 31 20 22 72 75 6e 66 69 72 73 74 22 20 db 1 "runfirst"
1200: 22 66 69 72 73 74 73 74 65 70 22 20 22 73 74 61 "firststep" "sta
1210: 72 74 22 20 30 20 27 28 29 20 22 54 68 69 73 20 rt" 0 '() "This
1220: 69 73 20 61 20 63 6f 6d 6d 65 6e 74 22 29 0a 09 is a comment")..
1230: 28 73 6c 65 65 70 20 32 29 0a 09 28 74 65 73 74 (sleep 2)..(test
1240: 73 74 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 step-set-status!
1250: 20 64 62 20 31 20 22 72 75 6e 66 69 72 73 74 22 db 1 "runfirst"
1260: 20 22 66 69 72 73 74 73 74 65 70 22 20 22 65 6e "firststep" "en
1270: 64 22 20 22 70 61 73 73 22 20 27 28 29 20 22 54 d" "pass" '() "T
1280: 68 69 73 20 69 73 20 61 20 64 69 66 66 65 72 65 his is a differe
1290: 6e 74 20 63 6f 6d 6d 65 6e 74 22 29 0a 09 28 73 nt comment")..(s
12a0: 65 74 21 20 74 65 73 74 2d 69 64 20 28 64 62 3a et! test-id (db:
12b0: 74 65 73 74 2d 67 65 74 2d 69 64 20 28 63 61 72 test-get-id (car
12c0: 20 28 64 62 2d 67 65 74 2d 74 65 73 74 73 2d 66 (db-get-tests-f
12d0: 6f 72 2d 72 75 6e 20 64 62 20 31 20 22 72 75 6e or-run db 1 "run
12e0: 66 69 72 73 74 22 20 22 22 29 29 29 29 0a 09 28 first" ""))))..(
12f0: 6e 75 6d 62 65 72 3f 20 74 65 73 74 2d 69 64 29 number? test-id)
1300: 29 29 0a 0a 28 74 65 73 74 20 22 47 65 74 20 6e ))..(test "Get n
1310: 69 63 65 20 74 61 62 6c 65 20 66 6f 72 20 73 74 ice table for st
1320: 65 70 73 22 20 22 32 2e 30 73 22 0a 20 20 20 20 eps" "2.0s".
1330: 20 20 28 62 65 67 69 6e 0a 09 28 76 65 63 74 6f (begin..(vecto
1340: 72 2d 72 65 66 20 28 68 61 73 68 2d 74 61 62 6c r-ref (hash-tabl
1350: 65 2d 72 65 66 20 28 64 62 3a 67 65 74 2d 73 74 e-ref (db:get-st
1360: 65 70 73 2d 74 61 62 6c 65 20 64 62 20 74 65 73 eps-table db tes
1370: 74 2d 69 64 29 20 22 66 69 72 73 74 73 74 65 70 t-id) "firststep
1380: 22 29 20 34 29 29 29 0a 0a 28 68 61 73 68 2d 74 ") 4)))..(hash-t
1390: 61 62 6c 65 2d 73 65 74 21 20 61 72 67 73 3a 61 able-set! args:a
13a0: 72 67 2d 68 61 73 68 20 22 3a 72 75 6e 6e 61 6d rg-hash ":runnam
13b0: 65 22 20 22 72 6f 6c 6c 75 70 22 29 0a 0a 28 74 e" "rollup")..(t
13c0: 65 73 74 20 22 52 65 6d 6f 76 65 20 74 68 65 20 est "Remove the
13d0: 72 6f 6c 6c 75 70 20 72 75 6e 22 20 23 74 20 28 rollup run" #t (
13e0: 62 65 67 69 6e 20 28 72 65 6d 6f 76 65 2d 72 75 begin (remove-ru
13f0: 6e 73 29 20 23 74 29 29 0a 28 74 65 73 74 20 22 ns) #t)).(test "
1400: 52 6f 6c 6c 75 70 20 74 68 65 20 72 75 6e 28 73 Rollup the run(s
1410: 29 22 20 23 74 20 28 62 65 67 69 6e 0a 09 09 09 )" #t (begin....
1420: 20 20 20 20 20 20 20 28 72 75 6e 73 3a 72 6f 6c (runs:rol
1430: 6c 75 70 2d 72 75 6e 20 64 62 20 6b 65 79 73 29 lup-run db keys)
1440: 0a 09 09 09 20 20 20 20 20 20 20 23 74 29 29 0a .... #t)).