Artifact
94de7ea81ef73532a19b3a3482d738542a093f10:
0000: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
0010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0040: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 6f 70 79 ========.;; Copy
0050: 72 69 67 68 74 20 32 30 30 36 2d 32 30 31 32 2c right 2006-2012,
0060: 20 4d 61 74 74 68 65 77 20 57 65 6c 6c 61 6e 64 Matthew Welland
0070: 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 69 73 20 70 ..;; .;; This p
0080: 72 6f 67 72 61 6d 20 69 73 20 6d 61 64 65 20 61 rogram is made a
0090: 76 61 69 6c 61 62 6c 65 20 75 6e 64 65 72 20 74 vailable under t
00a0: 68 65 20 47 4e 55 20 47 50 4c 20 76 65 72 73 69 he GNU GPL versi
00b0: 6f 6e 20 32 2e 30 20 6f 72 0a 3b 3b 20 20 67 72 on 2.0 or.;; gr
00c0: 65 61 74 65 72 2e 20 53 65 65 20 74 68 65 20 61 eater. See the a
00d0: 63 63 6f 6d 70 61 6e 79 69 6e 67 20 66 69 6c 65 ccompanying file
00e0: 20 43 4f 50 59 49 4e 47 20 66 6f 72 20 64 65 74 COPYING for det
00f0: 61 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 ails..;; .;; Th
0100: 69 73 20 70 72 6f 67 72 61 6d 20 69 73 20 64 69 is program is di
0110: 73 74 72 69 62 75 74 65 64 20 57 49 54 48 4f 55 stributed WITHOU
0120: 54 20 41 4e 59 20 57 41 52 52 41 4e 54 59 3b 20 T ANY WARRANTY;
0130: 77 69 74 68 6f 75 74 20 65 76 65 6e 20 74 68 65 without even the
0140: 0a 3b 3b 20 20 69 6d 70 6c 69 65 64 20 77 61 72 .;; implied war
0150: 72 61 6e 74 79 20 6f 66 20 4d 45 52 43 48 41 4e ranty of MERCHAN
0160: 54 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 4e TABILITY or FITN
0170: 45 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 43 ESS FOR A PARTIC
0180: 55 4c 41 52 0a 3b 3b 20 20 50 55 52 50 4f 53 45 ULAR.;; PURPOSE
0190: 2e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
01a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 75 73 65 ==========..(use
01e0: 20 73 71 6c 69 74 65 33 20 73 72 66 69 2d 31 20 sqlite3 srfi-1
01f0: 70 6f 73 69 78 20 72 65 67 65 78 2d 63 61 73 65 posix regex-case
0200: 20 62 61 73 65 36 34 20 66 6f 72 6d 61 74 20 64 base64 format d
0210: 6f 74 2d 6c 6f 63 6b 69 6e 67 20 63 73 76 2d 78 ot-locking csv-x
0220: 6d 6c 29 0a 28 72 65 71 75 69 72 65 2d 65 78 74 ml).(require-ext
0230: 65 6e 73 69 6f 6e 20 73 71 6c 69 74 65 33 20 72 ension sqlite3 r
0240: 65 67 65 78 20 70 6f 73 69 78 29 0a 0a 28 72 65 egex posix)..(re
0250: 71 75 69 72 65 2d 65 78 74 65 6e 73 69 6f 6e 20 quire-extension
0260: 28 73 72 66 69 20 31 38 29 20 65 78 74 72 61 73 (srfi 18) extras
0270: 20 74 63 70 20 72 70 63 29 0a 0a 28 69 6d 70 6f tcp rpc)..(impo
0280: 72 74 20 28 70 72 65 66 69 78 20 73 71 6c 69 74 rt (prefix sqlit
0290: 65 33 20 73 71 6c 69 74 65 33 3a 29 29 0a 28 69 e3 sqlite3:)).(i
02a0: 6d 70 6f 72 74 20 28 70 72 65 66 69 78 20 62 61 mport (prefix ba
02b0: 73 65 36 34 20 62 61 73 65 36 34 3a 29 29 0a 0a se64 base64:))..
02c0: 28 64 65 63 6c 61 72 65 20 28 75 6e 69 74 20 63 (declare (unit c
02d0: 6f 6d 6d 6f 6e 29 29 0a 0a 28 69 6e 63 6c 75 64 ommon))..(includ
02e0: 65 20 22 63 6f 6d 6d 6f 6e 5f 72 65 63 6f 72 64 e "common_record
02f0: 73 2e 73 63 6d 22 29 0a 0a 3b 3b 20 28 72 65 71 s.scm")..;; (req
0300: 75 69 72 65 2d 6c 69 62 72 61 72 79 20 6d 61 72 uire-library mar
0310: 67 73 29 0a 3b 3b 20 28 69 6e 63 6c 75 64 65 20 gs).;; (include
0320: 22 6d 61 72 67 73 2e 73 63 6d 22 29 0a 0a 28 64 "margs.scm")..(d
0330: 65 66 69 6e 65 20 67 65 74 65 6e 76 20 67 65 74 efine getenv get
0340: 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 -environment-var
0350: 69 61 62 6c 65 29 0a 0a 28 64 65 66 69 6e 65 20 iable)..(define
0360: 68 6f 6d 65 20 28 67 65 74 65 6e 76 20 22 48 4f home (getenv "HO
0370: 4d 45 22 29 29 0a 28 64 65 66 69 6e 65 20 75 73 ME")).(define us
0380: 65 72 20 28 67 65 74 65 6e 76 20 22 55 53 45 52 er (getenv "USER
0390: 22 29 29 0a 0a 3b 3b 20 67 6c 6f 62 61 6c 20 67 "))..;; global g
03a0: 6c 65 74 63 68 65 73 0a 28 64 65 66 69 6e 65 20 letches.(define
03b0: 2a 64 62 2d 6b 65 79 73 2a 20 23 66 29 0a 28 64 *db-keys* #f).(d
03c0: 65 66 69 6e 65 20 2a 63 6f 6e 66 69 67 69 6e 66 efine *configinf
03d0: 6f 2a 20 23 66 29 0a 28 64 65 66 69 6e 65 20 2a o* #f).(define *
03e0: 63 6f 6e 66 69 67 64 61 74 2a 20 20 23 66 29 0a configdat* #f).
03f0: 28 64 65 66 69 6e 65 20 2a 74 6f 70 70 61 74 68 (define *toppath
0400: 2a 20 20 20 20 23 66 29 0a 28 64 65 66 69 6e 65 * #f).(define
0410: 20 2a 61 6c 72 65 61 64 79 2d 73 65 65 6e 2d 72 *already-seen-r
0420: 75 6e 63 6f 6e 66 69 67 2d 69 6e 66 6f 2a 20 23 unconfig-info* #
0430: 66 29 0a 28 64 65 66 69 6e 65 20 2a 77 61 69 74 f).(define *wait
0440: 69 6e 67 2d 71 75 65 75 65 2a 20 20 20 20 20 28 ing-queue* (
0450: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
0460: 29 0a 28 64 65 66 69 6e 65 20 2a 74 65 73 74 2d ).(define *test-
0470: 6d 65 74 61 2d 75 70 64 61 74 65 64 2a 20 28 6d meta-updated* (m
0480: 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 ake-hash-table))
0490: 0a 28 64 65 66 69 6e 65 20 2a 67 6c 6f 62 61 6c .(define *global
04a0: 65 78 69 74 73 74 61 74 75 73 2a 20 20 30 29 20 exitstatus* 0)
04b0: 3b 3b 20 61 74 74 65 6d 70 74 20 74 6f 20 77 6f ;; attempt to wo
04c0: 72 6b 20 61 72 6f 75 6e 64 20 70 6f 73 73 69 62 rk around possib
04d0: 6c 65 20 74 68 72 65 61 64 20 69 73 73 75 65 73 le thread issues
04e0: 0a 28 64 65 66 69 6e 65 20 2a 70 61 73 73 6e 75 .(define *passnu
04f0: 6d 2a 20 20 20 20 20 20 20 20 20 20 20 30 29 20 m* 0)
0500: 3b 3b 20 77 68 65 6e 20 72 75 6e 6e 69 6e 67 20 ;; when running
0510: 74 72 61 63 6b 20 63 61 6c 6c 73 20 74 6f 20 72 track calls to r
0520: 75 6e 2d 74 65 73 74 73 20 6f 72 20 73 69 6d 69 un-tests or simi
0530: 6c 61 72 0a 0a 3b 3b 20 53 45 52 56 45 52 0a 28 lar..;; SERVER.(
0540: 64 65 66 69 6e 65 20 2a 6d 79 2d 63 6c 69 65 6e define *my-clien
0550: 74 2d 73 69 67 6e 61 74 75 72 65 2a 20 23 66 29 t-signature* #f)
0560: 0a 28 64 65 66 69 6e 65 20 2a 74 72 61 6e 73 70 .(define *transp
0570: 6f 72 74 2d 74 79 70 65 2a 20 20 20 20 27 66 73 ort-type* 'fs
0580: 29 0a 28 64 65 66 69 6e 65 20 2a 6d 65 67 61 74 ).(define *megat
0590: 65 73 74 2d 64 62 2a 20 20 20 20 20 20 20 23 66 est-db* #f
05a0: 29 0a 28 64 65 66 69 6e 65 20 2a 72 70 63 3a 6c ).(define *rpc:l
05b0: 69 73 74 65 6e 65 72 2a 20 20 20 20 20 20 23 66 istener* #f
05c0: 29 20 3b 3b 20 69 66 20 73 65 74 20 75 70 20 66 ) ;; if set up f
05d0: 6f 72 20 73 65 72 76 65 72 20 63 6f 6d 6d 75 6e or server commun
05e0: 69 63 61 74 69 6f 6e 20 74 68 69 73 20 77 69 6c ication this wil
05f0: 6c 20 68 6f 6c 64 20 74 68 65 20 74 63 70 20 70 l hold the tcp p
0600: 6f 72 74 0a 28 64 65 66 69 6e 65 20 2a 72 75 6e ort.(define *run
0610: 72 65 6d 6f 74 65 2a 20 20 20 20 20 20 20 20 20 remote*
0620: 23 66 29 20 3b 3b 20 69 66 20 73 65 74 20 75 70 #f) ;; if set up
0630: 20 66 6f 72 20 73 65 72 76 65 72 20 63 6f 6d 6d for server comm
0640: 75 6e 69 63 61 74 69 6f 6e 20 74 68 69 73 20 77 unication this w
0650: 69 6c 6c 20 68 6f 6c 64 20 3c 68 6f 73 74 20 70 ill hold <host p
0660: 6f 72 74 3e 0a 28 64 65 66 69 6e 65 20 2a 6c 61 ort>.(define *la
0670: 73 74 2d 64 62 2d 61 63 63 65 73 73 2a 20 20 20 st-db-access*
0680: 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 (current-second
0690: 73 29 29 20 20 3b 3b 20 75 70 64 61 74 65 20 77 s)) ;; update w
06a0: 68 65 6e 20 64 62 20 69 73 20 61 63 63 65 73 73 hen db is access
06b0: 65 64 20 76 69 61 20 73 65 72 76 65 72 0a 28 64 ed via server.(d
06c0: 65 66 69 6e 65 20 2a 6d 61 78 2d 63 61 63 68 65 efine *max-cache
06d0: 2d 73 69 7a 65 2a 20 20 20 20 30 29 0a 28 64 65 -size* 0).(de
06e0: 66 69 6e 65 20 2a 6c 6f 67 67 65 64 2d 69 6e 2d fine *logged-in-
06f0: 63 6c 69 65 6e 74 73 2a 20 28 6d 61 6b 65 2d 68 clients* (make-h
0700: 61 73 68 2d 74 61 62 6c 65 29 29 0a 28 64 65 66 ash-table)).(def
0710: 69 6e 65 20 2a 63 6c 69 65 6e 74 2d 6e 6f 6e 2d ine *client-non-
0720: 62 6c 6f 63 6b 69 6e 67 2d 6d 6f 64 65 2a 20 23 blocking-mode* #
0730: 66 29 0a 28 64 65 66 69 6e 65 20 2a 73 65 72 76 f).(define *serv
0740: 65 72 2d 69 64 2a 20 20 20 20 20 20 20 20 20 23 er-id* #
0750: 66 29 0a 28 64 65 66 69 6e 65 20 2a 73 65 72 76 f).(define *serv
0760: 65 72 2d 69 6e 66 6f 2a 20 20 20 20 20 20 20 23 er-info* #
0770: 66 29 0a 28 64 65 66 69 6e 65 20 2a 74 69 6d 65 f).(define *time
0780: 2d 74 6f 2d 65 78 69 74 2a 20 20 20 20 20 20 23 -to-exit* #
0790: 66 29 0a 28 64 65 66 69 6e 65 20 2a 72 65 63 65 f).(define *rece
07a0: 69 76 65 64 2d 72 65 73 70 6f 6e 73 65 2a 20 23 ived-response* #
07b0: 66 29 0a 28 64 65 66 69 6e 65 20 2a 64 65 66 61 f).(define *defa
07c0: 75 6c 74 2d 6e 75 6d 74 72 69 65 73 2a 20 20 31 ult-numtries* 1
07d0: 30 29 0a 28 64 65 66 69 6e 65 20 2a 73 65 72 76 0).(define *serv
07e0: 65 72 2d 72 75 6e 2a 20 20 20 20 20 20 20 20 23 er-run* #
07f0: 74 29 0a 28 64 65 66 69 6e 65 20 2a 64 62 2d 77 t).(define *db-w
0800: 72 69 74 65 2d 61 63 63 65 73 73 2a 20 20 20 23 rite-access* #
0810: 74 29 0a 0a 0a 28 64 65 66 69 6e 65 20 2a 74 61 t)...(define *ta
0820: 72 67 65 74 2a 20 20 20 20 20 20 20 20 20 20 20 rget*
0830: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
0840: 65 29 29 20 3b 3b 20 63 61 63 68 65 20 74 68 65 e)) ;; cache the
0850: 20 74 61 72 67 65 74 20 68 65 72 65 3b 20 74 61 target here; ta
0860: 72 67 65 74 20 69 73 20 6b 65 79 76 61 6c 31 2f rget is keyval1/
0870: 6b 65 79 76 61 6c 32 2f 2e 2e 2e 2f 6b 65 79 76 keyval2/.../keyv
0880: 61 6c 4e 0a 28 64 65 66 69 6e 65 20 2a 6b 65 79 alN.(define *key
0890: 73 2a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 s*
08a0: 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 (make-hash-table
08b0: 29 29 20 3b 3b 20 63 61 63 68 65 20 74 68 65 20 )) ;; cache the
08c0: 6b 65 79 73 20 68 65 72 65 0a 28 64 65 66 69 6e keys here.(defin
08d0: 65 20 2a 6b 65 79 76 61 6c 73 2a 20 20 20 20 20 e *keyvals*
08e0: 20 20 20 20 20 20 28 6d 61 6b 65 2d 68 61 73 68 (make-hash
08f0: 2d 74 61 62 6c 65 29 29 0a 28 64 65 66 69 6e 65 -table)).(define
0900: 20 2a 74 6f 70 74 65 73 74 2d 70 61 74 68 73 2a *toptest-paths*
0910: 20 20 20 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d (make-hash-
0920: 74 61 62 6c 65 29 29 20 3b 3b 20 63 61 63 68 65 table)) ;; cache
0930: 20 74 6f 70 74 65 73 74 20 70 61 74 68 20 73 65 toptest path se
0940: 74 74 69 6e 67 73 20 68 65 72 65 0a 28 64 65 66 ttings here.(def
0950: 69 6e 65 20 2a 74 65 73 74 2d 70 61 74 68 73 2a ine *test-paths*
0960: 20 20 20 20 20 20 20 20 28 6d 61 6b 65 2d 68 61 (make-ha
0970: 73 68 2d 74 61 62 6c 65 29 29 20 3b 3b 20 63 61 sh-table)) ;; ca
0980: 63 68 65 20 74 65 73 74 2d 69 64 20 74 6f 20 74 che test-id to t
0990: 65 73 74 20 72 75 6e 20 70 61 74 68 73 20 68 65 est run paths he
09a0: 72 65 0a 28 64 65 66 69 6e 65 20 2a 74 65 73 74 re.(define *test
09b0: 2d 69 64 73 2a 20 20 20 20 20 20 20 20 20 20 28 -ids* (
09c0: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
09d0: 29 20 3b 3b 20 63 61 63 68 65 20 72 75 6e 2d 69 ) ;; cache run-i
09e0: 64 2c 20 74 65 73 74 6e 61 6d 65 2c 20 61 6e 64 d, testname, and
09f0: 20 69 74 65 6d 2d 70 61 74 68 20 3d 3e 20 74 65 item-path => te
0a00: 73 74 2d 69 64 0a 28 64 65 66 69 6e 65 20 2a 74 st-id.(define *t
0a10: 65 73 74 2d 69 6e 66 6f 2a 20 20 20 20 20 20 20 est-info*
0a20: 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 (make-hash-tab
0a30: 6c 65 29 29 20 3b 3b 20 63 61 63 68 65 20 74 68 le)) ;; cache th
0a40: 65 20 74 65 73 74 20 69 6e 66 6f 20 72 65 63 6f e test info reco
0a50: 72 64 73 2c 20 75 70 64 61 74 65 20 74 68 65 20 rds, update the
0a60: 73 74 61 74 65 2c 20 73 74 61 74 75 73 2c 20 72 state, status, r
0a70: 75 6e 5f 64 75 72 61 74 69 6f 6e 20 65 74 63 2e un_duration etc.
0a80: 20 66 72 6f 6d 20 74 65 73 74 64 61 74 2e 64 62 from testdat.db
0a90: 0a 0a 28 64 65 66 69 6e 65 20 2a 72 75 6e 2d 69 ..(define *run-i
0aa0: 6e 66 6f 2d 63 61 63 68 65 2a 20 20 20 20 28 6d nfo-cache* (m
0ab0: 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 ake-hash-table))
0ac0: 20 3b 3b 20 72 75 6e 20 69 6e 66 6f 20 69 73 20 ;; run info is
0ad0: 73 74 61 62 6c 65 2c 20 6e 6f 20 6e 65 65 64 20 stable, no need
0ae0: 74 6f 20 72 65 67 65 74 0a 0a 3b 3b 20 41 77 66 to reget..;; Awf
0af0: 75 6c 2e 20 50 6c 65 61 73 65 20 46 49 58 4d 45 ul. Please FIXME
0b00: 0a 28 64 65 66 69 6e 65 20 2a 65 6e 76 2d 76 61 .(define *env-va
0b10: 72 73 2d 62 79 2d 72 75 6e 2d 69 64 2a 20 28 6d rs-by-run-id* (m
0b20: 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 ake-hash-table))
0b30: 0a 28 64 65 66 69 6e 65 20 2a 63 75 72 72 65 6e .(define *curren
0b40: 74 2d 72 75 6e 2d 6e 61 6d 65 2a 20 20 20 23 66 t-run-name* #f
0b50: 29 0a 0a 3b 3b 20 54 65 73 74 63 6f 6e 66 69 67 )..;; Testconfig
0b60: 20 61 6e 64 20 72 75 6e 63 6f 6e 66 69 67 20 63 and runconfig c
0b70: 61 63 68 65 73 2e 20 0a 28 64 65 66 69 6e 65 20 aches. .(define
0b80: 2a 74 65 73 74 63 6f 6e 66 69 67 73 2a 20 20 20 *testconfigs*
0b90: 20 20 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 (make-hash-t
0ba0: 61 62 6c 65 29 29 20 3b 3b 20 74 65 73 74 2d 6e able)) ;; test-n
0bb0: 61 6d 65 20 3d 3e 20 74 65 73 74 63 6f 6e 66 69 ame => testconfi
0bc0: 67 0a 28 64 65 66 69 6e 65 20 2a 72 75 6e 63 6f g.(define *runco
0bd0: 6e 66 69 67 73 2a 20 20 20 20 20 20 20 20 28 6d nfigs* (m
0be0: 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 ake-hash-table))
0bf0: 20 3b 3b 20 74 61 72 67 65 74 20 20 20 20 3d 3e ;; target =>
0c00: 20 72 75 6e 63 6f 6e 66 69 67 0a 0a 28 64 65 66 runconfig..(def
0c10: 69 6e 65 20 28 63 6f 6d 6d 6f 6e 3a 63 6c 65 61 ine (common:clea
0c20: 72 2d 63 61 63 68 65 73 29 0a 20 20 28 73 65 74 r-caches). (set
0c30: 21 20 2a 74 61 72 67 65 74 2a 20 20 20 20 20 20 ! *target*
0c40: 20 20 20 20 20 20 20 28 6d 61 6b 65 2d 68 61 73 (make-has
0c50: 68 2d 74 61 62 6c 65 29 29 0a 20 20 28 73 65 74 h-table)). (set
0c60: 21 20 2a 6b 65 79 73 2a 20 20 20 20 20 20 20 20 ! *keys*
0c70: 20 20 20 20 20 20 20 28 6d 61 6b 65 2d 68 61 73 (make-has
0c80: 68 2d 74 61 62 6c 65 29 29 0a 20 20 28 73 65 74 h-table)). (set
0c90: 21 20 2a 6b 65 79 76 61 6c 73 2a 20 20 20 20 20 ! *keyvals*
0ca0: 20 20 20 20 20 20 20 28 6d 61 6b 65 2d 68 61 73 (make-has
0cb0: 68 2d 74 61 62 6c 65 29 29 0a 20 20 28 73 65 74 h-table)). (set
0cc0: 21 20 2a 74 6f 70 74 65 73 74 2d 70 61 74 68 73 ! *toptest-paths
0cd0: 2a 20 20 20 20 20 20 28 6d 61 6b 65 2d 68 61 73 * (make-has
0ce0: 68 2d 74 61 62 6c 65 29 29 0a 20 20 28 73 65 74 h-table)). (set
0cf0: 21 20 2a 74 65 73 74 2d 70 61 74 68 73 2a 20 20 ! *test-paths*
0d00: 20 20 20 20 20 20 20 28 6d 61 6b 65 2d 68 61 73 (make-has
0d10: 68 2d 74 61 62 6c 65 29 29 0a 20 20 28 73 65 74 h-table)). (set
0d20: 21 20 2a 74 65 73 74 2d 69 64 73 2a 20 20 20 20 ! *test-ids*
0d30: 20 20 20 20 20 20 20 28 6d 61 6b 65 2d 68 61 73 (make-has
0d40: 68 2d 74 61 62 6c 65 29 29 0a 20 20 28 73 65 74 h-table)). (set
0d50: 21 20 2a 74 65 73 74 2d 69 6e 66 6f 2a 20 20 20 ! *test-info*
0d60: 20 20 20 20 20 20 20 28 6d 61 6b 65 2d 68 61 73 (make-has
0d70: 68 2d 74 61 62 6c 65 29 29 0a 20 20 28 73 65 74 h-table)). (set
0d80: 21 20 2a 72 75 6e 2d 69 6e 66 6f 2d 63 61 63 68 ! *run-info-cach
0d90: 65 2a 20 20 20 20 20 28 6d 61 6b 65 2d 68 61 73 e* (make-has
0da0: 68 2d 74 61 62 6c 65 29 29 0a 20 20 28 73 65 74 h-table)). (set
0db0: 21 20 2a 65 6e 76 2d 76 61 72 73 2d 62 79 2d 72 ! *env-vars-by-r
0dc0: 75 6e 2d 69 64 2a 20 28 6d 61 6b 65 2d 68 61 73 un-id* (make-has
0dd0: 68 2d 74 61 62 6c 65 29 29 0a 20 20 28 73 65 74 h-table)). (set
0de0: 21 20 2a 74 65 73 74 2d 69 64 2d 63 61 63 68 65 ! *test-id-cache
0df0: 2a 20 20 20 20 20 20 28 6d 61 6b 65 2d 68 61 73 * (make-has
0e00: 68 2d 74 61 62 6c 65 29 29 29 0a 0a 3b 3b 20 47 h-table)))..;; G
0e10: 65 6e 65 72 69 63 20 73 74 72 69 6e 67 20 64 61 eneric string da
0e20: 74 61 62 61 73 65 20 28 6e 6f 72 6d 61 6c 69 7a tabase (normaliz
0e30: 61 74 69 6f 6e 20 6f 66 20 73 6f 72 74 73 29 0a ation of sorts).
0e40: 28 64 65 66 69 6e 65 20 73 64 62 3a 71 72 79 20 (define sdb:qry
0e50: 23 66 29 20 3b 3b 20 28 6d 61 6b 65 2d 73 64 62 #f) ;; (make-sdb
0e60: 3a 71 72 79 29 29 20 3b 3b 20 20 27 69 6e 69 74 :qry)) ;; 'init
0e70: 20 23 66 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d #f)..;;========
0e80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0e90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0ea0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0eb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
0ec0: 3b 20 53 20 54 20 41 20 54 20 45 20 53 20 20 20 ; S T A T E S
0ed0: 41 20 4e 20 44 20 20 20 53 20 54 20 41 20 54 20 A N D S T A T
0ee0: 55 20 53 20 45 20 53 0a 3b 3b 3d 3d 3d 3d 3d 3d U S E S.;;======
0ef0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0f00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0f10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0f20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0f30: 0a 0a 28 64 65 66 69 6e 65 20 2a 63 6f 6d 6d 6f ..(define *commo
0f40: 6e 3a 73 74 64 2d 73 74 61 74 65 73 2a 20 20 20 n:std-states*
0f50: 0a 20 20 28 6c 69 73 74 20 22 43 4f 4d 50 4c 45 . (list "COMPLE
0f60: 54 45 44 22 20 22 4e 4f 54 5f 53 54 41 52 54 45 TED" "NOT_STARTE
0f70: 44 22 20 22 52 55 4e 4e 49 4e 47 22 20 22 52 45 D" "RUNNING" "RE
0f80: 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 22 20 22 MOTEHOSTSTART" "
0f90: 4c 41 55 4e 43 48 45 44 22 20 22 4b 49 4c 4c 45 LAUNCHED" "KILLE
0fa0: 44 22 20 22 4b 49 4c 4c 52 45 51 22 20 22 53 54 D" "KILLREQ" "ST
0fb0: 55 43 4b 22 29 29 0a 0a 28 64 65 66 69 6e 65 20 UCK"))..(define
0fc0: 2a 63 6f 6d 6d 6f 6e 3a 73 74 64 2d 73 74 61 74 *common:std-stat
0fd0: 75 73 65 73 2a 0a 20 20 28 6c 69 73 74 20 20 22 uses*. (list "
0fe0: 50 41 53 53 22 20 22 57 41 52 4e 22 20 22 46 41 PASS" "WARN" "FA
0ff0: 49 4c 22 20 22 43 48 45 43 4b 22 20 22 6e 2f 61 IL" "CHECK" "n/a
1000: 22 20 22 57 41 49 56 45 44 22 20 22 53 4b 49 50 " "WAIVED" "SKIP
1010: 22 20 22 44 45 4c 45 54 45 44 22 20 22 53 54 55 " "DELETED" "STU
1020: 43 4b 2f 44 45 41 44 22 29 29 0a 0a 3b 3b 20 54 CK/DEAD"))..;; T
1030: 68 65 73 65 20 61 72 65 20 73 74 6f 70 70 69 6e hese are stoppin
1040: 67 20 63 6f 6e 64 69 74 69 6f 6e 73 20 74 68 61 g conditions tha
1050: 74 20 70 72 65 76 65 6e 74 20 61 20 74 65 73 74 t prevent a test
1060: 20 66 72 6f 6d 20 62 65 69 6e 67 20 72 75 6e 0a from being run.
1070: 28 64 65 66 69 6e 65 20 2a 63 6f 6d 6d 6f 6e 3a (define *common:
1080: 63 61 6e 74 2d 72 75 6e 2d 73 74 61 74 65 73 2d cant-run-states-
1090: 73 79 6d 2a 20 0a 20 20 27 28 43 4f 4d 50 4c 45 sym* . '(COMPLE
10a0: 54 45 44 20 4b 49 4c 4c 45 44 20 57 41 49 56 45 TED KILLED WAIVE
10b0: 44 20 55 4e 4b 4e 4f 57 4e 20 49 4e 43 4f 4d 50 D UNKNOWN INCOMP
10c0: 4c 45 54 45 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d LETE))..;;======
10d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1100: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1110: 0a 3b 3b 20 44 20 45 20 42 20 55 20 47 20 47 20 .;; D E B U G G
1120: 49 20 4e 20 47 20 20 20 53 20 54 20 55 20 46 20 I N G S T U F
1130: 46 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d F .;;===========
1140: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1150: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1160: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1170: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 ===========..(de
1180: 66 69 6e 65 20 2a 76 65 72 62 6f 73 69 74 79 2a fine *verbosity*
1190: 20 20 20 20 20 20 20 20 20 31 29 0a 28 64 65 66 1).(def
11a0: 69 6e 65 20 2a 6c 6f 67 67 69 6e 67 2a 20 20 20 ine *logging*
11b0: 20 20 20 20 20 20 20 20 23 66 29 0a 0a 28 64 65 #f)..(de
11c0: 66 69 6e 65 20 28 67 65 74 2d 77 69 74 68 2d 64 fine (get-with-d
11d0: 65 66 61 75 6c 74 20 76 61 6c 20 64 65 66 61 75 efault val defau
11e0: 6c 74 29 0a 20 20 28 6c 65 74 20 28 28 76 61 6c lt). (let ((val
11f0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 76 (args:get-arg v
1200: 61 6c 29 29 29 0a 20 20 20 20 28 69 66 20 76 61 al))). (if va
1210: 6c 20 76 61 6c 20 64 65 66 61 75 6c 74 29 29 29 l val default)))
1220: 0a 0a 28 64 65 66 69 6e 65 20 28 61 73 73 6f 63 ..(define (assoc
1230: 2f 64 65 66 61 75 6c 74 20 6b 65 79 20 6c 73 74 /default key lst
1240: 20 2e 20 64 65 66 61 75 6c 74 29 0a 20 20 28 6c . default). (l
1250: 65 74 20 28 28 72 65 73 20 28 61 73 73 6f 63 20 et ((res (assoc
1260: 6b 65 79 20 6c 73 74 29 29 29 0a 20 20 20 20 28 key lst))). (
1270: 69 66 20 72 65 73 20 28 63 61 64 72 20 72 65 73 if res (cadr res
1280: 29 28 69 66 20 28 6e 75 6c 6c 3f 20 64 65 66 61 )(if (null? defa
1290: 75 6c 74 29 20 23 66 20 28 63 61 72 20 64 65 66 ult) #f (car def
12a0: 61 75 6c 74 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d ault)))))..;;===
12b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12f0: 3d 3d 3d 0a 3b 3b 20 4d 69 73 63 20 75 74 69 6c ===.;; Misc util
1300: 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d s.;;============
1310: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1320: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1330: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1340: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 43 ==========..;; C
1350: 6f 6e 76 65 72 74 20 73 74 72 69 6e 67 73 20 6c onvert strings l
1360: 69 6b 65 20 22 35 73 20 32 68 20 33 6d 22 20 3d ike "5s 2h 3m" =
1370: 3e 20 36 30 78 36 30 78 32 20 2b 20 33 78 36 30 > 60x60x2 + 3x60
1380: 20 2b 20 35 0a 28 64 65 66 69 6e 65 20 28 63 6f + 5.(define (co
1390: 6d 6d 6f 6e 3a 68 6d 73 2d 73 74 72 69 6e 67 2d mmon:hms-string-
13a0: 3e 73 65 63 6f 6e 64 73 20 74 73 74 72 29 0a 20 >seconds tstr).
13b0: 20 28 6c 65 74 20 28 28 70 61 72 74 73 20 20 20 (let ((parts
13c0: 20 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 (string-split
13d0: 74 73 74 72 29 29 0a 09 28 74 69 6d 65 2d 73 65 tstr))..(time-se
13e0: 63 73 20 30 29 0a 09 3b 3b 20 73 3d 73 65 63 6f cs 0)..;; s=seco
13f0: 6e 64 73 2c 20 6d 3d 6d 69 6e 75 74 65 73 2c 20 nds, m=minutes,
1400: 68 3d 68 6f 75 72 73 2c 20 64 3d 64 61 79 73 0a h=hours, d=days.
1410: 09 28 74 72 78 20 20 20 20 20 20 20 28 72 65 67 .(trx (reg
1420: 65 78 70 20 22 28 5c 5c 64 2b 29 28 5b 73 6d 68 exp "(\\d+)([smh
1430: 64 5d 29 22 29 29 29 0a 20 20 20 20 28 66 6f 72 d])"))). (for
1440: 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 70 -each (lambda (p
1450: 61 72 74 29 0a 09 09 28 6c 65 74 20 28 28 6d 61 art)...(let ((ma
1460: 74 63 68 20 20 28 73 74 72 69 6e 67 2d 6d 61 74 tch (string-mat
1470: 63 68 20 74 72 78 20 70 61 72 74 29 29 29 0a 09 ch trx part)))..
1480: 09 20 20 28 69 66 20 6d 61 74 63 68 0a 09 09 20 . (if match...
1490: 20 20 20 20 20 28 6c 65 74 20 28 28 76 61 6c 20 (let ((val
14a0: 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 (string->number
14b0: 28 63 61 64 72 20 6d 61 74 63 68 29 29 29 0a 09 (cadr match)))..
14c0: 09 09 20 20 20 20 28 75 6e 74 20 28 63 61 64 64 .. (unt (cadd
14d0: 72 20 6d 61 74 63 68 29 29 29 0a 09 09 09 28 69 r match)))....(i
14e0: 66 20 76 61 6c 20 0a 09 09 09 20 20 20 20 28 73 f val .... (s
14f0: 65 74 21 20 74 69 6d 65 2d 73 65 63 73 20 28 2b et! time-secs (+
1500: 20 74 69 6d 65 2d 73 65 63 73 20 28 2a 20 76 61 time-secs (* va
1510: 6c 0a 09 09 09 09 09 09 09 20 20 20 20 28 63 61 l........ (ca
1520: 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 se (string->symb
1530: 6f 6c 20 75 6e 74 29 0a 09 09 09 09 09 09 09 20 ol unt)........
1540: 20 20 20 20 20 28 28 73 29 20 31 29 0a 09 09 09 ((s) 1)....
1550: 09 09 09 09 20 20 20 20 20 20 28 28 6d 29 20 36 .... ((m) 6
1560: 30 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 0)........
1570: 28 28 68 29 20 28 2a 20 36 30 20 36 30 29 29 0a ((h) (* 60 60)).
1580: 09 09 09 09 09 09 09 20 20 20 20 20 20 28 28 64 ....... ((d
1590: 29 20 28 2a 20 32 34 20 36 30 20 36 30 29 29 0a ) (* 24 60 60)).
15a0: 09 09 09 09 09 09 09 20 20 20 20 20 20 28 65 6c ....... (el
15b0: 73 65 20 30 29 29 29 29 29 29 29 29 29 29 0a 09 se 0))))))))))..
15c0: 20 20 20 20 20 20 70 61 72 74 73 29 0a 20 20 20 parts).
15d0: 20 74 69 6d 65 2d 73 65 63 73 29 29 0a 09 09 20 time-secs))...
15e0: 20 20 20 20 20 20 0a 28 64 65 66 69 6e 65 20 28 .(define (
15f0: 63 6f 6d 6d 6f 6e 3a 76 65 72 73 69 6f 6e 2d 73 common:version-s
1600: 69 67 6e 61 74 75 72 65 29 0a 20 20 28 63 6f 6e ignature). (con
1610: 63 20 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 c megatest-versi
1620: 6f 6e 20 22 2d 22 20 28 73 75 62 73 74 72 69 6e on "-" (substrin
1630: 67 20 6d 65 67 61 74 65 73 74 2d 66 6f 73 73 69 g megatest-fossi
1640: 6c 2d 68 61 73 68 20 30 20 34 29 29 29 0a 0a 3b l-hash 0 4)))..;
1650: 3b 20 6f 6e 65 2d 6f 66 20 61 72 67 73 20 64 65 ; one-of args de
1660: 66 69 6e 65 64 0a 28 64 65 66 69 6e 65 20 28 61 fined.(define (a
1670: 72 67 73 2d 64 65 66 69 6e 65 64 3f 20 2e 20 70 rgs-defined? . p
1680: 61 72 61 6d 29 0a 20 20 28 6c 65 74 20 28 28 72 aram). (let ((r
1690: 65 73 20 23 66 29 29 0a 20 20 20 20 28 66 6f 72 es #f)). (for
16a0: 2d 65 61 63 68 20 0a 20 20 20 20 20 28 6c 61 6d -each . (lam
16b0: 62 64 61 20 28 61 72 67 29 0a 20 20 20 20 20 20 bda (arg).
16c0: 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
16d0: 72 67 20 61 72 67 29 28 73 65 74 21 20 72 65 73 rg arg)(set! res
16e0: 20 23 74 29 29 29 0a 20 20 20 20 20 70 61 72 61 #t))). para
16f0: 6d 29 0a 20 20 20 20 72 65 73 29 29 0a 0a 3b 3b m). res))..;;
1700: 20 63 6f 6e 76 65 72 74 20 73 74 75 66 66 20 74 convert stuff t
1710: 6f 20 61 20 6e 75 6d 62 65 72 20 69 66 20 70 6f o a number if po
1720: 73 73 69 62 6c 65 0a 28 64 65 66 69 6e 65 20 28 ssible.(define (
1730: 61 6e 79 2d 3e 6e 75 6d 62 65 72 20 76 61 6c 29 any->number val)
1740: 0a 20 20 28 63 6f 6e 64 20 0a 20 20 20 28 28 6e . (cond . ((n
1750: 75 6d 62 65 72 3f 20 76 61 6c 29 20 76 61 6c 29 umber? val) val)
1760: 0a 20 20 20 28 28 73 74 72 69 6e 67 3f 20 76 61 . ((string? va
1770: 6c 29 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 l) (string->numb
1780: 65 72 20 76 61 6c 29 29 0a 20 20 20 28 28 73 79 er val)). ((sy
1790: 6d 62 6f 6c 3f 20 76 61 6c 29 20 28 61 6e 79 2d mbol? val) (any-
17a0: 3e 6e 75 6d 62 65 72 20 28 73 79 6d 62 6f 6c 2d >number (symbol-
17b0: 3e 73 74 72 69 6e 67 20 76 61 6c 29 29 29 0a 20 >string val))).
17c0: 20 20 28 65 6c 73 65 20 23 66 29 29 29 0a 0a 28 (else #f)))..(
17d0: 64 65 66 69 6e 65 20 28 61 6e 79 2d 3e 6e 75 6d define (any->num
17e0: 62 65 72 2d 69 66 2d 70 6f 73 73 69 62 6c 65 20 ber-if-possible
17f0: 76 61 6c 29 0a 20 20 28 6c 65 74 20 28 28 6e 75 val). (let ((nu
1800: 6d 20 28 61 6e 79 2d 3e 6e 75 6d 62 65 72 20 76 m (any->number v
1810: 61 6c 29 29 29 0a 20 20 20 20 28 69 66 20 6e 75 al))). (if nu
1820: 6d 20 6e 75 6d 20 76 61 6c 29 29 29 0a 0a 28 64 m num val)))..(d
1830: 65 66 69 6e 65 20 28 70 61 74 74 2d 6c 69 73 74 efine (patt-list
1840: 2d 6d 61 74 63 68 20 69 74 65 6d 20 70 61 74 74 -match item patt
1850: 73 29 0a 20 20 28 64 65 62 75 67 3a 70 72 69 6e s). (debug:prin
1860: 74 2d 69 6e 66 6f 20 38 20 22 70 61 74 74 2d 6c t-info 8 "patt-l
1870: 69 73 74 2d 6d 61 74 63 68 20 69 74 65 6d 3d 22 ist-match item="
1880: 20 69 74 65 6d 20 22 20 70 61 74 74 73 3d 22 20 item " patts="
1890: 70 61 74 74 73 29 0a 20 20 28 69 66 20 28 61 6e patts). (if (an
18a0: 64 20 69 74 65 6d 20 70 61 74 74 73 29 20 20 3b d item patts) ;
18b0: 3b 20 68 65 72 65 20 77 65 20 61 72 65 20 66 69 ; here we are fi
18c0: 6c 74 65 72 69 6e 67 20 66 6f 72 20 6d 61 74 63 ltering for matc
18d0: 68 65 73 20 77 69 74 68 20 69 74 65 6d 20 70 61 hes with item pa
18e0: 74 74 65 72 6e 73 0a 20 20 20 20 20 20 28 6c 65 tterns. (le
18f0: 74 20 28 28 72 65 73 20 23 66 29 29 20 20 20 3b t ((res #f)) ;
1900: 3b 20 6c 6f 6f 6b 20 74 68 72 6f 75 67 68 20 61 ; look through a
1910: 6c 6c 20 74 68 65 20 69 74 65 6d 2d 70 61 74 74 ll the item-patt
1920: 73 20 69 66 20 64 65 66 69 6e 65 64 2c 20 66 6f s if defined, fo
1930: 72 6d 61 74 20 69 73 20 70 61 74 74 31 2c 70 61 rmat is patt1,pa
1940: 74 74 32 2c 70 61 74 74 33 20 2e 2e 2e 20 77 69 tt2,patt3 ... wi
1950: 6c 64 63 61 72 64 20 69 73 20 25 0a 09 28 66 6f ldcard is %..(fo
1960: 72 2d 65 61 63 68 20 0a 09 20 28 6c 61 6d 62 64 r-each .. (lambd
1970: 61 20 28 70 61 74 74 29 0a 09 20 20 20 28 6c 65 a (patt).. (le
1980: 74 20 28 28 6d 6f 64 70 61 74 74 20 28 73 74 72 t ((modpatt (str
1990: 69 6e 67 2d 73 75 62 73 74 69 74 75 74 65 20 22 ing-substitute "
19a0: 25 22 20 22 2e 2a 22 20 70 61 74 74 20 23 74 29 %" ".*" patt #t)
19b0: 29 29 0a 09 20 20 20 20 20 28 64 65 62 75 67 3a )).. (debug:
19c0: 70 72 69 6e 74 2d 69 6e 66 6f 20 31 30 20 22 70 print-info 10 "p
19d0: 61 74 74 20 22 20 70 61 74 74 20 22 20 6d 6f 64 att " patt " mod
19e0: 70 61 74 74 20 22 20 6d 6f 64 70 61 74 74 29 0a patt " modpatt).
19f0: 09 20 20 20 20 20 28 69 66 20 28 73 74 72 69 6e . (if (strin
1a00: 67 2d 6d 61 74 63 68 20 28 72 65 67 65 78 70 20 g-match (regexp
1a10: 6d 6f 64 70 61 74 74 29 20 69 74 65 6d 29 0a 09 modpatt) item)..
1a20: 09 20 28 73 65 74 21 20 72 65 73 20 23 74 29 29 . (set! res #t))
1a30: 29 29 0a 09 20 28 73 74 72 69 6e 67 2d 73 70 6c )).. (string-spl
1a40: 69 74 20 70 61 74 74 73 20 22 2c 22 29 29 0a 09 it patts ","))..
1a50: 72 65 73 29 0a 20 20 20 20 20 20 23 74 29 29 0a res). #t)).
1a60: 0a 3b 3b 20 28 6d 61 70 20 70 72 69 6e 74 20 28 .;; (map print (
1a70: 6d 61 70 20 63 61 72 20 28 68 61 73 68 2d 74 61 map car (hash-ta
1a80: 62 6c 65 2d 3e 61 6c 69 73 74 20 28 72 65 61 64 ble->alist (read
1a90: 2d 63 6f 6e 66 69 67 20 22 72 75 6e 63 6f 6e 66 -config "runconf
1aa0: 69 67 73 2e 63 6f 6e 66 69 67 22 20 23 66 20 23 igs.config" #f #
1ab0: 74 29 29 29 29 0a 28 64 65 66 69 6e 65 20 28 63 t)))).(define (c
1ac0: 6f 6d 6d 6f 6e 3a 67 65 74 2d 72 75 6e 63 6f 6e ommon:get-runcon
1ad0: 66 69 67 2d 74 61 72 67 65 74 73 29 0a 20 20 28 fig-targets). (
1ae0: 73 6f 72 74 20 28 6d 61 70 20 63 61 72 20 28 68 sort (map car (h
1af0: 61 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 ash-table->alist
1b00: 0a 09 09 20 20 28 72 65 61 64 2d 63 6f 6e 66 69 ... (read-confi
1b10: 67 20 22 72 75 6e 63 6f 6e 66 69 67 73 2e 63 6f g "runconfigs.co
1b20: 6e 66 69 67 22 0a 09 09 09 20 20 20 20 20 20 20 nfig"....
1b30: 23 66 20 23 74 29 29 29 20 73 74 72 69 6e 67 3c #f #t))) string<
1b40: 3f 29 29 0a 0a 3b 3b 20 27 28 70 72 69 6e 74 20 ?))..;; '(print
1b50: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
1b60: 72 73 65 20 28 6d 61 70 20 63 61 64 72 20 28 68 rse (map cadr (h
1b70: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
1b80: 66 61 75 6c 74 20 28 72 65 61 64 2d 63 6f 6e 66 fault (read-conf
1b90: 69 67 20 22 6d 65 67 61 74 65 73 74 2e 63 6f 6e ig "megatest.con
1ba0: 66 69 67 22 20 5c 23 66 20 5c 23 74 29 20 22 64 fig" \#f \#t) "d
1bb0: 69 73 6b 73 22 20 27 22 27 22 27 28 22 6e 6f 6e isks" '"'"'("non
1bc0: 65 22 20 22 22 29 29 29 20 22 5c 6e 22 29 29 27 e" ""))) "\n"))'
1bd0: 0a 28 64 65 66 69 6e 65 20 28 63 6f 6d 6d 6f 6e .(define (common
1be0: 3a 67 65 74 2d 64 69 73 6b 73 29 0a 20 20 28 68 :get-disks). (h
1bf0: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
1c00: 66 61 75 6c 74 20 0a 20 20 20 28 72 65 61 64 2d fault . (read-
1c10: 63 6f 6e 66 69 67 20 22 6d 65 67 61 74 65 73 74 config "megatest
1c20: 2e 63 6f 6e 66 69 67 22 20 23 66 20 23 74 29 0a .config" #f #t).
1c30: 20 20 20 22 64 69 73 6b 73 22 20 27 28 22 6e 6f "disks" '("no
1c40: 6e 65 22 20 22 22 29 29 29 0a 0a 3b 3b 3d 3d 3d ne" "")))..;;===
1c50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1c60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1c70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1c80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1c90: 3d 3d 3d 0a 3b 3b 20 4d 20 49 20 53 20 43 20 20 ===.;; M I S C
1ca0: 20 4c 20 49 20 53 20 54 20 53 0a 3b 3b 3d 3d 3d L I S T S.;;===
1cb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1cc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1cd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1ce0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1cf0: 3d 3d 3d 0a 0a 3b 3b 20 69 74 65 6d 73 20 69 6e ===..;; items in
1d00: 20 6c 69 73 74 61 20 61 72 65 20 6d 61 74 63 68 lista are match
1d10: 65 64 20 76 61 6c 75 65 20 61 6e 64 20 70 6f 73 ed value and pos
1d20: 69 74 69 6f 6e 20 69 6e 20 6c 69 73 74 62 0a 3b ition in listb.;
1d30: 3b 20 72 65 74 75 72 6e 20 74 68 65 20 72 65 6d ; return the rem
1d40: 61 69 6e 69 6e 67 20 69 74 65 6d 73 20 69 6e 20 aining items in
1d50: 6c 69 73 74 62 20 6f 72 20 23 66 0a 3b 3b 0a 28 listb or #f.;;.(
1d60: 64 65 66 69 6e 65 20 28 63 6f 6d 6d 6f 6e 3a 6c define (common:l
1d70: 69 73 74 2d 69 73 2d 73 75 62 6c 69 73 74 20 6c ist-is-sublist l
1d80: 69 73 74 61 20 6c 69 73 74 62 29 0a 20 20 28 69 ista listb). (i
1d90: 66 20 28 6e 75 6c 6c 3f 20 6c 69 73 74 61 29 0a f (null? lista).
1da0: 20 20 20 20 20 20 6c 69 73 74 62 20 3b 3b 20 61 listb ;; a
1db0: 6c 6c 20 69 74 65 6d 73 20 69 6e 20 6c 69 73 74 ll items in list
1dc0: 62 20 61 72 65 20 22 72 65 6d 61 69 6e 69 6e 67 b are "remaining
1dd0: 22 0a 20 20 20 20 20 20 28 69 66 20 28 3e 20 28 ". (if (> (
1de0: 6c 65 6e 67 74 68 20 6c 69 73 74 61 29 28 6c 65 length lista)(le
1df0: 6e 67 74 68 20 6c 69 73 74 62 29 29 20 0a 09 20 ngth listb)) ..
1e00: 20 23 66 0a 09 20 20 28 6c 65 74 20 6c 6f 6f 70 #f.. (let loop
1e10: 20 28 28 68 65 64 61 20 28 63 61 72 20 6c 69 73 ((heda (car lis
1e20: 74 61 29 29 0a 09 09 20 20 20 20 20 28 74 61 6c ta))... (tal
1e30: 61 20 28 63 64 72 20 6c 69 73 74 61 29 29 0a 09 a (cdr lista))..
1e40: 09 20 20 20 20 20 28 68 65 64 62 20 28 63 61 72 . (hedb (car
1e50: 20 6c 69 73 74 62 29 29 0a 09 09 20 20 20 20 20 listb))...
1e60: 28 74 61 6c 62 20 28 63 64 72 20 6c 69 73 74 62 (talb (cdr listb
1e70: 29 29 29 0a 09 20 20 20 20 28 69 66 20 28 65 71 ))).. (if (eq
1e80: 75 61 6c 3f 20 68 65 64 61 20 68 65 64 62 29 0a ual? heda hedb).
1e90: 09 09 28 69 66 20 28 6e 75 6c 6c 3f 20 74 61 6c ..(if (null? tal
1ea0: 61 29 20 3b 3b 20 77 65 20 61 72 65 20 64 6f 6e a) ;; we are don
1eb0: 65 0a 09 09 20 20 20 20 74 61 6c 62 0a 09 09 20 e... talb...
1ec0: 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 (loop (car ta
1ed0: 6c 61 29 0a 09 09 09 20 20 28 63 64 72 20 74 61 la).... (cdr ta
1ee0: 6c 61 29 0a 09 09 09 20 20 28 63 61 72 20 74 61 la).... (car ta
1ef0: 6c 62 29 0a 09 09 09 20 20 28 63 64 72 20 74 61 lb).... (cdr ta
1f00: 6c 62 29 29 29 0a 09 09 23 66 29 29 29 29 29 0a lb)))...#f))))).
1f10: 0a 3b 3b 20 4e 65 65 64 65 64 20 66 6f 72 20 6c .;; Needed for l
1f20: 6f 6e 67 20 6c 69 73 74 73 20 74 6f 20 62 65 20 ong lists to be
1f30: 73 6f 72 74 65 64 20 77 68 65 72 65 20 28 61 70 sorted where (ap
1f40: 70 6c 79 20 6d 61 78 20 2e 2e 2e 20 29 20 64 69 ply max ... ) di
1f50: 65 73 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 63 es.;;.(define (c
1f60: 6f 6d 6d 6f 6e 3a 6d 61 78 20 69 6e 6c 73 74 29 ommon:max inlst)
1f70: 0a 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 6d . (let loop ((m
1f80: 61 78 2d 76 61 6c 20 28 63 61 72 20 69 6e 6c 73 ax-val (car inls
1f90: 74 29 29 0a 09 20 20 20 20 20 28 68 65 64 20 20 t)).. (hed
1fa0: 20 20 20 28 63 61 72 20 69 6e 6c 73 74 29 29 0a (car inlst)).
1fb0: 09 20 20 20 20 20 28 74 61 6c 20 20 20 20 20 28 . (tal (
1fc0: 63 64 72 20 69 6e 6c 73 74 29 29 29 0a 20 20 20 cdr inlst))).
1fd0: 20 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f (if (not (null?
1fe0: 20 74 61 6c 29 29 0a 09 28 6c 6f 6f 70 20 28 6d tal))..(loop (m
1ff0: 61 78 20 68 65 64 20 6d 61 78 2d 76 61 6c 29 0a ax hed max-val).
2000: 09 20 20 20 20 20 20 28 63 61 72 20 74 61 6c 29 . (car tal)
2010: 0a 09 20 20 20 20 20 20 28 63 64 72 20 74 61 6c .. (cdr tal
2020: 29 29 0a 09 28 6d 61 78 20 68 65 64 20 6d 61 78 ))..(max hed max
2030: 2d 76 61 6c 29 29 29 29 0a 0a 0a 3b 3b 3d 3d 3d -val))))...;;===
2040: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2050: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2060: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2070: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2080: 3d 3d 3d 0a 3b 3b 20 4d 75 6e 67 65 20 64 61 74 ===.;; Munge dat
2090: 61 20 69 6e 74 6f 20 6e 69 63 65 20 66 6f 72 6d a into nice form
20a0: 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d s.;;============
20b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
20c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
20d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
20e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 47 ==========..;; G
20f0: 65 6e 65 72 61 74 65 20 61 6e 20 69 6e 64 65 78 enerate an index
2100: 20 66 6f 72 20 61 20 73 70 61 72 73 65 20 6c 69 for a sparse li
2110: 73 74 20 6f 66 20 6b 65 79 20 76 61 6c 75 65 73 st of key values
2120: 0a 3b 3b 20 20 20 28 20 28 72 6f 77 6e 61 6d 65 .;; ( (rowname
2130: 31 20 63 6f 6c 6e 61 6d 65 31 20 76 61 6c 31 29 1 colname1 val1)
2140: 28 72 6f 77 6e 61 6d 65 32 20 63 6f 6c 6e 61 6d (rowname2 colnam
2150: 65 32 20 76 61 6c 32 29 20 29 0a 3b 3b 0a 3b 3b e2 val2) ).;;.;;
2160: 20 3d 3e 20 0a 3b 3b 0a 3b 3b 20 20 20 28 20 28 => .;;.;; ( (
2170: 72 6f 77 6e 61 6d 65 31 20 30 29 28 72 6f 77 6e rowname1 0)(rown
2180: 61 6d 65 32 20 31 29 29 20 20 20 20 3b 3b 20 72 ame2 1)) ;; r
2190: 6f 77 6e 61 6d 65 73 20 2d 3e 20 6e 75 6d 0a 3b ownames -> num.;
21a0: 3b 20 20 20 20 20 28 63 6f 6c 6e 61 6d 65 31 20 ; (colname1
21b0: 30 29 28 63 6f 6c 6e 61 6d 65 32 20 31 29 29 20 0)(colname2 1))
21c0: 29 20 20 3b 3b 20 63 6f 6c 6e 61 6d 65 73 20 2d ) ;; colnames -
21d0: 3e 20 6e 75 6d 0a 3b 3b 20 0a 3b 3b 20 6f 70 74 > num.;; .;; opt
21e0: 69 6f 6e 61 6c 20 61 70 70 6c 79 20 70 72 6f 63 ional apply proc
21f0: 20 74 6f 20 72 6f 77 6e 75 6d 20 63 6f 6c 6e 75 to rownum colnu
2200: 6d 20 76 61 6c 75 65 0a 28 64 65 66 69 6e 65 20 m value.(define
2210: 28 63 6f 6d 6d 6f 6e 3a 73 70 61 72 73 65 2d 6c (common:sparse-l
2220: 69 73 74 2d 67 65 6e 65 72 61 74 65 2d 69 6e 64 ist-generate-ind
2230: 65 78 20 64 61 74 61 20 23 21 6b 65 79 20 28 70 ex data #!key (p
2240: 72 6f 63 20 23 66 29 29 0a 20 20 28 69 66 20 28 roc #f)). (if (
2250: 6e 75 6c 6c 3f 20 64 61 74 61 29 0a 20 20 20 20 null? data).
2260: 20 20 28 6c 69 73 74 20 27 28 29 20 27 28 29 29 (list '() '())
2270: 0a 20 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 . (let loop
2280: 20 28 28 68 65 64 20 28 63 61 72 20 64 61 74 61 ((hed (car data
2290: 29 29 0a 09 09 20 28 74 61 6c 20 28 63 64 72 20 ))... (tal (cdr
22a0: 64 61 74 61 29 29 0a 09 09 20 28 72 6f 77 6e 61 data))... (rowna
22b0: 6d 65 73 20 27 28 29 29 0a 09 09 20 28 63 6f 6c mes '())... (col
22c0: 6e 61 6d 65 73 20 27 28 29 29 0a 09 09 20 28 72 names '())... (r
22d0: 6f 77 6e 75 6d 20 20 20 30 29 0a 09 09 20 28 63 ownum 0)... (c
22e0: 6f 6c 6e 75 6d 20 20 20 30 29 29 0a 09 28 6c 65 olnum 0))..(le
22f0: 74 2a 20 28 28 72 6f 77 6b 65 79 20 20 20 20 20 t* ((rowkey
2300: 20 20 20 20 20 28 63 61 72 20 20 20 68 65 64 29 (car hed)
2310: 29 0a 09 20 20 20 20 20 20 20 28 63 6f 6c 6b 65 ).. (colke
2320: 79 20 20 20 20 20 20 20 20 20 20 28 63 61 64 72 y (cadr
2330: 20 20 68 65 64 29 29 0a 09 20 20 20 20 20 20 20 hed))..
2340: 28 76 61 6c 75 65 20 20 20 20 20 20 20 20 20 20 (value
2350: 20 28 63 61 64 64 72 20 68 65 64 29 29 0a 09 20 (caddr hed))..
2360: 20 20 20 20 20 20 28 65 78 69 73 74 69 6e 67 2d (existing-
2370: 72 6f 77 64 61 74 20 28 61 73 73 6f 63 20 72 6f rowdat (assoc ro
2380: 77 6b 65 79 20 72 6f 77 6e 61 6d 65 73 29 29 0a wkey rownames)).
2390: 09 20 20 20 20 20 20 20 28 65 78 69 73 74 69 6e . (existin
23a0: 67 2d 63 6f 6c 64 61 74 20 28 61 73 73 6f 63 20 g-coldat (assoc
23b0: 63 6f 6c 6b 65 79 20 63 6f 6c 6e 61 6d 65 73 29 colkey colnames)
23c0: 29 0a 09 20 20 20 20 20 20 20 28 63 75 72 72 2d ).. (curr-
23d0: 72 6f 77 6e 75 6d 20 20 20 20 20 28 69 66 20 65 rownum (if e
23e0: 78 69 73 74 69 6e 67 2d 72 6f 77 64 61 74 20 72 xisting-rowdat r
23f0: 6f 77 6e 75 6d 20 28 2b 20 72 6f 77 6e 75 6d 20 ownum (+ rownum
2400: 31 29 29 29 0a 09 20 20 20 20 20 20 20 28 63 75 1))).. (cu
2410: 72 72 2d 63 6f 6c 6e 75 6d 20 20 20 20 20 28 69 rr-colnum (i
2420: 66 20 65 78 69 73 74 69 6e 67 2d 63 6f 6c 64 61 f existing-colda
2430: 74 20 63 6f 6c 6e 75 6d 20 28 2b 20 63 6f 6c 6e t colnum (+ coln
2440: 75 6d 20 31 29 29 29 0a 09 20 20 20 20 20 20 20 um 1)))..
2450: 28 6e 65 77 2d 72 6f 77 6e 61 6d 65 73 20 20 20 (new-rownames
2460: 20 28 69 66 20 65 78 69 73 74 69 6e 67 2d 72 6f (if existing-ro
2470: 77 64 61 74 20 72 6f 77 6e 61 6d 65 73 20 28 63 wdat rownames (c
2480: 6f 6e 73 20 28 6c 69 73 74 20 72 6f 77 6b 65 79 ons (list rowkey
2490: 20 63 75 72 72 2d 72 6f 77 6e 75 6d 29 20 72 6f curr-rownum) ro
24a0: 77 6e 61 6d 65 73 29 29 29 0a 09 20 20 20 20 20 wnames)))..
24b0: 20 20 28 6e 65 77 2d 63 6f 6c 6e 61 6d 65 73 20 (new-colnames
24c0: 20 20 20 28 69 66 20 65 78 69 73 74 69 6e 67 2d (if existing-
24d0: 63 6f 6c 64 61 74 20 63 6f 6c 6e 61 6d 65 73 20 coldat colnames
24e0: 28 63 6f 6e 73 20 28 6c 69 73 74 20 63 6f 6c 6b (cons (list colk
24f0: 65 79 20 63 75 72 72 2d 63 6f 6c 6e 75 6d 29 20 ey curr-colnum)
2500: 63 6f 6c 6e 61 6d 65 73 29 29 29 29 0a 09 20 20 colnames))))..
2510: 3b 3b 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d ;; (debug:print-
2520: 69 6e 66 6f 20 30 20 22 50 72 6f 63 65 73 73 69 info 0 "Processi
2530: 6e 67 20 72 65 63 6f 72 64 3a 20 22 20 68 65 64 ng record: " hed
2540: 20 29 0a 09 20 20 28 69 66 20 70 72 6f 63 20 28 ).. (if proc (
2550: 70 72 6f 63 20 63 75 72 72 2d 72 6f 77 6e 75 6d proc curr-rownum
2560: 20 63 75 72 72 2d 63 6f 6c 6e 75 6d 20 72 6f 77 curr-colnum row
2570: 6b 65 79 20 63 6f 6c 6b 65 79 20 76 61 6c 75 65 key colkey value
2580: 29 29 0a 09 20 20 28 69 66 20 28 6e 75 6c 6c 3f )).. (if (null?
2590: 20 74 61 6c 29 0a 09 20 20 20 20 20 20 28 6c 69 tal).. (li
25a0: 73 74 20 6e 65 77 2d 72 6f 77 6e 61 6d 65 73 20 st new-rownames
25b0: 6e 65 77 2d 63 6f 6c 6e 61 6d 65 73 29 0a 09 20 new-colnames)..
25c0: 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 (loop (car
25d0: 74 61 6c 29 0a 09 09 20 20 20 20 28 63 64 72 20 tal)... (cdr
25e0: 74 61 6c 29 0a 09 09 20 20 20 20 6e 65 77 2d 72 tal)... new-r
25f0: 6f 77 6e 61 6d 65 73 0a 09 09 20 20 20 20 6e 65 ownames... ne
2600: 77 2d 63 6f 6c 6e 61 6d 65 73 0a 09 09 20 20 20 w-colnames...
2610: 20 28 69 66 20 28 3e 20 63 75 72 72 2d 72 6f 77 (if (> curr-row
2620: 6e 75 6d 20 72 6f 77 6e 75 6d 29 20 63 75 72 72 num rownum) curr
2630: 2d 72 6f 77 6e 75 6d 20 72 6f 77 6e 75 6d 29 0a -rownum rownum).
2640: 09 09 20 20 20 20 28 69 66 20 28 3e 20 63 75 72 .. (if (> cur
2650: 72 2d 63 6f 6c 6e 75 6d 20 63 6f 6c 6e 75 6d 29 r-colnum colnum)
2660: 20 63 75 72 72 2d 63 6f 6c 6e 75 6d 20 63 6f 6c curr-colnum col
2670: 6e 75 6d 29 0a 09 09 20 20 20 20 29 29 29 29 29 num)... )))))
2680: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
2690: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
26a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
26b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
26c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 53 ===========.;; S
26d0: 79 73 74 65 6d 20 73 74 75 66 66 0a 3b 3b 3d 3d ystem stuff.;;==
26e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
26f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2700: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2710: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2720: 3d 3d 3d 3d 0a 0a 3b 3b 20 72 65 74 75 72 6e 20 ====..;; return
2730: 61 20 6e 69 63 65 20 63 6c 65 61 6e 20 70 61 74 a nice clean pat
2740: 68 6e 61 6d 65 20 6d 61 64 65 20 61 62 73 6f 6c hname made absol
2750: 75 74 65 0a 28 64 65 66 69 6e 65 20 28 6e 69 63 ute.(define (nic
2760: 65 2d 70 61 74 68 20 64 69 72 29 0a 20 20 28 6e e-path dir). (n
2770: 6f 72 6d 61 6c 69 7a 65 2d 70 61 74 68 6e 61 6d ormalize-pathnam
2780: 65 20 28 69 66 20 28 61 62 73 6f 6c 75 74 65 2d e (if (absolute-
2790: 70 61 74 68 6e 61 6d 65 3f 20 64 69 72 29 0a 09 pathname? dir)..
27a0: 09 09 20 20 64 69 72 0a 09 09 09 20 20 28 63 6f .. dir.... (co
27b0: 6e 63 20 28 63 75 72 72 65 6e 74 2d 64 69 72 65 nc (current-dire
27c0: 63 74 6f 72 79 29 20 22 2f 22 20 64 69 72 29 29 ctory) "/" dir))
27d0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 67 65 74 ))..(define (get
27e0: 2d 64 66 20 70 61 74 68 29 0a 20 20 28 6c 65 74 -df path). (let
27f0: 2a 20 28 28 64 66 2d 72 65 73 75 6c 74 73 20 28 * ((df-results (
2800: 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73 74 20 28 63 cmd-run->list (c
2810: 6f 6e 63 20 22 64 66 20 22 20 70 61 74 68 29 29 onc "df " path))
2820: 29 0a 09 20 28 73 70 61 63 65 2d 72 78 20 20 20 ).. (space-rx
2830: 28 72 65 67 65 78 70 20 22 28 5b 30 2d 39 5d 2b (regexp "([0-9]+
2840: 29 5c 5c 73 2b 28 5b 30 2d 39 5d 2b 29 25 22 29 )\\s+([0-9]+)%")
2850: 29 0a 09 20 28 66 72 65 65 73 70 63 20 20 20 20 ).. (freespc
2860: 23 66 29 29 0a 20 20 20 20 3b 3b 20 28 77 72 69 #f)). ;; (wri
2870: 74 65 20 64 66 2d 72 65 73 75 6c 74 73 29 0a 20 te df-results).
2880: 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 (for-each (la
2890: 6d 62 64 61 20 28 6c 29 0a 09 09 28 6c 65 74 20 mbda (l)...(let
28a0: 28 28 6d 61 74 63 68 20 28 73 74 72 69 6e 67 2d ((match (string-
28b0: 73 65 61 72 63 68 20 73 70 61 63 65 2d 72 78 20 search space-rx
28c0: 6c 29 29 29 0a 09 09 20 20 28 69 66 20 6d 61 74 l)))... (if mat
28d0: 63 68 20 0a 09 09 20 20 20 20 20 20 28 6c 65 74 ch ... (let
28e0: 20 28 28 6e 65 77 76 61 6c 20 28 73 74 72 69 6e ((newval (strin
28f0: 67 2d 3e 6e 75 6d 62 65 72 20 28 63 61 64 72 20 g->number (cadr
2900: 6d 61 74 63 68 29 29 29 29 0a 09 09 09 28 69 66 match))))....(if
2910: 20 28 6e 75 6d 62 65 72 3f 20 6e 65 77 76 61 6c (number? newval
2920: 29 0a 09 09 09 20 20 20 20 28 73 65 74 21 20 66 ).... (set! f
2930: 72 65 65 73 70 63 20 6e 65 77 76 61 6c 29 29 29 reespc newval)))
2940: 29 29 29 0a 09 20 20 20 20 20 20 28 63 61 72 20 ))).. (car
2950: 64 66 2d 72 65 73 75 6c 74 73 29 29 0a 20 20 20 df-results)).
2960: 20 66 72 65 65 73 70 63 29 29 0a 20 20 0a 28 64 freespc)). .(d
2970: 65 66 69 6e 65 20 28 67 65 74 2d 63 70 75 2d 6c efine (get-cpu-l
2980: 6f 61 64 29 0a 20 20 28 6c 65 74 2a 20 28 28 6c oad). (let* ((l
2990: 6f 61 64 2d 72 65 73 20 28 63 6d 64 2d 72 75 6e oad-res (cmd-run
29a0: 2d 3e 6c 69 73 74 20 22 75 70 74 69 6d 65 22 29 ->list "uptime")
29b0: 29 0a 09 20 28 6c 6f 61 64 2d 72 78 20 20 28 72 ).. (load-rx (r
29c0: 65 67 65 78 70 20 22 6c 6f 61 64 20 61 76 65 72 egexp "load aver
29d0: 61 67 65 3a 5c 5c 73 2b 28 5c 5c 64 2b 29 22 29 age:\\s+(\\d+)")
29e0: 29 0a 09 20 28 63 70 75 2d 6c 6f 61 64 20 23 66 ).. (cpu-load #f
29f0: 29 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 )). (for-each
2a00: 20 28 6c 61 6d 62 64 61 20 28 6c 29 0a 09 09 28 (lambda (l)...(
2a10: 6c 65 74 20 28 28 6d 61 74 63 68 20 28 73 74 72 let ((match (str
2a20: 69 6e 67 2d 73 65 61 72 63 68 20 6c 6f 61 64 2d ing-search load-
2a30: 72 78 20 6c 29 29 29 0a 09 09 20 20 28 69 66 20 rx l)))... (if
2a40: 6d 61 74 63 68 0a 09 09 20 20 20 20 20 20 28 6c match... (l
2a50: 65 74 20 28 28 6e 65 77 76 61 6c 20 28 73 74 72 et ((newval (str
2a60: 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 63 61 64 ing->number (cad
2a70: 72 20 6d 61 74 63 68 29 29 29 29 0a 09 09 09 28 r match))))....(
2a80: 69 66 20 28 6e 75 6d 62 65 72 3f 20 6e 65 77 76 if (number? newv
2a90: 61 6c 29 0a 09 09 09 20 20 20 20 28 73 65 74 21 al).... (set!
2aa0: 20 63 70 75 2d 6c 6f 61 64 20 6e 65 77 76 61 6c cpu-load newval
2ab0: 29 29 29 29 29 29 0a 09 20 20 20 20 20 20 28 63 )))))).. (c
2ac0: 61 72 20 6c 6f 61 64 2d 72 65 73 29 29 0a 20 20 ar load-res)).
2ad0: 20 20 63 70 75 2d 6c 6f 61 64 29 29 0a 0a 28 64 cpu-load))..(d
2ae0: 65 66 69 6e 65 20 28 67 65 74 2d 75 6e 61 6d 65 efine (get-uname
2af0: 20 2e 20 70 61 72 61 6d 73 29 0a 20 20 28 6c 65 . params). (le
2b00: 74 2a 20 28 28 75 6e 61 6d 65 2d 72 65 73 20 28 t* ((uname-res (
2b10: 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73 74 20 28 63 cmd-run->list (c
2b20: 6f 6e 63 20 22 75 6e 61 6d 65 20 22 20 28 69 66 onc "uname " (if
2b30: 20 28 6e 75 6c 6c 3f 20 70 61 72 61 6d 73 29 20 (null? params)
2b40: 22 2d 61 22 20 28 63 61 72 20 70 61 72 61 6d 73 "-a" (car params
2b50: 29 29 29 29 29 0a 09 20 28 75 6e 61 6d 65 20 23 ))))).. (uname #
2b60: 66 29 29 0a 20 20 20 20 28 69 66 20 28 6e 75 6c f)). (if (nul
2b70: 6c 3f 20 28 63 61 72 20 75 6e 61 6d 65 2d 72 65 l? (car uname-re
2b80: 73 29 29 0a 09 22 75 6e 6b 6e 6f 77 6e 22 0a 09 s)).."unknown"..
2b90: 28 63 61 61 72 20 75 6e 61 6d 65 2d 72 65 73 29 (caar uname-res)
2ba0: 29 29 29 0a 09 20 20 20 20 20 20 0a 28 64 65 66 ))).. .(def
2bb0: 69 6e 65 20 28 73 61 76 65 2d 65 6e 76 69 72 6f ine (save-enviro
2bc0: 6e 6d 65 6e 74 2d 61 73 2d 66 69 6c 65 73 20 66 nment-as-files f
2bd0: 6e 61 6d 65 20 23 21 6b 65 79 20 28 69 67 6e 6f name #!key (igno
2be0: 72 65 76 61 72 73 20 28 6c 69 73 74 20 22 44 49 revars (list "DI
2bf0: 53 50 4c 41 59 22 20 22 4c 53 5f 43 4f 4c 4f 52 SPLAY" "LS_COLOR
2c00: 53 22 20 22 58 4b 45 59 53 59 4d 44 42 22 20 22 S" "XKEYSYMDB" "
2c10: 45 44 49 54 4f 52 22 29 29 29 0a 20 20 28 6c 65 EDITOR"))). (le
2c20: 74 20 28 28 65 6e 76 76 61 72 73 20 28 67 65 74 t ((envvars (get
2c30: 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 -environment-var
2c40: 69 61 62 6c 65 73 29 29 0a 20 20 20 20 20 20 20 iables)).
2c50: 20 28 77 68 69 74 65 73 70 20 28 72 65 67 65 78 (whitesp (regex
2c60: 70 20 22 5b 5e 61 2d 7a 41 2d 5a 30 2d 39 5f 5c p "[^a-zA-Z0-9_\
2c70: 5c 2d 3a 3b 2c 2e 5c 5c 2f 25 24 5d 22 29 29 29 \-:;,.\\/%$]")))
2c80: 0a 20 20 20 20 20 28 77 69 74 68 2d 6f 75 74 70 . (with-outp
2c90: 75 74 2d 74 6f 2d 66 69 6c 65 20 28 63 6f 6e 63 ut-to-file (conc
2ca0: 20 66 6e 61 6d 65 20 22 2e 63 73 68 22 29 0a 20 fname ".csh").
2cb0: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 (lambda ()
2cc0: 0a 20 20 20 20 20 20 20 20 20 20 28 66 6f 72 2d . (for-
2cd0: 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 6b 65 each (lambda (ke
2ce0: 79 29 0a 09 09 20 20 20 20 20 20 28 69 66 20 28 y)... (if (
2cf0: 6e 6f 74 20 28 6d 65 6d 62 65 72 20 6b 65 79 20 not (member key
2d00: 69 67 6e 6f 72 65 76 61 72 73 29 29 0a 09 09 09 ignorevars))....
2d10: 20 20 28 6c 65 74 2a 20 28 28 76 61 6c 20 28 63 (let* ((val (c
2d20: 64 72 20 6b 65 79 29 29 0a 09 09 09 09 20 28 73 dr key))..... (s
2d30: 76 61 6c 20 28 69 66 20 28 73 74 72 69 6e 67 2d val (if (string-
2d40: 73 65 61 72 63 68 20 77 68 69 74 65 73 70 20 76 search whitesp v
2d50: 61 6c 29 28 63 6f 6e 63 20 22 5c 22 22 20 76 61 al)(conc "\"" va
2d60: 6c 20 22 5c 22 22 29 20 76 61 6c 29 29 29 0a 09 l "\"") val)))..
2d70: 09 09 20 20 20 20 28 70 72 69 6e 74 20 22 73 65 .. (print "se
2d80: 74 65 6e 76 20 22 20 28 63 61 72 20 6b 65 79 29 tenv " (car key)
2d90: 20 22 20 22 20 73 76 61 6c 29 29 29 29 0a 09 09 " " sval))))...
2da0: 20 20 20 20 20 20 65 6e 76 76 61 72 73 29 29 29 envvars)))
2db0: 0a 20 20 20 20 20 28 77 69 74 68 2d 6f 75 74 70 . (with-outp
2dc0: 75 74 2d 74 6f 2d 66 69 6c 65 20 28 63 6f 6e 63 ut-to-file (conc
2dd0: 20 66 6e 61 6d 65 20 22 2e 73 68 22 29 0a 20 20 fname ".sh").
2de0: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 0a (lambda ().
2df0: 20 20 20 20 20 20 20 20 20 20 28 66 6f 72 2d 65 (for-e
2e00: 61 63 68 20 28 6c 61 6d 62 64 61 20 28 6b 65 79 ach (lambda (key
2e10: 29 0a 09 09 20 20 20 20 20 20 28 69 66 20 28 6e )... (if (n
2e20: 6f 74 20 28 6d 65 6d 62 65 72 20 6b 65 79 20 69 ot (member key i
2e30: 67 6e 6f 72 65 76 61 72 73 29 29 0a 09 09 09 20 gnorevars))....
2e40: 20 28 6c 65 74 2a 20 28 28 76 61 6c 20 28 63 64 (let* ((val (cd
2e50: 72 20 6b 65 79 29 29 0a 09 09 09 09 20 28 73 76 r key))..... (sv
2e60: 61 6c 20 28 69 66 20 28 73 74 72 69 6e 67 2d 73 al (if (string-s
2e70: 65 61 72 63 68 20 77 68 69 74 65 73 70 20 76 61 earch whitesp va
2e80: 6c 29 28 63 6f 6e 63 20 22 5c 22 22 20 76 61 6c l)(conc "\"" val
2e90: 20 22 5c 22 22 29 20 76 61 6c 29 29 29 0a 09 09 "\"") val)))...
2ea0: 09 20 20 20 20 28 70 72 69 6e 74 20 22 65 78 70 . (print "exp
2eb0: 6f 72 74 20 22 20 28 63 61 72 20 6b 65 79 29 20 ort " (car key)
2ec0: 22 3d 22 20 73 76 61 6c 29 29 29 29 0a 20 20 20 "=" sval)))).
2ed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2ee0: 20 65 6e 76 76 61 72 73 29 29 29 29 29 0a 0a 3b envvars)))))..;
2ef0: 3b 20 73 65 74 20 73 6f 6d 65 20 65 6e 76 20 76 ; set some env v
2f00: 61 72 73 20 66 72 6f 6d 20 61 6e 20 61 6c 69 73 ars from an alis
2f10: 74 2c 20 72 65 74 75 72 6e 20 61 6e 20 61 6c 69 t, return an ali
2f20: 73 74 20 77 69 74 68 20 6f 72 69 67 69 6e 61 6c st with original
2f30: 20 76 61 6c 75 65 73 0a 3b 3b 20 28 28 22 56 41 values.;; (("VA
2f40: 52 22 20 22 76 61 6c 75 65 22 29 20 2e 2e 2e 29 R" "value") ...)
2f50: 0a 28 64 65 66 69 6e 65 20 28 61 6c 69 73 74 2d .(define (alist-
2f60: 3e 65 6e 76 2d 76 61 72 73 20 6c 73 74 29 0a 20 >env-vars lst).
2f70: 20 28 69 66 20 28 6c 69 73 74 3f 20 6c 73 74 29 (if (list? lst)
2f80: 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 72 65 . (let ((re
2f90: 73 20 27 28 29 29 29 0a 09 28 66 6f 72 2d 65 61 s '()))..(for-ea
2fa0: 63 68 20 28 6c 61 6d 62 64 61 20 28 70 29 0a 09 ch (lambda (p)..
2fb0: 09 20 20 20 20 28 6c 65 74 2a 20 28 28 76 61 72 . (let* ((var
2fc0: 20 28 63 61 72 20 20 70 29 29 0a 09 09 09 20 20 (car p))....
2fd0: 20 28 76 61 6c 20 28 63 61 64 72 20 70 29 29 0a (val (cadr p)).
2fe0: 09 09 09 20 20 20 28 70 72 76 20 28 67 65 74 2d ... (prv (get-
2ff0: 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 environment-vari
3000: 61 62 6c 65 20 76 61 72 29 29 29 0a 09 09 20 20 able var)))...
3010: 20 20 20 20 28 73 65 74 21 20 72 65 73 20 28 63 (set! res (c
3020: 6f 6e 73 20 28 6c 69 73 74 20 76 61 72 20 70 72 ons (list var pr
3030: 76 29 20 72 65 73 29 29 0a 09 09 20 20 20 20 20 v) res))...
3040: 20 28 69 66 20 76 61 6c 20 0a 09 09 09 20 20 28 (if val .... (
3050: 73 65 74 65 6e 76 20 76 61 72 20 28 2d 3e 73 74 setenv var (->st
3060: 72 69 6e 67 20 76 61 6c 29 29 0a 09 09 09 20 20 ring val))....
3070: 28 75 6e 73 65 74 65 6e 76 20 76 61 72 29 29 29 (unsetenv var)))
3080: 29 0a 09 09 20 20 6c 73 74 29 0a 09 72 65 73 29 )... lst)..res)
3090: 0a 20 20 20 20 20 20 27 28 29 29 29 0a 09 09 20 . '()))...
30a0: 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;============
30b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
30c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
30d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
30e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 74 69 ==========.;; ti
30f0: 6d 65 20 61 6e 64 20 64 61 74 65 20 6e 69 63 65 me and date nice
3100: 20 74 6f 20 68 61 76 65 20 73 74 75 66 66 0a 3b to have stuff.;
3110: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
3120: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3130: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3140: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3150: 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 =======..(define
3160: 20 28 73 65 63 6f 6e 64 73 2d 3e 68 72 2d 6d 69 (seconds->hr-mi
3170: 6e 2d 73 65 63 20 73 65 63 73 29 0a 20 20 28 6c n-sec secs). (l
3180: 65 74 2a 20 28 28 68 72 73 20 28 71 75 6f 74 69 et* ((hrs (quoti
3190: 65 6e 74 20 73 65 63 73 20 33 36 30 30 29 29 0a ent secs 3600)).
31a0: 09 20 28 6d 69 6e 20 28 71 75 6f 74 69 65 6e 74 . (min (quotient
31b0: 20 28 2d 20 73 65 63 73 20 28 2a 20 68 72 73 20 (- secs (* hrs
31c0: 33 36 30 30 29 29 20 36 30 29 29 0a 09 20 28 73 3600)) 60)).. (s
31d0: 65 63 20 28 2d 20 73 65 63 73 20 28 2a 20 68 72 ec (- secs (* hr
31e0: 73 20 33 36 30 30 29 28 2a 20 6d 69 6e 20 36 30 s 3600)(* min 60
31f0: 29 29 29 29 0a 20 20 20 20 28 63 6f 6e 63 20 28 )))). (conc (
3200: 69 66 20 28 3e 20 68 72 73 20 30 29 28 63 6f 6e if (> hrs 0)(con
3210: 63 20 68 72 73 20 22 68 72 20 22 29 20 22 22 29 c hrs "hr ") "")
3220: 0a 09 20 20 28 69 66 20 28 3e 20 6d 69 6e 20 30 .. (if (> min 0
3230: 29 28 63 6f 6e 63 20 6d 69 6e 20 22 6d 20 22 29 )(conc min "m ")
3240: 20 20 22 22 29 0a 09 20 20 73 65 63 20 22 73 22 "").. sec "s"
3250: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 73 65 )))..(define (se
3260: 63 6f 6e 64 73 2d 3e 74 69 6d 65 2d 73 74 72 69 conds->time-stri
3270: 6e 67 20 73 65 63 29 0a 20 20 28 74 69 6d 65 2d ng sec). (time-
3280: 3e 73 74 72 69 6e 67 20 0a 20 20 20 28 73 65 63 >string . (sec
3290: 6f 6e 64 73 2d 3e 6c 6f 63 61 6c 2d 74 69 6d 65 onds->local-time
32a0: 20 73 65 63 29 20 22 25 48 3a 25 4d 3a 25 53 22 sec) "%H:%M:%S"
32b0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 73 65 63 ))..(define (sec
32c0: 6f 6e 64 73 2d 3e 77 6f 72 6b 2d 77 65 65 6b 2f onds->work-week/
32d0: 64 61 79 2d 74 69 6d 65 20 73 65 63 29 0a 20 20 day-time sec).
32e0: 28 74 69 6d 65 2d 3e 73 74 72 69 6e 67 0a 20 20 (time->string.
32f0: 20 28 73 65 63 6f 6e 64 73 2d 3e 6c 6f 63 61 6c (seconds->local
3300: 2d 74 69 6d 65 20 73 65 63 29 20 22 77 77 25 56 -time sec) "ww%V
3310: 2e 25 75 20 25 48 3a 25 4d 22 29 29 0a 0a 28 64 .%u %H:%M"))..(d
3320: 65 66 69 6e 65 20 28 73 65 63 6f 6e 64 73 2d 3e efine (seconds->
3330: 77 6f 72 6b 2d 77 65 65 6b 2f 64 61 79 20 73 65 work-week/day se
3340: 63 29 0a 20 20 28 74 69 6d 65 2d 3e 73 74 72 69 c). (time->stri
3350: 6e 67 0a 20 20 20 28 73 65 63 6f 6e 64 73 2d 3e ng. (seconds->
3360: 6c 6f 63 61 6c 2d 74 69 6d 65 20 73 65 63 29 20 local-time sec)
3370: 22 77 77 25 56 2e 25 75 22 29 29 0a 0a 28 64 65 "ww%V.%u"))..(de
3380: 66 69 6e 65 20 28 73 65 63 6f 6e 64 73 2d 3e 79 fine (seconds->y
3390: 65 61 72 2d 77 6f 72 6b 2d 77 65 65 6b 2f 64 61 ear-work-week/da
33a0: 79 20 73 65 63 29 0a 20 20 28 74 69 6d 65 2d 3e y sec). (time->
33b0: 73 74 72 69 6e 67 0a 20 20 20 28 73 65 63 6f 6e string. (secon
33c0: 64 73 2d 3e 6c 6f 63 61 6c 2d 74 69 6d 65 20 73 ds->local-time s
33d0: 65 63 29 20 22 25 79 77 77 25 56 2e 25 77 22 29 ec) "%yww%V.%w")
33e0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 73 65 63 6f )..(define (seco
33f0: 6e 64 73 2d 3e 79 65 61 72 2d 77 6f 72 6b 2d 77 nds->year-work-w
3400: 65 65 6b 2f 64 61 79 2d 74 69 6d 65 20 73 65 63 eek/day-time sec
3410: 29 0a 20 20 28 74 69 6d 65 2d 3e 73 74 72 69 6e ). (time->strin
3420: 67 0a 20 20 20 28 73 65 63 6f 6e 64 73 2d 3e 6c g. (seconds->l
3430: 6f 63 61 6c 2d 74 69 6d 65 20 73 65 63 29 20 22 ocal-time sec) "
3440: 25 79 77 77 25 56 2e 25 77 20 25 48 3a 25 4d 22 %yww%V.%w %H:%M"
3450: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
3460: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3470: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3480: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3490: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
34a0: 43 6f 6c 6f 72 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d Colors.;;=======
34b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
34c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
34d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
34e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
34f0: 20 20 20 20 20 20 0a 28 64 65 66 69 6e 65 20 28 .(define (
3500: 63 6f 6d 6d 6f 6e 3a 6e 61 6d 65 2d 3e 69 75 70 common:name->iup
3510: 2d 63 6f 6c 6f 72 20 6e 61 6d 65 29 0a 20 20 28 -color name). (
3520: 63 61 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 case (string->sy
3530: 6d 62 6f 6c 20 28 73 74 72 69 6e 67 2d 64 6f 77 mbol (string-dow
3540: 6e 63 61 73 65 20 6e 61 6d 65 29 29 0a 20 20 20 ncase name)).
3550: 20 28 28 72 65 64 29 20 20 20 20 22 32 32 33 20 ((red) "223
3560: 33 33 20 34 39 22 29 0a 20 20 20 20 28 28 67 72 33 49"). ((gr
3570: 65 79 29 20 20 20 22 31 39 32 20 31 39 32 20 31 ey) "192 192 1
3580: 39 32 22 29 0a 20 20 20 20 28 28 6f 72 61 6e 67 92"). ((orang
3590: 65 29 20 22 32 35 35 20 31 37 32 20 31 33 22 29 e) "255 172 13")
35a0: 0a 20 20 20 20 28 28 70 75 72 70 6c 65 29 20 22 . ((purple) "
35b0: 54 68 69 73 20 69 73 20 75 6e 66 69 6e 69 73 68 This is unfinish
35c0: 65 64 20 2e 2e 2e 22 29 29 29 0a 0a 3b 3b 20 28 ed ...")))..;; (
35d0: 64 65 66 69 6e 65 20 28 63 6f 6d 6d 6f 6e 3a 67 define (common:g
35e0: 65 74 2d 63 6f 6c 6f 72 2d 66 6f 72 2d 73 74 61 et-color-for-sta
35f0: 74 65 2d 73 74 61 74 75 73 20 73 74 61 74 65 20 te-status state
3600: 73 74 61 74 75 73 29 0a 3b 3b 20 20 20 28 63 61 status).;; (ca
3610: 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 se (string->symb
3620: 6f 6c 20 73 74 61 74 65 29 0a 3b 3b 20 20 20 20 ol state).;;
3630: 20 28 28 43 4f 4d 50 4c 45 54 45 44 29 0a 3b 3b ((COMPLETED).;;
3640: 20 20 20 20 20 20 28 63 61 73 65 20 28 73 74 72 (case (str
3650: 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 73 74 61 74 ing->symbol stat
3660: 75 73 29 0a 3b 3b 20 20 20 20 20 20 20 20 28 28 us).;; ((
3670: 50 41 53 53 29 20 20 20 20 20 20 20 20 22 37 30 PASS) "70
3680: 20 20 32 34 39 20 37 33 22 29 0a 3b 3b 20 20 20 249 73").;;
3690: 20 20 20 20 20 28 28 57 41 52 4e 20 57 41 49 56 ((WARN WAIV
36a0: 45 44 29 20 22 32 35 35 20 31 37 32 20 31 33 22 ED) "255 172 13"
36b0: 29 0a 3b 3b 20 20 20 20 20 20 20 20 28 28 53 4b ).;; ((SK
36c0: 49 50 29 20 20 20 20 20 20 20 20 22 32 33 30 20 IP) "230
36d0: 32 33 30 20 30 22 29 0a 3b 3b 20 20 20 20 20 20 230 0").;;
36e0: 20 20 28 65 6c 73 65 20 22 32 32 33 20 33 33 20 (else "223 33
36f0: 34 39 22 29 29 29 0a 3b 3b 20 20 20 20 20 28 28 49"))).;; ((
3700: 4c 41 55 4e 43 48 45 44 29 20 20 20 20 20 20 20 LAUNCHED)
3710: 20 20 22 31 30 31 20 31 32 33 20 31 34 32 22 29 "101 123 142")
3720: 0a 3b 3b 20 20 20 20 20 28 28 43 48 45 43 4b 29 .;; ((CHECK)
3730: 20 20 20 20 20 20 20 20 20 20 20 20 22 32 35 35 "255
3740: 20 31 30 30 20 35 30 22 29 0a 3b 3b 20 20 20 20 100 50").;;
3750: 20 28 28 52 45 4d 4f 54 45 48 4f 53 54 53 54 41 ((REMOTEHOSTSTA
3760: 52 54 29 20 20 22 35 30 20 20 31 33 30 20 31 39 RT) "50 130 19
3770: 35 22 29 0a 3b 3b 20 20 20 20 20 28 28 52 55 4e 5").;; ((RUN
3780: 4e 49 4e 47 29 20 20 20 20 20 20 20 20 20 20 22 NING) "
3790: 39 20 20 20 31 33 31 20 32 33 32 22 29 0a 3b 3b 9 131 232").;;
37a0: 20 20 20 20 20 28 28 4b 49 4c 4c 52 45 51 29 20 ((KILLREQ)
37b0: 20 20 20 20 20 20 20 20 20 22 33 39 20 20 38 32 "39 82
37c0: 20 20 32 30 36 22 29 0a 3b 3b 20 20 20 20 20 28 206").;; (
37d0: 28 4b 49 4c 4c 45 44 29 20 20 20 20 20 20 20 20 (KILLED)
37e0: 20 20 20 22 32 33 34 20 31 30 31 20 31 37 22 29 "234 101 17")
37f0: 0a 3b 3b 20 20 20 20 20 28 28 4e 4f 54 5f 53 54 .;; ((NOT_ST
3800: 41 52 54 45 44 29 20 20 20 20 20 20 22 32 34 30 ARTED) "240
3810: 20 32 34 30 20 32 34 30 22 29 0a 3b 3b 20 20 20 240 240").;;
3820: 20 20 28 65 6c 73 65 20 20 20 20 20 20 20 20 20 (else
3830: 20 20 20 20 20 20 22 31 39 32 20 31 39 32 20 31 "192 192 1
3840: 39 32 22 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 92")))..(define
3850: 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 63 6f 6c 6f (common:get-colo
3860: 72 2d 66 72 6f 6d 2d 73 74 61 74 75 73 20 73 74 r-from-status st
3870: 61 74 75 73 29 0a 20 20 28 63 6f 6e 64 0a 20 20 atus). (cond.
3880: 20 28 28 65 71 75 61 6c 3f 20 73 74 61 74 75 73 ((equal? status
3890: 20 22 50 41 53 53 22 29 20 20 20 20 22 67 72 65 "PASS") "gre
38a0: 65 6e 22 29 0a 20 20 20 28 28 65 71 75 61 6c 3f en"). ((equal?
38b0: 20 73 74 61 74 75 73 20 22 46 41 49 4c 22 29 20 status "FAIL")
38c0: 20 20 20 22 72 65 64 22 29 0a 20 20 20 28 28 65 "red"). ((e
38d0: 71 75 61 6c 3f 20 73 74 61 74 75 73 20 22 57 41 qual? status "WA
38e0: 52 4e 22 29 20 20 20 20 22 6f 72 61 6e 67 65 22 RN") "orange"
38f0: 29 0a 20 20 20 28 28 65 71 75 61 6c 3f 20 73 74 ). ((equal? st
3900: 61 74 75 73 20 22 4b 49 4c 4c 45 44 22 29 20 20 atus "KILLED")
3910: 22 6f 72 61 6e 67 65 22 29 0a 20 20 20 28 28 65 "orange"). ((e
3920: 71 75 61 6c 3f 20 73 74 61 74 75 73 20 22 4b 49 qual? status "KI
3930: 4c 4c 52 45 51 22 29 20 22 70 75 72 70 6c 65 22 LLREQ") "purple"
3940: 29 0a 20 20 20 28 28 65 71 75 61 6c 3f 20 73 74 ). ((equal? st
3950: 61 74 75 73 20 22 52 55 4e 4e 49 4e 47 22 29 20 atus "RUNNING")
3960: 22 62 6c 75 65 22 29 0a 20 20 20 28 65 6c 73 65 "blue"). (else
3970: 20 22 62 6c 61 63 6b 22 29 29 29 0a "black"))).