Artifact
6debbc62bb509b4e79a1b91778a630c8b575e12e:
0000: 28 72 65 71 75 69 72 65 2d 65 78 74 65 6e 73 69 (require-extensi
0010: 6f 6e 20 74 65 73 74 29 0a 28 72 65 71 75 69 72 on test).(requir
0020: 65 2d 65 78 74 65 6e 73 69 6f 6e 20 72 65 67 65 e-extension rege
0030: 78 29 0a 0a 28 64 65 66 69 6e 65 20 74 65 73 74 x)..(define test
0040: 2d 77 6f 72 6b 2d 64 69 72 20 28 63 75 72 72 65 -work-dir (curre
0050: 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 29 0a 0a nt-directory))..
0060: 3b 3b 20 72 65 61 64 20 69 6e 20 61 6c 6c 20 74 ;; read in all t
0070: 68 65 20 5f 72 65 63 6f 72 64 20 66 69 6c 65 73 he _record files
0080: 0a 28 6c 65 74 20 28 28 66 69 6c 65 73 20 28 67 .(let ((files (g
0090: 6c 6f 62 20 22 2a 5f 72 65 63 6f 72 64 73 2e 73 lob "*_records.s
00a0: 63 6d 22 29 29 29 0a 20 20 28 66 6f 72 2d 65 61 cm"))). (for-ea
00b0: 63 68 0a 20 20 20 28 6c 61 6d 62 64 61 20 28 66 ch. (lambda (f
00c0: 69 6c 65 29 0a 20 20 20 20 20 28 70 72 69 6e 74 ile). (print
00d0: 20 22 4c 6f 61 64 69 6e 67 20 22 20 66 69 6c 65 "Loading " file
00e0: 29 0a 20 20 20 20 20 28 6c 6f 61 64 20 66 69 6c ). (load fil
00f0: 65 29 29 0a 20 20 20 66 69 6c 65 73 29 29 0a 0a e)). files))..
0100: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
0110: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0120: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0130: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0140: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 50 20 52 20 ========.;; P R
0150: 4f 20 43 20 45 20 53 20 53 20 45 20 53 0a 3b 3b O C E S S E S.;;
0160: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0170: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0180: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0190: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01a0: 3d 3d 3d 3d 3d 3d 0a 0a 28 74 65 73 74 20 22 63 ======..(test "c
01b0: 6d 64 2d 72 75 6e 2d 77 69 74 68 2d 73 74 64 65 md-run-with-stde
01c0: 72 72 2d 3e 6c 69 73 74 22 20 27 28 22 4e 6f 20 rr->list" '("No
01d0: 73 75 63 68 20 66 69 6c 65 20 6f 72 20 64 69 72 such file or dir
01e0: 65 63 74 6f 72 79 22 29 0a 20 20 20 20 20 20 28 ectory"). (
01f0: 6c 65 74 20 28 28 72 65 73 6c 73 74 20 28 63 6d let ((reslst (cm
0200: 64 2d 72 75 6e 2d 77 69 74 68 2d 73 74 64 65 72 d-run-with-stder
0210: 72 2d 3e 6c 69 73 74 20 22 6c 73 22 20 22 2f 74 r->list "ls" "/t
0220: 6d 70 2f 69 68 61 64 62 65 74 74 65 72 6e 6f 74 mp/ihadbetternot
0230: 65 78 69 73 74 22 29 29 29 0a 09 28 73 74 72 69 exist")))..(stri
0240: 6e 67 2d 73 65 61 72 63 68 20 28 72 65 67 65 78 ng-search (regex
0250: 70 20 22 4e 6f 20 73 75 63 68 20 66 69 6c 65 20 p "No such file
0260: 6f 72 20 64 69 72 65 63 74 6f 72 79 22 29 28 63 or directory")(c
0270: 61 72 20 72 65 73 6c 73 74 29 29 29 29 0a 0a 3b ar reslst))))..;
0280: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
0290: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
02a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
02b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
02c0: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 20 4f 20 4e =======.;; C O N
02d0: 20 46 20 49 20 47 20 20 20 46 20 49 20 4c 20 45 F I G F I L E
02e0: 20 53 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d S .;;==========
02f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0300: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0310: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0320: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 ============..(d
0330: 65 66 69 6e 65 20 63 6f 6e 66 66 69 6c 65 20 23 efine conffile #
0340: 66 29 0a 28 74 65 73 74 20 22 52 65 61 64 20 61 f).(test "Read a
0350: 20 63 6f 6e 66 69 67 22 20 23 74 20 28 68 61 73 config" #t (has
0360: 68 2d 74 61 62 6c 65 3f 20 28 72 65 61 64 2d 63 h-table? (read-c
0370: 6f 6e 66 69 67 20 22 74 65 73 74 2e 63 6f 6e 66 onfig "test.conf
0380: 69 67 22 20 23 66 20 23 66 29 29 29 0a 28 74 65 ig" #f #f))).(te
0390: 73 74 20 22 52 65 61 64 20 61 20 63 6f 6e 66 69 st "Read a confi
03a0: 67 20 74 68 61 74 20 64 6f 65 73 6e 27 74 20 65 g that doesn't e
03b0: 78 69 73 74 22 20 23 74 20 28 68 61 73 68 2d 74 xist" #t (hash-t
03c0: 61 62 6c 65 3f 20 28 72 65 61 64 2d 63 6f 6e 66 able? (read-conf
03d0: 69 67 20 22 6e 61 64 61 2e 63 6f 6e 66 69 67 22 ig "nada.config"
03e0: 20 23 66 20 23 66 29 29 29 0a 0a 28 73 65 74 21 #f #f)))..(set!
03f0: 20 63 6f 6e 66 66 69 6c 65 20 28 72 65 61 64 2d conffile (read-
0400: 63 6f 6e 66 69 67 20 22 74 65 73 74 2e 63 6f 6e config "test.con
0410: 66 69 67 22 20 23 66 20 23 66 29 29 0a 28 74 65 fig" #f #f)).(te
0420: 73 74 20 22 47 65 74 20 61 76 61 69 6c 61 62 6c st "Get availabl
0430: 65 20 64 69 73 6b 73 70 61 63 65 22 20 23 74 20 e diskspace" #t
0440: 28 6e 75 6d 62 65 72 3f 20 28 67 65 74 2d 64 66 (number? (get-df
0450: 20 22 2e 2f 22 29 29 29 0a 28 74 65 73 74 20 22 "./"))).(test "
0460: 47 65 74 20 62 65 73 74 20 64 69 72 22 20 23 74 Get best dir" #t
0470: 20 28 6c 65 74 20 28 28 62 65 73 74 64 69 72 20 (let ((bestdir
0480: 28 67 65 74 2d 62 65 73 74 2d 64 69 73 6b 20 63 (get-best-disk c
0490: 6f 6e 66 66 69 6c 65 29 29 29 0a 09 09 09 20 20 onffile)))....
04a0: 20 20 20 20 28 6f 72 20 28 65 71 75 61 6c 3f 20 (or (equal?
04b0: 22 2e 2f 22 20 20 20 62 65 73 74 64 69 72 29 0a "./" bestdir).
04c0: 09 09 09 09 20 20 28 65 71 75 61 6c 3f 20 22 2f .... (equal? "/
04d0: 74 6d 70 22 20 62 65 73 74 64 69 72 29 29 29 29 tmp" bestdir))))
04e0: 0a 28 74 65 73 74 20 22 4d 75 6c 74 69 6c 69 6e .(test "Multilin
04f0: 65 20 76 61 72 69 61 62 6c 65 22 20 34 20 28 6c e variable" 4 (l
0500: 65 6e 67 74 68 20 28 73 74 72 69 6e 67 2d 73 70 ength (string-sp
0510: 6c 69 74 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b lit (config-look
0520: 75 70 20 63 6f 6e 66 66 69 6c 65 20 22 6d 65 74 up conffile "met
0530: 61 64 61 74 61 22 20 22 64 65 73 63 72 69 70 74 adata" "descript
0540: 69 6f 6e 22 29 20 22 5c 6e 22 29 29 29 0a 0a 3b ion") "\n")))..;
0550: 3b 20 64 62 0a 28 64 65 66 69 6e 65 20 72 6f 77 ; db.(define row
0560: 20 20 20 20 28 76 65 63 74 6f 72 20 22 61 22 20 (vector "a"
0570: 22 62 22 20 22 63 22 20 22 62 6c 61 68 22 29 29 "b" "c" "blah"))
0580: 0a 28 64 65 66 69 6e 65 20 68 65 61 64 65 72 20 .(define header
0590: 28 6c 69 73 74 20 22 63 6f 6c 31 22 20 22 63 6f (list "col1" "co
05a0: 6c 32 22 20 22 63 6f 6c 33 22 20 22 63 6f 6c 34 l2" "col3" "col4
05b0: 22 29 29 0a 28 74 65 73 74 20 22 47 65 74 20 72 ")).(test "Get r
05c0: 6f 77 20 62 79 20 68 65 61 64 65 72 22 20 22 62 ow by header" "b
05d0: 6c 61 68 22 20 28 64 62 3a 67 65 74 2d 76 61 6c lah" (db:get-val
05e0: 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 6f 77 ue-by-header row
05f0: 20 68 65 61 64 65 72 20 22 63 6f 6c 34 22 29 29 header "col4"))
0600: 0a 0a 3b 3b 20 28 64 65 66 69 6e 65 20 2a 74 6f ..;; (define *to
0610: 70 70 61 74 68 2a 20 22 74 65 73 74 73 22 29 0a ppath* "tests").
0620: 28 64 65 66 69 6e 65 20 2a 64 62 2a 20 23 66 29 (define *db* #f)
0630: 0a 28 74 65 73 74 20 22 73 65 74 75 70 20 66 6f .(test "setup fo
0640: 72 20 72 75 6e 22 20 23 74 20 28 62 65 67 69 6e r run" #t (begin
0650: 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 (setup-for-run)
0660: 0a 09 09 09 09 28 73 74 72 69 6e 67 3f 20 28 67 .....(string? (g
0670: 65 74 65 6e 76 20 22 4d 54 5f 52 55 4e 5f 41 52 etenv "MT_RUN_AR
0680: 45 41 5f 48 4f 4d 45 22 29 29 29 29 0a 28 74 65 EA_HOME")))).(te
0690: 73 74 20 22 6f 70 65 6e 2d 64 62 22 20 23 74 20 st "open-db" #t
06a0: 28 62 65 67 69 6e 0a 09 09 20 20 20 20 20 28 73 (begin... (s
06b0: 65 74 21 20 2a 64 62 2a 20 28 6f 70 65 6e 2d 64 et! *db* (open-d
06c0: 62 29 29 0a 09 09 20 20 20 20 20 28 69 66 20 2a b))... (if *
06d0: 64 62 2a 20 23 74 20 23 66 29 29 29 0a 0a 3b 3b db* #t #f)))..;;
06e0: 20 71 75 69 74 20 77 61 73 74 69 6e 67 20 74 69 quit wasting ti
06f0: 6d 65 2c 20 49 27 6d 20 63 68 61 6e 67 69 6e 67 me, I'm changing
0700: 20 2a 64 62 2a 20 74 6f 20 64 62 0a 28 64 65 66 *db* to db.(def
0710: 69 6e 65 20 64 62 20 2a 64 62 2a 29 0a 0a 28 74 ine db *db*)..(t
0720: 65 73 74 20 22 67 65 74 20 63 70 75 20 6c 6f 61 est "get cpu loa
0730: 64 22 20 23 74 20 28 6e 75 6d 62 65 72 3f 20 28 d" #t (number? (
0740: 67 65 74 2d 63 70 75 2d 6c 6f 61 64 29 29 29 0a get-cpu-load))).
0750: 28 74 65 73 74 20 22 67 65 74 20 75 6e 61 6d 65 (test "get uname
0760: 22 20 20 20 20 23 74 20 28 73 74 72 69 6e 67 3f " #t (string?
0770: 20 28 67 65 74 2d 75 6e 61 6d 65 29 29 29 0a 0a (get-uname)))..
0780: 28 74 65 73 74 20 22 67 65 74 20 76 61 6c 69 64 (test "get valid
0790: 76 61 6c 75 65 73 20 61 73 20 6c 69 73 74 22 20 values as list"
07a0: 28 6c 69 73 74 20 22 73 74 61 72 74 22 20 22 65 (list "start" "e
07b0: 6e 64 22 20 22 63 6f 6d 70 6c 65 74 65 64 22 29 nd" "completed")
07c0: 0a 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 73 . (string-s
07d0: 70 6c 69 74 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f plit (config-loo
07e0: 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 kup *configdat*
07f0: 22 76 61 6c 69 64 76 61 6c 75 65 73 22 20 22 73 "validvalues" "s
0800: 74 61 74 65 22 29 29 29 0a 0a 28 66 6f 72 2d 65 tate")))..(for-e
0810: 61 63 68 20 28 6c 61 6d 62 64 61 20 28 69 74 65 ach (lambda (ite
0820: 6d 29 0a 09 20 20 20 20 28 74 65 73 74 20 28 63 m).. (test (c
0830: 6f 6e 63 20 22 67 65 74 20 76 61 6c 69 64 20 69 onc "get valid i
0840: 74 65 6d 73 20 28 22 20 69 74 65 6d 20 22 29 22 tems (" item ")"
0850: 29 0a 09 09 20 20 69 74 65 6d 20 28 63 68 65 63 )... item (chec
0860: 6b 2d 76 61 6c 69 64 2d 69 74 65 6d 73 20 22 73 k-valid-items "s
0870: 74 61 74 65 22 20 69 74 65 6d 29 29 29 0a 09 20 tate" item)))..
0880: 20 28 6c 69 73 74 20 22 73 74 61 72 74 22 20 22 (list "start" "
0890: 65 6e 64 22 20 22 63 6f 6d 70 6c 65 74 65 64 22 end" "completed"
08a0: 29 29 0a 0a 28 66 6f 72 2d 65 61 63 68 20 28 6c ))..(for-each (l
08b0: 61 6d 62 64 61 20 28 69 74 65 6d 29 0a 09 20 20 ambda (item)..
08c0: 20 20 28 74 65 73 74 20 28 63 6f 6e 63 20 22 67 (test (conc "g
08d0: 65 74 20 76 61 6c 69 64 20 69 74 65 6d 73 20 28 et valid items (
08e0: 22 20 69 74 65 6d 20 22 29 22 29 0a 09 09 20 20 " item ")")...
08f0: 69 74 65 6d 20 28 63 68 65 63 6b 2d 76 61 6c 69 item (check-vali
0900: 64 2d 69 74 65 6d 73 20 22 73 74 61 74 75 73 22 d-items "status"
0910: 20 69 74 65 6d 29 29 29 0a 09 20 20 28 6c 69 73 item))).. (lis
0920: 74 20 22 70 61 73 73 22 20 22 66 61 69 6c 22 20 t "pass" "fail"
0930: 22 6e 2f 61 22 29 29 0a 0a 28 74 65 73 74 20 22 "n/a"))..(test "
0940: 77 72 69 74 65 20 65 6e 76 20 66 69 6c 65 73 22 write env files"
0950: 20 22 6e 61 64 61 2e 63 73 68 22 20 28 62 65 67 "nada.csh" (beg
0960: 69 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 in.
0970: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0980: 20 20 20 20 20 20 20 20 20 28 73 61 76 65 2d 65 (save-e
0990: 6e 76 69 72 6f 6e 6d 65 6e 74 2d 61 73 2d 66 69 nvironment-as-fi
09a0: 6c 65 73 20 22 6e 61 64 61 22 29 0a 20 20 20 20 les "nada").
09b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
09c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
09d0: 20 20 28 61 6e 64 20 28 66 69 6c 65 2d 65 78 69 (and (file-exi
09e0: 73 74 73 3f 20 22 6e 61 64 61 2e 73 68 22 29 0a sts? "nada.sh").
09f0: 20 20 20 20 09 09 09 20 20 20 20 20 20 20 20 20 ...
0a00: 20 20 20 20 20 20 20 20 28 66 69 6c 65 2d 65 78 (file-ex
0a10: 69 73 74 73 3f 20 22 6e 61 64 61 2e 63 73 68 22 ists? "nada.csh"
0a20: 29 29 29 29 0a 0a 28 74 65 73 74 20 22 67 65 74 ))))..(test "get
0a30: 20 61 6c 6c 20 6c 65 67 61 6c 20 74 65 73 74 73 all legal tests
0a40: 22 20 28 6c 69 73 74 20 22 74 65 73 74 31 22 20 " (list "test1"
0a50: 22 74 65 73 74 32 22 29 20 28 73 6f 72 74 20 28 "test2") (sort (
0a60: 67 65 74 2d 61 6c 6c 2d 6c 65 67 61 6c 2d 74 65 get-all-legal-te
0a70: 73 74 73 29 20 73 74 72 69 6e 67 3c 3d 3f 29 29 sts) string<=?))
0a80: 0a 0a 28 74 65 73 74 20 22 72 65 67 69 73 74 65 ..(test "registe
0a90: 72 2d 74 65 73 74 2c 20 74 65 73 74 20 69 6e 66 r-test, test inf
0aa0: 6f 22 20 22 4e 4f 54 5f 53 54 41 52 54 45 44 22 o" "NOT_STARTED"
0ab0: 0a 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 28 . (begin..(
0ac0: 72 64 62 3a 74 65 73 74 73 2d 72 65 67 69 73 74 rdb:tests-regist
0ad0: 65 72 2d 74 65 73 74 20 2a 64 62 2a 20 31 20 22 er-test *db* 1 "
0ae0: 6e 61 64 61 22 20 22 22 29 0a 09 3b 3b 20 28 72 nada" "")..;; (r
0af0: 64 62 3a 66 6c 75 73 68 2d 71 75 65 75 65 29 0a db:flush-queue).
0b00: 09 28 76 65 63 74 6f 72 2d 72 65 66 20 28 64 62 .(vector-ref (db
0b10: 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 20 2a :get-test-info *
0b20: 64 62 2a 20 31 20 22 6e 61 64 61 22 20 22 22 29 db* 1 "nada" "")
0b30: 20 33 29 29 29 0a 0a 28 74 65 73 74 20 23 66 20 3)))..(test #f
0b40: 22 4e 4f 54 5f 53 54 41 52 54 45 44 22 20 20 20 "NOT_STARTED"
0b50: 20 0a 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 . (begin..
0b60: 28 72 64 62 3a 74 65 73 74 73 2d 72 65 67 69 73 (rdb:tests-regis
0b70: 74 65 72 2d 74 65 73 74 20 23 66 20 31 20 22 6e ter-test #f 1 "n
0b80: 61 64 61 22 20 22 22 29 0a 09 3b 3b 20 28 72 64 ada" "")..;; (rd
0b90: 62 3a 66 6c 75 73 68 2d 71 75 65 75 65 29 0a 09 b:flush-queue)..
0ba0: 28 76 65 63 74 6f 72 2d 72 65 66 20 28 6f 70 65 (vector-ref (ope
0bb0: 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 62 3a 67 n-run-close db:g
0bc0: 65 74 2d 74 65 73 74 2d 69 6e 66 6f 20 23 66 20 et-test-info #f
0bd0: 31 20 22 6e 61 64 61 22 20 22 22 29 20 33 29 29 1 "nada" "") 3))
0be0: 29 0a 0a 28 74 65 73 74 20 22 67 65 74 2d 6b 65 )..(test "get-ke
0bf0: 79 73 22 20 22 53 59 53 54 45 4d 22 20 28 76 65 ys" "SYSTEM" (ve
0c00: 63 74 6f 72 2d 72 65 66 20 28 63 61 72 20 28 64 ctor-ref (car (d
0c10: 62 3a 67 65 74 2d 6b 65 79 73 20 2a 64 62 2a 29 b:get-keys *db*)
0c20: 29 20 30 29 29 3b 3b 20 28 6b 65 79 3a 67 65 74 ) 0));; (key:get
0c30: 2d 66 69 65 6c 64 6e 61 6d 65 20 28 63 61 72 20 -fieldname (car
0c40: 28 73 6f 72 74 20 28 64 62 2d 67 65 74 2d 6b 65 (sort (db-get-ke
0c50: 79 73 20 2a 64 62 2a 29 28 6c 61 6d 62 64 61 20 ys *db*)(lambda
0c60: 28 61 20 62 29 28 73 74 72 69 6e 67 3e 3d 3f 20 (a b)(string>=?
0c70: 28 76 65 63 74 6f 72 2d 72 65 66 20 61 20 30 29 (vector-ref a 0)
0c80: 28 76 65 63 74 6f 72 2d 72 65 66 20 62 20 30 29 (vector-ref b 0)
0c90: 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 ))))))..(define
0ca0: 72 65 6d 61 72 67 73 20 28 61 72 67 73 3a 67 65 remargs (args:ge
0cb0: 74 2d 61 72 67 73 0a 09 09 20 27 28 22 62 61 72 t-args... '("bar
0cc0: 22 20 22 66 6f 6f 22 20 22 3a 72 75 6e 6e 61 6d " "foo" ":runnam
0cd0: 65 22 20 22 62 6f 62 22 20 22 3a 73 79 73 6e 61 e" "bob" ":sysna
0ce0: 6d 65 22 20 22 75 62 75 6e 74 75 22 20 22 3a 66 me" "ubuntu" ":f
0cf0: 73 6e 61 6d 65 22 20 22 6e 66 73 22 20 22 3a 64 sname" "nfs" ":d
0d00: 61 74 61 70 61 74 68 22 20 22 62 6c 61 68 2f 66 atapath" "blah/f
0d10: 6f 6f 22 20 22 6e 61 64 61 22 29 0a 09 09 20 28 oo" "nada")... (
0d20: 6c 69 73 74 20 22 3a 72 75 6e 6e 61 6d 65 22 20 list ":runname"
0d30: 22 3a 73 74 61 74 65 22 20 22 3a 73 74 61 74 75 ":state" ":statu
0d40: 73 22 29 0a 09 09 20 28 6c 69 73 74 20 22 2d 68 s")... (list "-h
0d50: 22 29 0a 09 09 20 61 72 67 73 3a 61 72 67 2d 68 ")... args:arg-h
0d60: 61 73 68 0a 09 09 20 30 29 29 0a 0a 28 74 65 73 ash... 0))..(tes
0d70: 74 20 22 72 65 67 69 73 74 65 72 2d 72 75 6e 22 t "register-run"
0d80: 20 23 74 20 28 6e 75 6d 62 65 72 3f 20 28 72 75 #t (number? (ru
0d90: 6e 73 3a 72 65 67 69 73 74 65 72 2d 72 75 6e 20 ns:register-run
0da0: 2a 64 62 2a 0a 09 09 09 09 09 09 20 20 20 20 28 *db*....... (
0db0: 64 62 3a 67 65 74 2d 6b 65 79 73 20 2a 64 62 2a db:get-keys *db*
0dc0: 29 0a 09 09 09 09 09 09 20 20 20 20 27 28 28 22 )....... '(("
0dd0: 53 59 53 54 45 4d 22 20 22 6b 65 79 31 22 29 28 SYSTEM" "key1")(
0de0: 22 4f 53 22 20 22 6b 65 79 32 22 29 29 0a 09 09 "OS" "key2"))...
0df0: 09 09 09 09 20 20 20 20 22 6d 79 72 75 6e 22 20 .... "myrun"
0e00: 0a 09 09 09 09 09 09 20 20 20 20 22 6e 65 77 22 ....... "new"
0e10: 0a 09 09 09 09 09 09 20 20 20 20 22 6e 2f 61 22 ....... "n/a"
0e20: 20 0a 09 09 09 09 09 09 20 20 20 20 22 62 6f 62 ....... "bob
0e30: 22 29 29 29 0a 28 64 65 66 69 6e 65 20 6b 65 79 "))).(define key
0e40: 73 20 28 64 62 3a 67 65 74 2d 6b 65 79 73 20 2a s (db:get-keys *
0e50: 64 62 2a 29 29 0a 0a 3b 3b 28 74 65 73 74 20 22 db*))..;;(test "
0e60: 75 70 64 61 74 65 2d 74 65 73 74 2d 69 6e 66 6f update-test-info
0e70: 22 20 23 74 20 28 74 65 73 74 2d 75 70 64 61 74 " #t (test-updat
0e80: 65 2d 6d 65 74 61 2d 69 6e 66 6f 20 2a 64 62 2a e-meta-info *db*
0e90: 20 31 20 22 6e 61 64 61 22 20 0a 28 73 65 74 65 1 "nada" .(sete
0ea0: 6e 76 20 22 42 4c 41 48 46 4f 4f 22 20 22 31 32 nv "BLAHFOO" "12
0eb0: 33 34 22 29 0a 28 75 6e 73 65 74 65 6e 76 20 22 34").(unsetenv "
0ec0: 4e 41 44 41 46 4f 4f 22 29 0a 28 74 65 73 74 20 NADAFOO").(test
0ed0: 22 65 6e 76 20 74 65 6d 70 20 6f 76 65 72 72 69 "env temp overri
0ee0: 64 65 73 22 20 22 78 79 7a 22 20 28 6c 65 74 20 des" "xyz" (let
0ef0: 28 28 70 72 65 76 76 61 6c 73 20 28 61 6c 69 73 ((prevvals (alis
0f00: 74 2d 3e 65 6e 76 2d 76 61 72 73 20 27 28 28 22 t->env-vars '(("
0f10: 42 4c 41 48 46 4f 4f 22 20 34 33 32 31 29 28 22 BLAHFOO" 4321)("
0f20: 4e 41 44 41 46 4f 4f 22 20 78 79 7a 29 29 29 29 NADAFOO" xyz))))
0f30: 0a 09 09 09 09 20 20 20 20 20 20 20 28 72 65 73 ..... (res
0f40: 75 6c 74 20 20 20 28 67 65 74 2d 65 6e 76 69 72 ult (get-envir
0f50: 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 onment-variable
0f60: 22 4e 41 44 41 46 4f 4f 22 29 29 29 0a 09 09 09 "NADAFOO")))....
0f70: 09 20 20 20 20 28 61 6c 69 73 74 2d 3e 65 6e 76 . (alist->env
0f80: 2d 76 61 72 73 20 70 72 65 76 76 61 6c 73 29 0a -vars prevvals).
0f90: 09 09 09 09 20 20 20 20 72 65 73 75 6c 74 29 29 .... result))
0fa0: 0a 0a 28 74 65 73 74 20 22 65 6e 76 20 72 65 73 ..(test "env res
0fb0: 74 6f 72 65 64 22 20 22 31 32 33 34 22 20 28 67 tored" "1234" (g
0fc0: 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 et-environment-v
0fd0: 61 72 69 61 62 6c 65 20 22 42 4c 41 48 46 4f 4f ariable "BLAHFOO
0fe0: 22 29 29 0a 0a 0a 28 74 65 73 74 20 22 49 74 65 "))...(test "Ite
0ff0: 6d 73 20 61 73 73 6f 63 22 20 22 45 6c 65 70 68 ms assoc" "Eleph
1000: 61 6e 74 22 20 28 63 61 64 61 72 20 28 63 61 64 ant" (cadar (cad
1010: 72 20 28 69 74 65 6d 2d 61 73 73 6f 63 2d 3e 69 r (item-assoc->i
1020: 74 65 6d 2d 6c 69 73 74 20 27 28 28 22 41 4e 49 tem-list '(("ANI
1030: 4d 41 4c 22 20 22 45 6c 65 70 68 61 6e 74 20 4c MAL" "Elephant L
1040: 69 6f 6e 22 29 28 22 53 45 41 53 4f 4e 22 20 22 ion")("SEASON" "
1050: 53 70 72 69 6e 67 20 46 61 6c 6c 22 29 29 29 29 Spring Fall"))))
1060: 29 29 0a 28 73 65 74 21 20 2a 76 65 72 62 6f 73 )).(set! *verbos
1070: 69 74 79 2a 20 36 29 0a 28 74 65 73 74 20 22 49 ity* 6).(test "I
1080: 74 65 6d 73 20 61 73 73 6f 63 22 20 27 28 29 28 tems assoc" '()(
1090: 69 74 65 6d 2d 61 73 73 6f 63 2d 3e 69 74 65 6d item-assoc->item
10a0: 2d 6c 69 73 74 20 27 28 28 22 61 22 20 22 61 20 -list '(("a" "a
10b0: 62 20 63 20 64 22 29 28 22 62 22 20 22 63 20 64 b c d")("b" "c d
10c0: 20 65 22 29 28 22 63 22 20 22 22 29 28 22 64 22 e")("c" "")("d"
10d0: 29 29 29 29 0a 28 73 65 74 21 20 2a 76 65 72 62 )))).(set! *verb
10e0: 6f 73 69 74 79 2a 20 2d 31 29 0a 28 74 65 73 74 osity* -1).(test
10f0: 20 22 49 74 65 6d 73 20 61 73 73 6f 63 20 65 6d "Items assoc em
1100: 70 74 79 20 69 74 65 6d 73 22 20 27 28 29 20 20 pty items" '()
1110: 20 28 69 74 65 6d 2d 61 73 73 6f 63 2d 3e 69 74 (item-assoc->it
1120: 65 6d 2d 6c 69 73 74 20 27 28 28 22 41 22 29 29 em-list '(("A"))
1130: 29 29 0a 28 73 65 74 21 20 2a 76 65 72 62 6f 73 )).(set! *verbos
1140: 69 74 79 2a 20 31 29 0a 28 74 65 73 74 20 22 49 ity* 1).(test "I
1150: 74 65 6d 73 20 74 61 62 6c 65 22 20 22 53 45 41 tems table" "SEA
1160: 53 4f 4e 22 20 28 63 61 61 64 61 72 20 28 69 74 SON" (caadar (it
1170: 65 6d 2d 74 61 62 6c 65 2d 3e 69 74 65 6d 2d 6c em-table->item-l
1180: 69 73 74 20 27 28 28 22 41 4e 49 4d 41 4c 22 20 ist '(("ANIMAL"
1190: 22 45 6c 65 70 68 61 6e 74 20 4c 69 6f 6e 22 29 "Elephant Lion")
11a0: 28 22 53 45 41 53 4f 4e 22 20 22 53 70 72 69 6e ("SEASON" "Sprin
11b0: 67 20 57 69 6e 74 65 72 22 29 29 29 29 29 0a 28 g Winter"))))).(
11c0: 74 65 73 74 20 22 49 74 65 6d 73 20 74 61 62 6c test "Items tabl
11d0: 65 20 65 6d 70 74 79 20 69 74 65 6d 73 20 49 22 e empty items I"
11e0: 20 27 28 29 20 28 69 74 65 6d 2d 74 61 62 6c 65 '() (item-table
11f0: 2d 3e 69 74 65 6d 2d 6c 69 73 74 20 27 28 28 22 ->item-list '(("
1200: 41 22 29 29 29 29 0a 28 74 65 73 74 20 22 49 74 A")))).(test "It
1210: 65 6d 73 20 74 61 62 6c 65 20 65 6d 70 74 79 20 ems table empty
1220: 69 74 65 6d 73 20 49 49 22 20 27 28 29 20 28 69 items II" '() (i
1230: 74 65 6d 2d 74 61 62 6c 65 2d 3e 69 74 65 6d 2d tem-table->item-
1240: 6c 69 73 74 20 27 28 28 22 41 22 20 22 22 29 29 list '(("A" ""))
1250: 29 29 0a 0a 3b 3b 20 54 65 73 74 20 6f 75 74 20 ))..;; Test out
1260: 74 68 65 20 73 74 65 70 73 20 63 6f 64 65 0a 0a the steps code..
1270: 28 64 65 66 69 6e 65 20 74 65 73 74 2d 69 64 20 (define test-id
1280: 23 66 29 0a 0a 3b 3b 20 66 6f 72 63 65 20 6b 65 #f)..;; force ke
1290: 65 70 67 6f 69 6e 67 0a 3b 20 28 68 61 73 68 2d epgoing.; (hash-
12a0: 74 61 62 6c 65 2d 73 65 74 21 20 61 72 67 73 3a table-set! args:
12b0: 61 72 67 2d 68 61 73 68 20 22 2d 6b 65 65 70 67 arg-hash "-keepg
12c0: 6f 69 6e 67 22 20 23 74 29 0a 28 68 61 73 68 2d oing" #t).(hash-
12d0: 74 61 62 6c 65 2d 73 65 74 21 20 61 72 67 73 3a table-set! args:
12e0: 61 72 67 2d 68 61 73 68 20 22 2d 69 74 65 6d 70 arg-hash "-itemp
12f0: 61 74 74 22 20 22 25 22 29 0a 28 68 61 73 68 2d att" "%").(hash-
1300: 74 61 62 6c 65 2d 73 65 74 21 20 61 72 67 73 3a table-set! args:
1310: 61 72 67 2d 68 61 73 68 20 22 2d 74 65 73 74 70 arg-hash "-testp
1320: 61 74 74 22 20 22 25 22 29 0a 28 68 61 73 68 2d att" "%").(hash-
1330: 74 61 62 6c 65 2d 73 65 74 21 20 61 72 67 73 3a table-set! args:
1340: 61 72 67 2d 68 61 73 68 20 22 2d 74 61 72 67 65 arg-hash "-targe
1350: 74 22 20 22 75 62 75 6e 74 75 2f 72 31 2e 32 22 t" "ubuntu/r1.2"
1360: 29 0a 28 74 65 73 74 20 22 53 65 74 75 70 20 66 ).(test "Setup f
1370: 6f 72 20 61 20 72 75 6e 22 20 20 20 20 20 20 20 or a run"
1380: 23 74 20 28 62 65 67 69 6e 20 28 73 65 74 75 70 #t (begin (setup
1390: 2d 66 6f 72 2d 72 75 6e 29 20 23 74 29 29 0a 0a -for-run) #t))..
13a0: 28 64 65 66 69 6e 65 20 2a 74 64 62 2a 20 23 66 (define *tdb* #f
13b0: 29 0a 0a 28 64 65 66 69 6e 65 20 74 65 73 74 64 )..(define testd
13c0: 62 70 61 74 68 20 28 63 6f 6e 63 20 22 2f 74 6d bpath (conc "/tm
13d0: 70 2f 22 20 28 67 65 74 65 6e 76 20 22 55 53 45 p/" (getenv "USE
13e0: 52 22 29 20 22 2f 6d 65 67 61 74 65 73 74 5f 74 R") "/megatest_t
13f0: 65 73 74 69 6e 67 22 29 29 0a 28 73 79 73 74 65 esting")).(syste
1400: 6d 20 28 63 6f 6e 63 20 22 72 6d 20 2d 66 20 22 m (conc "rm -f "
1410: 20 74 65 73 74 64 62 70 61 74 68 20 22 2f 74 65 testdbpath "/te
1420: 73 74 64 61 74 2e 64 62 3b 6d 6b 64 69 72 20 2d stdat.db;mkdir -
1430: 70 20 22 20 74 65 73 74 64 62 70 61 74 68 29 29 p " testdbpath))
1440: 0a 0a 28 70 72 69 6e 74 20 22 55 73 69 6e 67 20 ..(print "Using
1450: 22 20 74 65 73 74 64 62 70 61 74 68 20 22 20 66 " testdbpath " f
1460: 6f 72 20 74 65 73 74 20 64 62 22 29 0a 28 74 65 or test db").(te
1470: 73 74 20 23 66 20 23 74 20 28 6c 65 74 20 28 28 st #f #t (let ((
1480: 64 62 20 28 6f 70 65 6e 2d 74 65 73 74 2d 64 62 db (open-test-db
1490: 20 74 65 73 74 64 62 70 61 74 68 29 29 29 0a 09 testdbpath)))..
14a0: 20 20 20 20 20 20 28 73 65 74 21 20 2a 74 64 62 (set! *tdb
14b0: 2a 20 64 62 29 0a 09 20 20 20 20 20 20 28 73 71 * db).. (sq
14c0: 6c 69 74 65 33 23 64 61 74 61 62 61 73 65 3f 20 lite3#database?
14d0: 64 62 29 29 29 0a 28 73 71 6c 69 74 65 33 23 66 db))).(sqlite3#f
14e0: 69 6e 61 6c 69 7a 65 21 20 2a 74 64 62 2a 29 0a inalize! *tdb*).
14f0: 0a 3b 3b 20 28 74 65 73 74 20 22 52 65 6d 6f 76 .;; (test "Remov
1500: 65 20 74 68 65 20 72 6f 6c 6c 75 70 20 72 75 6e e the rollup run
1510: 22 20 23 74 20 28 62 65 67 69 6e 20 28 72 65 6d " #t (begin (rem
1520: 6f 76 65 2d 72 75 6e 73 29 20 23 74 29 29 0a 28 ove-runs) #t)).(
1530: 64 65 66 69 6e 65 20 74 63 6f 6e 66 69 67 20 23 define tconfig #
1540: 66 29 0a 28 74 65 73 74 20 22 67 65 74 20 61 20 f).(test "get a
1550: 74 65 73 74 63 6f 6e 66 69 67 22 20 23 74 20 28 testconfig" #t (
1560: 6c 65 74 20 28 28 74 63 6f 6e 66 20 28 74 65 73 let ((tconf (tes
1570: 74 73 3a 67 65 74 2d 74 65 73 74 63 6f 6e 66 69 ts:get-testconfi
1580: 67 20 22 74 65 73 74 31 22 20 27 72 65 74 75 72 g "test1" 'retur
1590: 6e 2d 70 72 6f 63 73 29 29 29 0a 09 09 09 20 20 n-procs)))....
15a0: 20 20 20 20 28 73 65 74 21 20 74 63 6f 6e 66 69 (set! tconfi
15b0: 67 20 74 63 6f 6e 66 29 0a 09 09 09 20 20 20 20 g tconf)....
15c0: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 3f 20 74 (hash-table? t
15d0: 63 6f 6e 66 29 29 29 0a 28 64 62 3a 63 6c 65 61 conf))).(db:clea
15e0: 6e 2d 61 6c 6c 2d 63 61 63 68 65 73 29 0a 3b 3b n-all-caches).;;
15f0: 20 28 73 65 74 21 20 2a 76 65 72 62 6f 73 69 74 (set! *verbosit
1600: 79 2a 20 32 30 29 0a 28 74 65 73 74 20 22 52 75 y* 20).(test "Ru
1610: 6e 20 61 20 74 65 73 74 22 20 23 74 20 28 67 65 n a test" #t (ge
1620: 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a neral-run-call .
1630: 09 09 20 20 20 20 20 20 20 22 2d 72 75 6e 74 65 .. "-runte
1640: 73 74 73 22 20 0a 09 09 20 20 20 20 20 20 20 22 sts" ... "
1650: 72 75 6e 20 61 20 74 65 73 74 22 0a 09 09 20 20 run a test"...
1660: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 (lambda (ta
1670: 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 rget runname key
1680: 73 20 6b 65 79 6e 61 6d 65 73 20 6b 65 79 76 61 s keynames keyva
1690: 6c 6c 73 74 29 0a 09 09 09 20 28 6c 65 74 20 28 llst).... (let (
16a0: 28 74 65 73 74 2d 70 61 74 74 73 20 22 74 65 73 (test-patts "tes
16b0: 74 25 22 29 29 0a 09 09 09 20 20 20 3b 3b 20 28 t%")).... ;; (
16c0: 72 75 6e 73 3a 72 75 6e 2d 74 65 73 74 73 20 74 runs:run-tests t
16d0: 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 74 65 arget runname te
16e0: 73 74 2d 70 61 74 74 73 20 75 73 65 72 20 28 6d st-patts user (m
16f0: 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 ake-hash-table))
1700: 0a 09 09 09 20 20 20 28 72 75 6e 3a 74 65 73 74 .... (run:test
1710: 20 31 20 3b 3b 20 72 75 6e 2d 69 64 0a 09 09 09 1 ;; run-id....
1720: 09 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d . (args:get-
1730: 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 0a arg ":runname").
1740: 09 09 09 09 20 20 20 20 20 28 6b 65 79 73 3a 74 .... (keys:t
1750: 61 72 67 65 74 2d 3e 6b 65 79 76 61 6c 20 6b 65 arget->keyval ke
1760: 79 73 20 74 61 72 67 65 74 29 0a 09 09 09 09 20 ys target).....
1770: 20 20 20 20 28 76 65 63 74 6f 72 0a 09 09 09 09 (vector.....
1780: 20 20 20 20 20 20 22 74 65 73 74 31 22 20 20 20 "test1"
1790: 20 20 20 20 20 20 20 20 3b 3b 20 74 65 73 74 6e ;; testn
17a0: 61 6d 65 0a 09 09 09 09 20 20 20 20 20 20 74 63 ame..... tc
17b0: 6f 6e 66 69 67 20 20 20 20 20 20 20 20 20 20 20 onfig
17c0: 3b 3b 20 74 65 73 74 63 6f 6e 66 69 67 0a 09 09 ;; testconfig...
17d0: 09 09 20 20 20 20 20 20 27 28 29 20 20 20 20 20 .. '()
17e0: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 77 61 69 ;; wai
17f0: 74 6f 6e 73 0a 09 09 09 09 20 20 20 20 20 20 30 tons..... 0
1800: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1810: 20 3b 3b 20 70 72 69 6f 72 69 74 79 0a 09 09 09 ;; priority....
1820: 09 20 20 20 20 20 20 23 66 20 20 20 20 20 20 20 . #f
1830: 20 20 20 20 20 20 20 20 20 3b 3b 20 69 74 65 6d ;; item
1840: 73 0a 09 09 09 09 20 20 20 20 20 20 23 66 20 20 s..... #f
1850: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b ;;
1860: 20 69 74 65 6d 73 64 61 74 0a 09 09 09 09 20 20 itemsdat.....
1870: 20 20 20 20 23 66 20 20 20 20 20 20 20 20 20 20 #f
1880: 20 20 20 20 20 20 3b 3b 20 73 70 61 72 65 0a 09 ;; spare..
1890: 09 09 09 20 20 20 20 20 20 29 0a 09 09 09 09 20 ... ).....
18a0: 20 20 20 20 61 72 67 73 3a 61 72 67 2d 68 61 73 args:arg-has
18b0: 68 20 20 20 20 20 20 3b 3b 20 66 6c 61 67 73 20 h ;; flags
18c0: 28 65 2e 67 2e 20 2d 69 74 65 6d 73 70 61 74 74 (e.g. -itemspatt
18d0: 29 0a 09 09 09 09 20 20 20 20 20 23 66 29 29 29 )..... #f)))
18e0: 29 29 0a 0a 28 74 65 73 74 20 22 63 61 63 68 65 ))..(test "cache
18f0: 20 69 73 20 63 6f 68 65 72 65 6e 74 22 20 23 74 is coherent" #t
1900: 20 28 6c 65 74 20 28 28 63 61 63 68 65 64 2d 69 (let ((cached-i
1910: 6e 66 6f 20 28 64 62 3a 67 65 74 2d 74 65 73 74 nfo (db:get-test
1920: 2d 69 6e 66 6f 2d 63 61 63 68 65 64 2d 62 79 2d -info-cached-by-
1930: 69 64 20 64 62 20 32 29 29 0a 09 09 09 09 20 20 id db 2)).....
1940: 20 28 6e 6f 6e 2d 63 61 63 68 65 64 20 20 28 64 (non-cached (d
1950: 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d b:get-test-info-
1960: 6e 6f 74 2d 63 61 63 68 65 64 2d 62 79 2d 69 64 not-cached-by-id
1970: 20 64 62 20 32 29 29 29 0a 09 09 09 20 20 20 20 db 2)))....
1980: 20 20 20 28 70 72 69 6e 74 20 22 5c 6e 43 61 63 (print "\nCac
1990: 68 65 64 3a 20 20 20 20 22 20 63 61 63 68 65 64 hed: " cached
19a0: 2d 69 6e 66 6f 29 0a 09 09 09 20 20 20 20 20 20 -info)....
19b0: 20 28 70 72 69 6e 74 20 22 4e 6f 6e 63 61 63 68 (print "Noncach
19c0: 65 64 3a 20 22 20 6e 6f 6e 2d 63 61 63 68 65 64 ed: " non-cached
19d0: 29 0a 09 09 09 20 20 20 20 20 20 20 28 65 71 75 ).... (equ
19e0: 61 6c 3f 20 63 61 63 68 65 64 2d 69 6e 66 6f 20 al? cached-info
19f0: 6e 6f 6e 2d 63 61 63 68 65 64 29 29 29 0a 0a 28 non-cached)))..(
1a00: 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 change-directory
1a10: 20 74 65 73 74 2d 77 6f 72 6b 2d 64 69 72 29 0a test-work-dir).
1a20: 28 74 65 73 74 20 22 41 64 64 20 61 20 73 74 65 (test "Add a ste
1a30: 70 22 20 20 23 74 0a 20 20 20 20 20 20 28 62 65 p" #t. (be
1a40: 67 69 6e 0a 09 28 64 62 3a 74 65 73 74 73 74 65 gin..(db:testste
1a50: 70 2d 73 65 74 2d 73 74 61 74 75 73 21 20 64 62 p-set-status! db
1a60: 20 32 20 22 73 74 65 70 31 22 20 22 73 74 61 72 2 "step1" "star
1a70: 74 22 20 30 20 22 54 68 69 73 20 69 73 20 61 20 t" 0 "This is a
1a80: 63 6f 6d 6d 65 6e 74 22 20 22 6d 79 6c 6f 67 66 comment" "mylogf
1a90: 69 6c 65 2e 68 74 6d 6c 22 29 0a 09 28 73 6c 65 ile.html")..(sle
1aa0: 65 70 20 32 29 0a 09 28 64 62 3a 74 65 73 74 73 ep 2)..(db:tests
1ab0: 74 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 20 tep-set-status!
1ac0: 64 62 20 32 20 22 73 74 65 70 31 22 20 22 65 6e db 2 "step1" "en
1ad0: 64 22 20 22 70 61 73 73 22 20 22 54 68 69 73 20 d" "pass" "This
1ae0: 69 73 20 61 20 64 69 66 66 65 72 65 6e 74 20 63 is a different c
1af0: 6f 6d 6d 65 6e 74 22 20 22 66 69 6e 61 6c 6c 6f omment" "finallo
1b00: 67 66 69 6c 65 2e 68 74 6d 6c 22 29 0a 09 28 73 gfile.html")..(s
1b10: 65 74 21 20 74 65 73 74 2d 69 64 20 28 64 62 3a et! test-id (db:
1b20: 74 65 73 74 2d 67 65 74 2d 69 64 20 28 63 61 72 test-get-id (car
1b30: 20 28 64 62 3a 67 65 74 2d 74 65 73 74 73 2d 66 (db:get-tests-f
1b40: 6f 72 2d 72 75 6e 20 64 62 20 31 20 22 74 65 73 or-run db 1 "tes
1b50: 74 31 22 20 22 22 20 27 28 29 20 27 28 29 29 29 t1" "" '() '()))
1b60: 29 29 0a 09 28 6e 75 6d 62 65 72 3f 20 74 65 73 ))..(number? tes
1b70: 74 2d 69 64 29 29 29 0a 0a 28 74 65 73 74 20 22 t-id)))..(test "
1b80: 47 65 74 20 72 75 6e 64 69 72 22 20 20 20 20 20 Get rundir"
1b90: 20 20 23 74 20 28 6c 65 74 20 28 28 72 75 6e 64 #t (let ((rund
1ba0: 69 72 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d ir (db:test-get-
1bb0: 72 75 6e 64 69 72 2d 66 72 6f 6d 2d 74 65 73 74 rundir-from-test
1bc0: 2d 69 64 20 64 62 20 74 65 73 74 2d 69 64 29 29 -id db test-id))
1bd0: 29 0a 09 09 09 20 20 20 20 20 20 28 70 72 69 6e ).... (prin
1be0: 74 20 22 52 75 6e 64 69 72 22 20 72 75 6e 64 69 t "Rundir" rundi
1bf0: 72 29 0a 09 09 09 20 20 20 20 20 20 28 73 74 72 r).... (str
1c00: 69 6e 67 3f 20 72 75 6e 64 69 72 29 29 29 0a 28 ing? rundir))).(
1c10: 74 65 73 74 20 22 43 72 65 61 74 65 20 61 20 74 test "Create a t
1c20: 65 73 74 20 64 62 22 20 22 2e 2e 2f 73 69 6d 70 est db" "../simp
1c30: 6c 65 72 75 6e 73 2f 6b 65 79 31 2f 6b 65 79 32 leruns/key1/key2
1c40: 2f 6d 79 72 75 6e 2f 74 65 73 74 31 2f 74 65 73 /myrun/test1/tes
1c50: 74 64 61 74 2e 64 62 22 20 28 6c 65 74 20 28 28 tdat.db" (let ((
1c60: 74 64 62 20 28 64 62 3a 6f 70 65 6e 2d 74 65 73 tdb (db:open-tes
1c70: 74 2d 64 62 2d 62 79 2d 74 65 73 74 2d 69 64 20 t-db-by-test-id
1c80: 64 62 20 74 65 73 74 2d 69 64 29 29 29 0a 09 09 db test-id)))...
1c90: 09 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 23 . (sqlite3#
1ca0: 66 69 6e 61 6c 69 7a 65 21 20 74 64 62 29 0a 09 finalize! tdb)..
1cb0: 09 09 20 20 20 20 20 20 28 66 69 6c 65 2d 65 78 .. (file-ex
1cc0: 69 73 74 73 3f 20 22 2e 2e 2f 73 69 6d 70 6c 65 ists? "../simple
1cd0: 72 75 6e 73 2f 6b 65 79 31 2f 6b 65 79 32 2f 6d runs/key1/key2/m
1ce0: 79 72 75 6e 2f 74 65 73 74 31 2f 74 65 73 74 64 yrun/test1/testd
1cf0: 61 74 2e 64 62 22 29 29 29 0a 28 74 65 73 74 20 at.db"))).(test
1d00: 22 47 65 74 20 73 74 65 70 73 20 66 6f 72 20 74 "Get steps for t
1d10: 65 73 74 22 20 23 74 20 28 3e 20 28 6c 65 6e 67 est" #t (> (leng
1d20: 74 68 20 28 64 62 3a 67 65 74 2d 73 74 65 70 73 th (db:get-steps
1d30: 2d 66 6f 72 2d 74 65 73 74 20 64 62 20 74 65 73 -for-test db tes
1d40: 74 2d 69 64 29 29 20 30 29 29 0a 28 74 65 73 74 t-id)) 0)).(test
1d50: 20 22 47 65 74 20 6e 69 63 65 20 74 61 62 6c 65 "Get nice table
1d60: 20 66 6f 72 20 73 74 65 70 73 22 20 22 32 73 22 for steps" "2s"
1d70: 0a 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 28 . (begin..(
1d80: 76 65 63 74 6f 72 2d 72 65 66 20 28 68 61 73 68 vector-ref (hash
1d90: 2d 74 61 62 6c 65 2d 72 65 66 20 28 64 62 3a 67 -table-ref (db:g
1da0: 65 74 2d 73 74 65 70 73 2d 74 61 62 6c 65 20 64 et-steps-table d
1db0: 62 20 74 65 73 74 2d 69 64 29 20 22 73 74 65 70 b test-id) "step
1dc0: 31 22 29 20 34 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 1") 4)))..;;====
1dd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1de0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1df0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1e00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1e10: 3d 3d 0a 3b 3b 20 52 20 45 20 4d 20 4f 20 54 20 ==.;; R E M O T
1e20: 45 20 20 20 43 20 41 20 4c 20 4c 20 53 20 0a 3b E C A L L S .;
1e30: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
1e40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1e50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1e60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1e70: 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 73 74 61 72 =======..;; star
1e80: 74 20 61 20 73 65 72 76 65 72 20 70 72 6f 63 65 t a server proce
1e90: 73 73 0a 28 73 65 74 21 20 2a 76 65 72 62 6f 73 ss.(set! *verbos
1ea0: 69 74 79 2a 20 31 30 29 0a 28 64 65 66 69 6e 65 ity* 10).(define
1eb0: 20 73 65 72 76 65 72 2d 70 69 64 20 28 70 72 6f server-pid (pro
1ec0: 63 65 73 73 2d 72 75 6e 20 22 2e 2e 2f 2e 2e 2f cess-run "../../
1ed0: 62 69 6e 2f 6d 65 67 61 74 65 73 74 22 20 28 6c bin/megatest" (l
1ee0: 69 73 74 20 22 2d 73 65 72 76 65 72 22 20 22 2d ist "-server" "-
1ef0: 22 20 22 2d 64 65 62 75 67 22 20 28 63 6f 6e 63 " "-debug" (conc
1f00: 20 2a 76 65 72 62 6f 73 69 74 79 2a 29 29 29 29 *verbosity*))))
1f10: 0a 28 73 6c 65 65 70 20 32 29 0a 28 64 65 66 69 .(sleep 2).(defi
1f20: 6e 65 20 73 74 61 72 74 2d 77 61 69 74 20 28 63 ne start-wait (c
1f30: 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 urrent-seconds))
1f40: 0a 28 73 65 72 76 65 72 3a 63 6c 69 65 6e 74 2d .(server:client-
1f50: 73 65 74 75 70 29 0a 28 70 72 69 6e 74 20 22 53 setup).(print "S
1f60: 74 61 72 74 69 6e 67 20 69 6e 74 65 6e 73 69 76 tarting intensiv
1f70: 65 20 63 61 63 68 65 20 61 6e 64 20 72 70 63 20 e cache and rpc
1f80: 74 65 73 74 22 29 0a 28 66 6f 72 2d 65 61 63 68 test").(for-each
1f90: 20 28 6c 61 6d 62 64 61 20 28 70 61 72 61 6d 73 (lambda (params
1fa0: 29 0a 09 20 20 20 20 3b 3b 3b 20 28 72 64 62 3a ).. ;;; (rdb:
1fb0: 74 65 73 74 73 2d 72 65 67 69 73 74 65 72 2d 74 tests-register-t
1fc0: 65 73 74 20 23 66 20 31 20 28 63 6f 6e 63 20 22 est #f 1 (conc "
1fd0: 74 65 73 74 22 20 28 72 61 6e 64 6f 6d 20 32 30 test" (random 20
1fe0: 29 29 20 22 22 29 0a 09 20 20 20 20 28 61 70 70 )) "").. (app
1ff0: 6c 79 20 72 64 62 3a 74 65 73 74 2d 73 65 74 2d ly rdb:test-set-
2000: 73 74 61 74 75 73 2d 73 74 61 74 65 20 74 65 73 status-state tes
2010: 74 2d 69 64 20 70 61 72 61 6d 73 29 0a 09 20 20 t-id params)..
2020: 20 20 28 72 64 62 3a 70 61 73 73 2d 66 61 69 6c (rdb:pass-fail
2030: 2d 63 6f 75 6e 74 73 20 74 65 73 74 2d 69 64 20 -counts test-id
2040: 28 72 61 6e 64 6f 6d 20 31 30 30 29 20 28 72 61 (random 100) (ra
2050: 6e 64 6f 6d 20 31 30 30 29 29 0a 09 20 20 20 20 ndom 100))..
2060: 28 72 64 62 3a 74 65 73 74 2d 72 6f 6c 6c 75 70 (rdb:test-rollup
2070: 2d 74 65 73 74 5f 64 61 74 61 2d 70 61 73 73 2d -test_data-pass-
2080: 66 61 69 6c 20 74 65 73 74 2d 69 64 29 0a 09 20 fail test-id)..
2090: 20 20 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 (thread-sleep
20a0: 21 20 30 2e 30 31 29 29 20 3b 3b 20 63 61 63 68 ! 0.01)) ;; cach
20b0: 65 20 6f 72 64 65 72 69 6e 67 20 67 72 61 6e 75 e ordering granu
20c0: 6c 61 72 69 74 79 20 69 73 20 61 74 20 74 68 65 larity is at the
20d0: 20 73 65 63 6f 6e 64 20 6c 65 76 65 6c 2e 20 53 second level. S
20e0: 68 6f 75 6c 64 20 72 65 61 6c 6c 79 20 62 65 20 hould really be
20f0: 61 74 20 74 68 65 20 6d 73 20 6c 65 76 65 6c 0a at the ms level.
2100: 09 20 20 27 28 28 22 43 4f 4d 50 4c 45 54 45 44 . '(("COMPLETED
2110: 22 20 20 20 20 22 50 41 53 53 22 20 23 66 29 0a " "PASS" #f).
2120: 09 20 20 20 20 28 22 4e 4f 54 5f 53 54 41 52 54 . ("NOT_START
2130: 45 44 22 20 20 22 46 41 49 4c 22 20 22 4a 75 73 ED" "FAIL" "Jus
2140: 74 20 74 65 73 74 69 6e 67 22 29 0a 09 20 20 20 t testing")..
2150: 20 28 22 4e 4f 54 5f 53 54 41 52 54 45 44 22 20 ("NOT_STARTED"
2160: 20 22 46 41 49 4c 22 20 22 4a 75 73 74 20 74 65 "FAIL" "Just te
2170: 73 74 69 6e 67 22 29 0a 09 20 20 20 20 28 22 4e sting").. ("N
2180: 4f 54 5f 53 54 41 52 54 45 44 22 20 20 22 46 41 OT_STARTED" "FA
2190: 49 4c 22 20 22 4a 75 73 74 20 74 65 73 74 69 6e IL" "Just testin
21a0: 67 22 29 0a 09 20 20 20 20 28 22 43 4f 4d 50 4c g").. ("COMPL
21b0: 45 54 45 44 22 20 20 20 20 22 50 41 53 53 22 20 ETED" "PASS"
21c0: 23 66 29 0a 09 20 20 20 20 28 22 4e 4f 54 5f 53 #f).. ("NOT_S
21d0: 54 41 52 54 45 44 22 20 20 22 46 41 49 4c 22 20 TARTED" "FAIL"
21e0: 22 4a 75 73 74 20 74 65 73 74 69 6e 67 22 29 0a "Just testing").
21f0: 09 20 20 20 20 28 22 4b 49 4c 4c 45 44 22 20 20 . ("KILLED"
2200: 20 20 20 20 20 22 55 4e 4b 4e 4f 57 4e 22 20 22 "UNKNOWN" "
2210: 4d 6f 72 65 20 74 65 73 74 69 6e 67 22 29 0a 09 More testing")..
2220: 20 20 20 20 28 22 4e 4f 54 5f 53 54 41 52 54 45 ("NOT_STARTE
2230: 44 22 20 20 22 46 41 49 4c 22 20 22 4a 75 73 74 D" "FAIL" "Just
2240: 20 74 65 73 74 69 6e 67 22 29 0a 09 20 20 20 20 testing")..
2250: 28 22 4e 4f 54 5f 53 54 41 52 54 45 44 22 20 20 ("NOT_STARTED"
2260: 22 46 41 49 4c 22 20 22 4a 75 73 74 20 74 65 73 "FAIL" "Just tes
2270: 74 69 6e 67 22 29 0a 09 20 20 20 20 28 22 43 4f ting").. ("CO
2280: 4d 50 4c 45 54 45 44 22 20 20 20 20 22 50 41 53 MPLETED" "PAS
2290: 53 22 20 23 66 29 0a 09 20 20 20 20 28 22 4e 4f S" #f).. ("NO
22a0: 54 5f 53 54 41 52 54 45 44 22 20 20 22 46 41 49 T_STARTED" "FAI
22b0: 4c 22 20 22 4a 75 73 74 20 74 65 73 74 69 6e 67 L" "Just testing
22c0: 22 29 0a 09 20 20 20 20 28 22 4e 4f 54 5f 53 54 ").. ("NOT_ST
22d0: 41 52 54 45 44 22 20 20 22 46 41 49 4c 22 20 22 ARTED" "FAIL" "
22e0: 4a 75 73 74 20 74 65 73 74 69 6e 67 22 29 0a 09 Just testing")..
22f0: 20 20 20 20 28 22 4b 49 4c 4c 45 44 22 20 20 20 ("KILLED"
2300: 20 20 20 20 22 55 4e 4b 4e 4f 57 4e 22 20 22 4d "UNKNOWN" "M
2310: 6f 72 65 20 74 65 73 74 69 6e 67 22 29 0a 09 20 ore testing")..
2320: 20 20 20 28 22 4e 4f 54 5f 53 54 41 52 54 45 44 ("NOT_STARTED
2330: 22 20 20 22 46 41 49 4c 22 20 22 4a 75 73 74 20 " "FAIL" "Just
2340: 74 65 73 74 69 6e 67 22 29 0a 09 20 20 20 20 28 testing").. (
2350: 22 43 4f 4d 50 4c 45 54 45 44 22 20 20 20 20 22 "COMPLETED" "
2360: 50 41 53 53 22 20 23 66 29 0a 09 20 20 20 20 28 PASS" #f).. (
2370: 22 4e 4f 54 5f 53 54 41 52 54 45 44 22 20 20 22 "NOT_STARTED" "
2380: 46 41 49 4c 22 20 22 4a 75 73 74 20 74 65 73 74 FAIL" "Just test
2390: 69 6e 67 22 29 0a 09 20 20 20 20 28 22 4b 49 4c ing").. ("KIL
23a0: 4c 45 44 22 20 20 20 20 20 20 20 22 55 4e 4b 4e LED" "UNKN
23b0: 4f 57 4e 22 20 22 4d 6f 72 65 20 74 65 73 74 69 OWN" "More testi
23c0: 6e 67 22 29 0a 09 20 20 20 20 28 22 4e 4f 54 5f ng").. ("NOT_
23d0: 53 54 41 52 54 45 44 22 20 20 22 46 41 49 4c 22 STARTED" "FAIL"
23e0: 20 22 4a 75 73 74 20 74 65 73 74 69 6e 67 22 29 "Just testing")
23f0: 0a 09 20 20 20 20 28 22 4e 4f 54 5f 53 54 41 52 .. ("NOT_STAR
2400: 54 45 44 22 20 20 22 46 41 49 4c 22 20 22 4a 75 TED" "FAIL" "Ju
2410: 73 74 20 74 65 73 74 69 6e 67 22 29 0a 09 20 20 st testing")..
2420: 20 20 28 22 43 4f 4d 50 4c 45 54 45 44 22 20 20 ("COMPLETED"
2430: 20 20 22 50 41 53 53 22 20 23 66 29 0a 09 20 20 "PASS" #f)..
2440: 20 20 28 22 4e 4f 54 5f 53 54 41 52 54 45 44 22 ("NOT_STARTED"
2450: 20 20 22 46 41 49 4c 22 20 22 4a 75 73 74 20 74 "FAIL" "Just t
2460: 65 73 74 69 6e 67 22 29 0a 09 20 20 20 20 28 22 esting").. ("
2470: 4e 4f 54 5f 53 54 41 52 54 45 44 22 20 20 22 46 NOT_STARTED" "F
2480: 41 49 4c 22 20 22 4a 75 73 74 20 74 65 73 74 69 AIL" "Just testi
2490: 6e 67 22 29 0a 09 20 20 20 20 28 22 4b 49 4c 4c ng").. ("KILL
24a0: 45 44 22 20 20 20 20 20 20 20 22 55 4e 4b 4e 4f ED" "UNKNO
24b0: 57 4e 22 20 22 4d 6f 72 65 20 74 65 73 74 69 6e WN" "More testin
24c0: 67 22 29 0a 09 20 20 20 20 28 22 4e 4f 54 5f 53 g").. ("NOT_S
24d0: 54 41 52 54 45 44 22 20 20 22 46 41 49 4c 22 20 TARTED" "FAIL"
24e0: 22 4a 75 73 74 20 74 65 73 74 69 6e 67 22 29 0a "Just testing").
24f0: 09 20 20 20 20 28 22 43 4f 4d 50 4c 45 54 45 44 . ("COMPLETED
2500: 22 20 20 20 20 22 50 41 53 53 22 20 23 66 29 0a " "PASS" #f).
2510: 09 20 20 20 20 28 22 4e 4f 54 5f 53 54 41 52 54 . ("NOT_START
2520: 45 44 22 20 20 22 46 41 49 4c 22 20 22 4a 75 73 ED" "FAIL" "Jus
2530: 74 20 74 65 73 74 69 6e 67 22 29 0a 09 20 20 20 t testing")..
2540: 20 28 22 4e 4f 54 5f 53 54 41 52 54 45 44 22 20 ("NOT_STARTED"
2550: 20 22 46 41 49 4c 22 20 22 4a 75 73 74 20 74 65 "FAIL" "Just te
2560: 73 74 69 6e 67 22 29 0a 09 20 20 20 20 28 22 4b sting").. ("K
2570: 49 4c 4c 45 44 22 20 20 20 20 20 20 20 22 55 4e ILLED" "UN
2580: 4b 4e 4f 57 4e 22 20 22 4d 6f 72 65 20 74 65 73 KNOWN" "More tes
2590: 74 69 6e 67 22 29 0a 09 20 20 20 20 28 22 4e 4f ting").. ("NO
25a0: 54 5f 53 54 41 52 54 45 44 22 20 20 22 46 41 49 T_STARTED" "FAI
25b0: 4c 22 20 22 4a 75 73 74 20 74 65 73 74 69 6e 67 L" "Just testing
25c0: 22 29 0a 09 20 20 20 20 28 22 4e 4f 54 5f 53 54 ").. ("NOT_ST
25d0: 41 52 54 45 44 22 20 20 22 46 41 49 4c 22 20 22 ARTED" "FAIL" "
25e0: 4a 75 73 74 20 74 65 73 74 69 6e 67 22 29 0a 09 Just testing")..
25f0: 20 20 20 20 28 22 43 4f 4d 50 4c 45 54 45 44 22 ("COMPLETED"
2600: 20 20 20 20 22 50 41 53 53 22 20 23 66 29 0a 09 "PASS" #f)..
2610: 20 20 20 20 28 22 4e 4f 54 5f 53 54 41 52 54 45 ("NOT_STARTE
2620: 44 22 20 20 22 46 41 49 4c 22 20 22 4a 75 73 74 D" "FAIL" "Just
2630: 20 74 65 73 74 69 6e 67 22 29 0a 09 20 20 20 20 testing")..
2640: 28 22 4b 49 4c 4c 45 44 22 20 20 20 20 20 20 20 ("KILLED"
2650: 22 55 4e 4b 4e 4f 57 4e 22 20 22 4d 6f 72 65 20 "UNKNOWN" "More
2660: 74 65 73 74 69 6e 67 22 29 0a 09 20 20 20 20 28 testing").. (
2670: 22 4e 4f 54 5f 53 54 41 52 54 45 44 22 20 20 22 "NOT_STARTED" "
2680: 46 41 49 4c 22 20 22 4a 75 73 74 20 74 65 73 74 FAIL" "Just test
2690: 69 6e 67 22 29 0a 09 20 20 20 20 28 22 4e 4f 54 ing").. ("NOT
26a0: 5f 53 54 41 52 54 45 44 22 20 20 22 46 41 49 4c _STARTED" "FAIL
26b0: 22 20 22 4a 75 73 74 20 74 65 73 74 69 6e 67 22 " "Just testing"
26c0: 29 0a 09 20 20 20 20 28 22 43 4f 4d 50 4c 45 54 ).. ("COMPLET
26d0: 45 44 22 20 20 20 20 22 50 41 53 53 22 20 23 66 ED" "PASS" #f
26e0: 29 0a 09 20 20 20 20 28 22 4e 4f 54 5f 53 54 41 ).. ("NOT_STA
26f0: 52 54 45 44 22 20 20 22 46 41 49 4c 22 20 22 4a RTED" "FAIL" "J
2700: 75 73 74 20 74 65 73 74 69 6e 67 22 29 0a 09 20 ust testing")..
2710: 20 20 20 28 22 4b 49 4c 4c 45 44 22 20 20 20 20 ("KILLED"
2720: 20 20 20 22 55 4e 4b 4e 4f 57 4e 22 20 22 4d 6f "UNKNOWN" "Mo
2730: 72 65 20 74 65 73 74 69 6e 67 22 29 0a 09 20 20 re testing")..
2740: 20 20 28 22 4b 49 4c 4c 45 44 22 20 20 20 20 20 ("KILLED"
2750: 20 20 22 55 4e 4b 4e 4f 57 4e 22 20 22 4d 6f 72 "UNKNOWN" "Mor
2760: 65 20 74 65 73 74 69 6e 67 22 29 0a 09 20 20 20 e testing")..
2770: 20 29 29 0a 3b 3b 20 6e 6f 77 20 73 65 74 20 61 )).;; now set a
2780: 6c 6c 20 74 65 73 74 73 20 74 6f 20 63 6f 6d 70 ll tests to comp
2790: 6c 65 74 65 64 0a 28 72 64 62 3a 66 6c 75 73 68 leted.(rdb:flush
27a0: 2d 71 75 65 75 65 29 0a 28 6c 65 74 20 28 28 74 -queue).(let ((t
27b0: 65 73 74 73 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 ests (open-run-c
27c0: 6c 6f 73 65 20 64 62 3a 67 65 74 2d 74 65 73 74 lose db:get-test
27d0: 73 2d 66 6f 72 2d 72 75 6e 20 23 66 20 31 20 22 s-for-run #f 1 "
27e0: 25 22 20 22 25 22 20 27 28 29 20 27 28 29 29 29 %" "%" '() '()))
27f0: 29 0a 20 20 28 70 72 69 6e 74 20 22 53 65 74 74 ). (print "Sett
2800: 69 6e 67 20 22 20 28 6c 65 6e 67 74 68 20 74 65 ing " (length te
2810: 73 74 73 29 20 22 20 74 6f 20 43 4f 4d 50 4c 45 sts) " to COMPLE
2820: 54 45 44 2f 50 41 53 53 22 29 0a 20 20 28 66 6f TED/PASS"). (fo
2830: 72 2d 65 61 63 68 0a 20 20 20 28 6c 61 6d 62 64 r-each. (lambd
2840: 61 20 28 74 65 73 74 29 0a 20 20 20 20 20 28 72 a (test). (r
2850: 64 62 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 db:test-set-stat
2860: 75 73 2d 73 74 61 74 65 20 28 64 62 3a 74 65 73 us-state (db:tes
2870: 74 2d 67 65 74 2d 69 64 20 74 65 73 74 29 20 22 t-get-id test) "
2880: 43 4f 4d 50 4c 45 54 45 44 22 20 22 50 41 53 53 COMPLETED" "PASS
2890: 22 20 22 46 6f 72 63 65 64 20 70 61 73 73 22 29 " "Forced pass")
28a0: 29 0a 20 20 20 74 65 73 74 73 29 29 0a 0a 28 70 ). tests))..(p
28b0: 72 69 6e 74 20 22 57 61 69 74 69 6e 67 20 66 6f rint "Waiting fo
28c0: 72 20 73 65 72 76 65 72 20 74 6f 20 62 65 20 64 r server to be d
28d0: 6f 6e 65 2c 20 73 68 6f 75 6c 64 20 62 65 20 61 one, should be a
28e0: 62 6f 75 74 20 32 30 20 73 65 63 6f 6e 64 73 22 bout 20 seconds"
28f0: 29 0a 28 70 72 6f 63 65 73 73 2d 77 61 69 74 20 ).(process-wait
2900: 73 65 72 76 65 72 2d 70 69 64 29 0a 28 74 65 73 server-pid).(tes
2910: 74 20 22 53 65 72 76 65 72 20 77 61 69 74 20 74 t "Server wait t
2920: 69 6d 65 22 20 23 74 20 28 6c 65 74 20 28 28 72 ime" #t (let ((r
2930: 75 6e 2d 64 65 6c 74 61 20 28 2d 20 28 63 75 72 un-delta (- (cur
2940: 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 20 73 74 rent-seconds) st
2950: 61 72 74 2d 77 61 69 74 29 29 29 0a 09 09 09 20 art-wait)))....
2960: 20 20 20 20 20 28 70 72 69 6e 74 20 22 53 65 72 (print "Ser
2970: 76 65 72 20 72 61 6e 20 66 6f 72 20 22 20 72 75 ver ran for " ru
2980: 6e 2d 64 65 6c 74 61 20 22 20 73 65 63 6f 6e 64 n-delta " second
2990: 73 22 29 0a 09 09 09 20 20 20 20 20 20 28 3e 20 s").... (>
29a0: 72 75 6e 2d 64 65 6c 74 61 20 32 30 29 29 29 0a run-delta 20))).
29b0: 0a 28 74 65 73 74 20 22 52 6f 6c 6c 75 70 20 74 .(test "Rollup t
29c0: 68 65 20 72 75 6e 28 73 29 22 20 23 74 20 28 62 he run(s)" #t (b
29d0: 65 67 69 6e 0a 09 09 09 20 20 20 20 20 20 20 28 egin.... (
29e0: 72 75 6e 73 3a 72 6f 6c 6c 75 70 2d 72 75 6e 20 runs:rollup-run
29f0: 6b 65 79 73 20 28 6b 65 79 73 2d 3e 61 6c 69 73 keys (keys->alis
2a00: 74 20 6b 65 79 73 20 22 6e 61 22 29 20 22 72 6f t keys "na") "ro
2a10: 6c 6c 75 70 22 20 22 6d 61 74 74 22 29 0a 09 09 llup" "matt")...
2a20: 09 20 20 20 20 20 20 20 23 74 29 29 0a 0a 28 68 . #t))..(h
2a30: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 61 ash-table-set! a
2a40: 72 67 73 3a 61 72 67 2d 68 61 73 68 20 22 3a 72 rgs:arg-hash ":r
2a50: 75 6e 6e 61 6d 65 22 20 22 25 22 29 0a 0a 28 74 unname" "%")..(t
2a60: 65 73 74 20 22 52 65 6d 6f 76 65 20 74 68 65 20 est "Remove the
2a70: 72 6f 6c 6c 75 70 20 72 75 6e 22 20 23 74 20 28 rollup run" #t (
2a80: 62 65 67 69 6e 20 28 6f 70 65 72 61 74 65 2d 6f begin (operate-o
2a90: 6e 20 27 72 65 6d 6f 76 65 2d 72 75 6e 73 29 29 n 'remove-runs))
2aa0: 29 0a 0a 3b 3b 20 41 44 44 20 4d 45 21 21 21 21 )..;; ADD ME!!!!
2ab0: 20 28 64 62 3a 67 65 74 2d 70 72 65 72 65 71 73 (db:get-prereqs
2ac0: 2d 6e 6f 74 2d 6d 65 74 20 2a 64 62 2a 20 31 20 -not-met *db* 1
2ad0: 27 28 22 72 75 6e 66 69 72 73 74 22 29 20 22 22 '("runfirst") ""
2ae0: 20 6d 6f 64 65 3a 20 27 6e 6f 72 6d 61 6c 29 0a mode: 'normal).
2af0: 3b 3b 20 41 44 44 20 4d 45 21 21 21 21 20 28 72 ;; ADD ME!!!! (r
2b00: 64 62 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 db:get-tests-for
2b10: 2d 72 75 6e 20 2a 64 62 2a 20 31 20 22 72 75 6e -run *db* 1 "run
2b20: 66 69 72 73 74 22 20 23 66 20 27 28 29 20 27 28 first" #f '() '(
2b30: 29 29 0a )).