0000: 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 32 30 30 ;; Copyright 200
0010: 36 2d 32 30 31 32 2c 20 4d 61 74 74 68 65 77 20 6-2012, Matthew
0020: 57 65 6c 6c 61 6e 64 2e 0a 3b 3b 20 0a 3b 3b 20 Welland..;; .;;
0030: 20 54 68 69 73 20 70 72 6f 67 72 61 6d 20 69 73 This program is
0040: 20 6d 61 64 65 20 61 76 61 69 6c 61 62 6c 65 20 made available
0050: 75 6e 64 65 72 20 74 68 65 20 47 4e 55 20 47 50 under the GNU GP
0060: 4c 20 76 65 72 73 69 6f 6e 20 32 2e 30 20 6f 72 L version 2.0 or
0070: 0a 3b 3b 20 20 67 72 65 61 74 65 72 2e 20 53 65 .;; greater. Se
0080: 65 20 74 68 65 20 61 63 63 6f 6d 70 61 6e 79 69 e the accompanyi
0090: 6e 67 20 66 69 6c 65 20 43 4f 50 59 49 4e 47 20 ng file COPYING
00a0: 66 6f 72 20 64 65 74 61 69 6c 73 2e 0a 3b 3b 20 for details..;;
00b0: 0a 3b 3b 20 20 54 68 69 73 20 70 72 6f 67 72 61 .;; This progra
00c0: 6d 20 69 73 20 64 69 73 74 72 69 62 75 74 65 64 m is distributed
00d0: 20 57 49 54 48 4f 55 54 20 41 4e 59 20 57 41 52 WITHOUT ANY WAR
00e0: 52 41 4e 54 59 3b 20 77 69 74 68 6f 75 74 20 65 RANTY; without e
00f0: 76 65 6e 20 74 68 65 0a 3b 3b 20 20 69 6d 70 6c ven the.;; impl
0100: 69 65 64 20 77 61 72 72 61 6e 74 79 20 6f 66 20 ied warranty of
0110: 4d 45 52 43 48 41 4e 54 41 42 49 4c 49 54 59 20 MERCHANTABILITY
0120: 6f 72 20 46 49 54 4e 45 53 53 20 46 4f 52 20 41 or FITNESS FOR A
0130: 20 50 41 52 54 49 43 55 4c 41 52 0a 3b 3b 20 20 PARTICULAR.;;
0140: 50 55 52 50 4f 53 45 2e 0a 0a 3b 3b 20 28 69 6e PURPOSE...;; (in
0150: 63 6c 75 64 65 20 22 63 6f 6d 6d 6f 6e 2e 73 63 clude "common.sc
0160: 6d 22 29 0a 3b 3b 20 28 69 6e 63 6c 75 64 65 20 m").;; (include
0170: 22 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f "megatest-versio
0180: 6e 2e 73 63 6d 22 29 0a 0a 28 75 73 65 20 73 71 n.scm")..(use sq
0190: 6c 69 74 65 33 20 73 72 66 69 2d 31 20 70 6f 73 lite3 srfi-1 pos
01a0: 69 78 20 72 65 67 65 78 20 72 65 67 65 78 2d 63 ix regex regex-c
01b0: 61 73 65 20 73 72 66 69 2d 36 39 20 62 61 73 65 ase srfi-69 base
01c0: 36 34 20 66 6f 72 6d 61 74 20 72 65 61 64 6c 69 64 format readli
01d0: 6e 65 20 61 70 72 6f 70 6f 73 20 6a 73 6f 6e 29 ne apropos json)
01e0: 20 3b 3b 20 28 73 72 66 69 20 31 38 29 20 65 78 ;; (srfi 18) ex
01f0: 74 72 61 73 29 0a 28 69 6d 70 6f 72 74 20 28 70 tras).(import (p
0200: 72 65 66 69 78 20 73 71 6c 69 74 65 33 20 73 71 refix sqlite3 sq
0210: 6c 69 74 65 33 3a 29 29 0a 28 69 6d 70 6f 72 74 lite3:)).(import
0220: 20 28 70 72 65 66 69 78 20 62 61 73 65 36 34 20 (prefix base64
0230: 62 61 73 65 36 34 3a 29 29 0a 0a 3b 3b 20 28 75 base64:))..;; (u
0240: 73 65 20 7a 6d 71 29 0a 0a 28 64 65 63 6c 61 72 se zmq)..(declar
0250: 65 20 28 75 73 65 73 20 63 6f 6d 6d 6f 6e 29 29 e (uses common))
0260: 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 .(declare (uses
0270: 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e megatest-version
0280: 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 )).(declare (use
0290: 73 20 6d 61 72 67 73 29 29 0a 28 64 65 63 6c 61 s margs)).(decla
02a0: 72 65 20 28 75 73 65 73 20 72 75 6e 73 29 29 0a re (uses runs)).
02b0: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 6c (declare (uses l
02c0: 61 75 6e 63 68 29 29 0a 28 64 65 63 6c 61 72 65 aunch)).(declare
02d0: 20 28 75 73 65 73 20 73 65 72 76 65 72 29 29 0a (uses server)).
02e0: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 63 (declare (uses c
02f0: 6c 69 65 6e 74 29 29 0a 28 64 65 63 6c 61 72 65 lient)).(declare
0300: 20 28 75 73 65 73 20 74 65 73 74 73 29 29 0a 28 (uses tests)).(
0310: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 67 65 declare (uses ge
0320: 6e 65 78 61 6d 70 6c 65 29 29 0a 28 64 65 63 6c nexample)).(decl
0330: 61 72 65 20 28 75 73 65 73 20 64 61 65 6d 6f 6e are (uses daemon
0340: 29 29 0a 0a 28 64 65 66 69 6e 65 20 2a 64 62 2a ))..(define *db*
0350: 20 23 66 29 20 3b 3b 20 74 68 69 73 20 69 73 20 #f) ;; this is
0360: 6f 6e 6c 79 20 66 6f 72 20 74 68 65 20 72 65 70 only for the rep
0370: 6c 2c 20 64 6f 20 6e 6f 74 20 75 73 65 20 69 6e l, do not use in
0380: 20 67 65 6e 65 72 61 6c 21 21 21 21 0a 0a 28 69 general!!!!..(i
0390: 6e 63 6c 75 64 65 20 22 63 6f 6d 6d 6f 6e 5f 72 nclude "common_r
03a0: 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 28 69 6e ecords.scm").(in
03b0: 63 6c 75 64 65 20 22 6b 65 79 5f 72 65 63 6f 72 clude "key_recor
03c0: 64 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 ds.scm").(includ
03d0: 65 20 22 64 62 5f 72 65 63 6f 72 64 73 2e 73 63 e "db_records.sc
03e0: 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 6d 65 m").(include "me
03f0: 67 61 74 65 73 74 2d 66 6f 73 73 69 6c 2d 68 61 gatest-fossil-ha
0400: 73 68 2e 73 63 6d 22 29 0a 0a 3b 3b 20 28 75 73 sh.scm")..;; (us
0410: 65 20 74 72 61 63 65 20 64 6f 74 2d 6c 6f 63 6b e trace dot-lock
0420: 69 6e 67 29 0a 3b 3b 20 28 74 72 61 63 65 0a 3b ing).;; (trace.;
0430: 3b 20 20 64 62 3a 74 65 73 74 73 74 65 70 2d 73 ; db:teststep-s
0440: 65 74 2d 73 74 61 74 75 73 21 0a 3b 3b 20 20 64 et-status!.;; d
0450: 62 3a 6f 70 65 6e 2d 74 65 73 74 2d 64 62 2d 62 b:open-test-db-b
0460: 79 2d 74 65 73 74 2d 69 64 0a 3b 3b 20 20 64 62 y-test-id.;; db
0470: 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 64 69 72 :test-get-rundir
0480: 2d 66 72 6f 6d 2d 74 65 73 74 2d 69 64 0a 3b 3b -from-test-id.;;
0490: 20 20 63 64 62 3a 74 65 73 74 73 2d 72 65 67 69 cdb:tests-regi
04a0: 73 74 65 72 2d 74 65 73 74 0a 3b 3b 20 20 63 64 ster-test.;; cd
04b0: 62 3a 74 65 73 74 73 2d 75 70 64 61 74 65 2d 75 b:tests-update-u
04c0: 6e 61 6d 65 2d 68 6f 73 74 0a 3b 3b 20 20 63 64 name-host.;; cd
04d0: 62 3a 74 65 73 74 73 2d 75 70 64 61 74 65 2d 72 b:tests-update-r
04e0: 75 6e 2d 64 75 72 61 74 69 6f 6e 0a 3b 3b 20 20 un-duration.;;
04f0: 3b 3b 20 20 63 64 62 3a 63 6c 69 65 6e 74 2d 63 ;; cdb:client-c
0500: 61 6c 6c 0a 3b 3b 20 20 3b 3b 20 63 64 62 3a 72 all.;; ;; cdb:r
0510: 65 6d 6f 74 65 2d 72 75 6e 0a 3b 3b 20 29 0a 3b emote-run.;; ).;
0520: 3b 20 20 63 64 62 3a 74 65 73 74 2d 73 65 74 2d ; cdb:test-set-
0530: 73 74 61 74 75 73 2d 73 74 61 74 65 0a 3b 3b 20 status-state.;;
0540: 20 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 change-director
0550: 79 0a 3b 3b 20 20 64 62 3a 70 72 6f 63 65 73 73 y.;; db:process
0560: 2d 71 75 65 75 65 2d 69 74 65 6d 0a 3b 3b 20 20 -queue-item.;;
0570: 64 62 3a 74 65 73 74 2d 67 65 74 2d 6c 6f 67 66 db:test-get-logf
0580: 69 6c 65 2d 69 6e 66 6f 0a 3b 3b 20 20 64 62 3a ile-info.;; db:
0590: 74 65 73 74 73 74 65 70 2d 73 65 74 2d 73 74 61 teststep-set-sta
05a0: 74 75 73 21 0a 3b 3b 20 20 6e 69 63 65 2d 70 61 tus!.;; nice-pa
05b0: 74 68 0a 3b 3b 20 20 6f 62 74 61 69 6e 2d 64 6f th.;; obtain-do
05c0: 74 2d 6c 6f 63 6b 0a 3b 3b 20 20 6f 70 65 6e 2d t-lock.;; open-
05d0: 72 75 6e 2d 63 6c 6f 73 65 0a 3b 3b 20 20 72 65 run-close.;; re
05e0: 61 64 2d 63 6f 6e 66 69 67 0a 3b 3b 20 20 72 75 ad-config.;; ru
05f0: 6e 73 3a 63 61 6e 2d 72 75 6e 2d 6d 6f 72 65 2d ns:can-run-more-
0600: 74 65 73 74 73 0a 3b 3b 20 20 73 71 6c 69 74 65 tests.;; sqlite
0610: 33 3a 65 78 65 63 75 74 65 0a 3b 3b 20 20 73 71 3:execute.;; sq
0620: 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 lite3:for-each-r
0630: 6f 77 0a 3b 3b 20 20 74 65 73 74 73 3a 63 68 65 ow.;; tests:che
0640: 63 6b 2d 77 61 69 76 65 72 2d 65 6c 69 67 69 62 ck-waiver-eligib
0650: 69 6c 69 74 79 0a 3b 3b 20 20 74 65 73 74 73 3a ility.;; tests:
0660: 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 0a summarize-items.
0670: 3b 3b 20 20 74 65 73 74 73 3a 74 65 73 74 2d 73 ;; tests:test-s
0680: 65 74 2d 73 74 61 74 75 73 21 0a 3b 3b 20 20 74 et-status!.;; t
0690: 68 72 65 61 64 2d 73 6c 65 65 70 21 0a 3b 3b 29 hread-sleep!.;;)
06a0: 0a 20 20 20 20 20 20 20 0a 0a 28 64 65 66 69 6e . ..(defin
06b0: 65 20 68 65 6c 70 20 28 63 6f 6e 63 20 22 0a 4d e help (conc ".M
06c0: 65 67 61 74 65 73 74 2c 20 64 6f 63 75 6d 65 6e egatest, documen
06d0: 74 61 74 69 6f 6e 20 61 74 20 68 74 74 70 3a 2f tation at http:/
06e0: 2f 77 77 77 2e 6b 69 61 74 6f 61 2e 63 6f 6d 2f /www.kiatoa.com/
06f0: 66 6f 73 73 69 6c 73 2f 6d 65 67 61 74 65 73 74 fossils/megatest
0700: 0a 20 20 76 65 72 73 69 6f 6e 20 22 20 6d 65 67 . version " meg
0710: 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 20 22 0a atest-version ".
0720: 20 20 6c 69 63 65 6e 73 65 20 47 50 4c 2c 20 43 license GPL, C
0730: 6f 70 79 72 69 67 68 74 20 4d 61 74 74 20 57 65 opyright Matt We
0740: 6c 6c 61 6e 64 20 32 30 30 36 2d 32 30 31 32 0a lland 2006-2012.
0750: 0a 55 73 61 67 65 3a 20 6d 65 67 61 74 65 73 74 .Usage: megatest
0760: 20 5b 6f 70 74 69 6f 6e 73 5d 0a 20 20 2d 68 20 [options]. -h
0770: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0780: 20 20 20 20 20 3a 20 74 68 69 73 20 68 65 6c 70 : this help
0790: 0a 20 20 2d 76 65 72 73 69 6f 6e 20 20 20 20 20 . -version
07a0: 20 20 20 20 20 20 20 20 20 20 20 3a 20 70 72 69 : pri
07b0: 6e 74 20 6d 65 67 61 74 65 73 74 20 76 65 72 73 nt megatest vers
07c0: 69 6f 6e 20 28 63 75 72 72 65 6e 74 6c 79 20 22 ion (currently "
07d0: 20 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f megatest-versio
07e0: 6e 20 22 29 0a 0a 4c 61 75 6e 63 68 69 6e 67 20 n ")..Launching
07f0: 61 6e 64 20 6d 61 6e 61 67 69 6e 67 20 72 75 6e and managing run
0800: 73 0a 20 20 2d 72 75 6e 61 6c 6c 20 20 20 20 20 s. -runall
0810: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 72 75 : ru
0820: 6e 20 61 6c 6c 20 74 65 73 74 73 20 74 68 61 74 n all tests that
0830: 20 61 72 65 20 6e 6f 74 20 73 74 61 74 65 20 43 are not state C
0840: 4f 4d 50 4c 45 54 45 44 20 61 6e 64 20 73 74 61 OMPLETED and sta
0850: 74 75 73 20 50 41 53 53 2c 20 0a 20 20 20 20 20 tus PASS, .
0860: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0870: 20 20 20 20 20 20 20 43 48 45 43 4b 20 6f 72 20 CHECK or
0880: 4b 49 4c 4c 45 44 0a 20 20 2d 72 75 6e 74 65 73 KILLED. -runtes
0890: 74 73 20 74 73 74 31 2c 74 73 74 32 20 2e 2e 2e ts tst1,tst2 ...
08a0: 20 3a 20 72 75 6e 20 74 65 73 74 73 0a 20 20 2d : run tests. -
08b0: 72 65 6d 6f 76 65 2d 72 75 6e 73 20 20 20 20 20 remove-runs
08c0: 20 20 20 20 20 20 20 3a 20 72 65 6d 6f 76 65 20 : remove
08d0: 74 68 65 20 64 61 74 61 20 66 6f 72 20 61 20 72 the data for a r
08e0: 75 6e 2c 20 72 65 71 75 69 72 65 73 20 3a 72 75 un, requires :ru
08f0: 6e 6e 61 6d 65 20 61 6e 64 20 2d 74 65 73 74 70 nname and -testp
0900: 61 74 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 att.
0910: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0920: 4f 70 74 69 6f 6e 61 6c 6c 79 20 75 73 65 20 3a Optionally use :
0930: 73 74 61 74 65 20 61 6e 64 20 3a 73 74 61 74 75 state and :statu
0940: 73 0a 20 20 2d 73 65 74 2d 73 74 61 74 65 2d 73 s. -set-state-s
0950: 74 61 74 75 73 20 58 2c 59 20 20 20 3a 20 73 65 tatus X,Y : se
0960: 74 20 73 74 61 74 65 20 74 6f 20 58 20 61 6e 64 t state to X and
0970: 20 73 74 61 74 75 73 20 74 6f 20 59 2c 20 72 65 status to Y, re
0980: 71 75 69 72 65 73 20 63 6f 6e 74 72 6f 6c 73 20 quires controls
0990: 70 65 72 20 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 per -remove-runs
09a0: 0a 20 20 2d 72 65 72 75 6e 20 46 41 49 4c 2c 57 . -rerun FAIL,W
09b0: 41 52 4e 2e 2e 2e 20 20 20 20 20 3a 20 66 6f 72 ARN... : for
09c0: 63 65 20 72 65 2d 72 75 6e 20 66 6f 72 20 74 65 ce re-run for te
09d0: 73 74 73 20 77 69 74 68 20 73 70 65 63 69 66 69 sts with specifi
09e0: 63 65 64 20 73 74 61 74 75 73 28 73 29 0a 20 20 ced status(s).
09f0: 2d 72 6f 6c 6c 75 70 20 20 20 20 20 20 20 20 20 -rollup
0a00: 20 20 20 20 20 20 20 20 3a 20 28 63 75 72 72 65 : (curre
0a10: 6e 74 6c 79 20 64 69 73 61 62 6c 65 64 29 20 66 ntly disabled) f
0a20: 69 6c 6c 20 72 75 6e 20 28 73 65 74 20 62 79 20 ill run (set by
0a30: 3a 72 75 6e 6e 61 6d 65 29 20 20 77 69 74 68 20 :runname) with
0a40: 6c 61 74 65 73 74 20 74 65 73 74 28 73 29 0a 20 latest test(s).
0a50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0a60: 20 20 20 20 20 20 20 20 20 20 20 66 72 6f 6d 20 from
0a70: 70 72 69 6f 72 20 72 75 6e 73 20 77 69 74 68 20 prior runs with
0a80: 73 61 6d 65 20 6b 65 79 73 0a 20 20 2d 6c 6f 63 same keys. -loc
0a90: 6b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 k
0aa0: 20 20 20 20 3a 20 6c 6f 63 6b 20 72 75 6e 20 73 : lock run s
0ab0: 70 65 63 69 66 69 65 64 20 62 79 20 74 61 72 67 pecified by targ
0ac0: 65 74 20 61 6e 64 20 72 75 6e 6e 61 6d 65 0a 20 et and runname.
0ad0: 20 2d 75 6e 6c 6f 63 6b 20 20 20 20 20 20 20 20 -unlock
0ae0: 20 20 20 20 20 20 20 20 20 3a 20 75 6e 6c 6f 63 : unloc
0af0: 6b 20 72 75 6e 20 73 70 65 63 69 66 69 65 64 20 k run specified
0b00: 62 79 20 74 61 72 67 65 74 20 61 6e 64 20 72 75 by target and ru
0b10: 6e 6e 61 6d 65 0a 0a 53 65 6c 65 63 74 6f 72 73 nname..Selectors
0b20: 20 28 65 2e 67 2e 20 75 73 65 20 66 6f 72 20 2d (e.g. use for -
0b30: 72 75 6e 74 65 73 74 73 2c 20 2d 72 65 6d 6f 76 runtests, -remov
0b40: 65 2d 72 75 6e 73 2c 20 2d 73 65 74 2d 73 74 61 e-runs, -set-sta
0b50: 74 65 2d 73 74 61 74 75 73 2c 20 2d 6c 69 73 74 te-status, -list
0b60: 2d 72 75 6e 73 20 65 74 63 2e 29 0a 20 20 2d 74 -runs etc.). -t
0b70: 61 72 67 65 74 20 6b 65 79 31 2f 6b 65 79 32 2f arget key1/key2/
0b80: 2e 2e 2e 20 20 20 3a 20 72 75 6e 20 66 6f 72 20 ... : run for
0b90: 6b 65 79 31 2c 20 6b 65 79 32 2c 20 65 74 63 2e key1, key2, etc.
0ba0: 0a 20 20 2d 72 65 71 74 61 72 67 20 6b 65 79 31 . -reqtarg key1
0bb0: 2f 6b 65 79 32 2f 2e 2e 2e 20 20 3a 20 72 75 6e /key2/... : run
0bc0: 20 66 6f 72 20 6b 65 79 31 2c 20 6b 65 79 32 2c for key1, key2,
0bd0: 20 65 74 63 2e 20 62 75 74 20 6b 65 79 31 2f 6b etc. but key1/k
0be0: 65 79 32 20 6d 75 73 74 20 62 65 20 69 6e 20 72 ey2 must be in r
0bf0: 75 6e 63 6f 6e 66 69 67 0a 20 20 2d 74 65 73 74 unconfig. -test
0c00: 70 61 74 74 20 70 61 74 74 31 2f 70 61 74 74 32 patt patt1/patt2
0c10: 2c 70 61 74 74 33 2f 2e 2e 2e 20 20 3a 20 25 20 ,patt3/... : %
0c20: 69 73 20 77 69 6c 64 63 61 72 64 0a 20 20 3a 72 is wildcard. :r
0c30: 75 6e 6e 61 6d 65 20 20 20 20 20 20 20 20 20 20 unname
0c40: 20 20 20 20 20 20 3a 20 72 65 71 75 69 72 65 64 : required
0c50: 2c 20 6e 61 6d 65 20 66 6f 72 20 74 68 69 73 20 , name for this
0c60: 70 61 72 74 69 63 75 6c 61 72 20 74 65 73 74 20 particular test
0c70: 72 75 6e 0a 20 20 3a 73 74 61 74 65 20 20 20 20 run. :state
0c80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 :
0c90: 41 70 70 6c 69 65 73 20 74 6f 20 72 75 6e 73 2c Applies to runs,
0ca0: 20 74 65 73 74 73 20 6f 72 20 73 74 65 70 73 20 tests or steps
0cb0: 64 65 70 65 6e 64 69 6e 67 20 6f 6e 20 63 6f 6e depending on con
0cc0: 74 65 78 74 0a 20 20 3a 73 74 61 74 75 73 20 20 text. :status
0cd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a :
0ce0: 20 41 70 70 6c 69 65 73 20 74 6f 20 72 75 6e 73 Applies to runs
0cf0: 2c 20 74 65 73 74 73 20 6f 72 20 73 74 65 70 73 , tests or steps
0d00: 20 64 65 70 65 6e 64 69 6e 67 20 6f 6e 20 63 6f depending on co
0d10: 6e 74 65 78 74 0a 0a 54 65 73 74 20 68 65 6c 70 ntext..Test help
0d20: 65 72 73 20 28 66 6f 72 20 75 73 65 20 69 6e 73 ers (for use ins
0d30: 69 64 65 20 74 65 73 74 73 29 0a 20 20 2d 73 74 ide tests). -st
0d40: 65 70 20 73 74 65 70 6e 61 6d 65 0a 20 20 2d 74 ep stepname. -t
0d50: 65 73 74 2d 73 74 61 74 75 73 20 20 20 20 20 20 est-status
0d60: 20 20 20 20 20 20 3a 20 73 65 74 20 74 68 65 20 : set the
0d70: 73 74 61 74 65 20 61 6e 64 20 73 74 61 74 75 73 state and status
0d80: 20 6f 66 20 61 20 74 65 73 74 20 28 75 73 65 20 of a test (use
0d90: 3a 73 74 61 74 65 20 61 6e 64 20 3a 73 74 61 74 :state and :stat
0da0: 75 73 29 0a 20 20 2d 73 65 74 6c 6f 67 20 6c 6f us). -setlog lo
0db0: 67 66 6e 61 6d 65 20 20 20 20 20 20 20 20 3a 20 gfname :
0dc0: 73 65 74 20 74 68 65 20 70 61 74 68 2f 66 69 6c set the path/fil
0dd0: 65 6e 61 6d 65 20 74 6f 20 74 68 65 20 66 69 6e ename to the fin
0de0: 61 6c 20 6c 6f 67 20 72 65 6c 61 74 69 76 65 20 al log relative
0df0: 74 6f 20 74 68 65 20 74 65 73 74 0a 20 20 20 20 to the test.
0e00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e10: 20 20 20 20 20 20 20 20 64 69 72 65 63 74 6f 72 director
0e20: 79 2e 20 6d 61 79 20 62 65 20 75 73 65 64 20 77 y. may be used w
0e30: 69 74 68 20 2d 74 65 73 74 2d 73 74 61 74 75 73 ith -test-status
0e40: 0a 20 20 2d 73 65 74 2d 74 6f 70 6c 6f 67 20 6c . -set-toplog l
0e50: 6f 67 66 6e 61 6d 65 20 20 20 20 3a 20 73 65 74 ogfname : set
0e60: 20 74 68 65 20 6f 76 65 72 61 6c 6c 20 6c 6f 67 the overall log
0e70: 20 66 6f 72 20 61 20 73 75 69 74 65 20 6f 66 20 for a suite of
0e80: 73 75 62 2d 74 65 73 74 73 0a 20 20 2d 73 75 6d sub-tests. -sum
0e90: 6d 61 72 69 7a 65 2d 69 74 65 6d 73 20 20 20 20 marize-items
0ea0: 20 20 20 20 3a 20 66 6f 72 20 61 6e 20 69 74 65 : for an ite
0eb0: 6d 69 7a 65 64 20 74 65 73 74 20 63 72 65 61 74 mized test creat
0ec0: 65 20 61 20 73 75 6d 6d 61 72 79 20 68 74 6d 6c e a summary html
0ed0: 20 0a 20 20 2d 6d 20 63 6f 6d 6d 65 6e 74 20 20 . -m comment
0ee0: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 69 6e : in
0ef0: 73 65 72 74 20 61 20 63 6f 6d 6d 65 6e 74 20 66 sert a comment f
0f00: 6f 72 20 74 68 69 73 20 74 65 73 74 0a 0a 54 65 or this test..Te
0f10: 73 74 20 64 61 74 61 20 63 61 70 74 75 72 65 0a st data capture.
0f20: 20 20 2d 73 65 74 2d 76 61 6c 75 65 73 20 20 20 -set-values
0f30: 20 20 20 20 20 20 20 20 20 20 3a 20 75 70 64 61 : upda
0f40: 74 65 20 6f 72 20 73 65 74 20 76 61 6c 75 65 73 te or set values
0f50: 20 69 6e 20 74 68 65 20 74 65 73 74 64 61 74 61 in the testdata
0f60: 20 74 61 62 6c 65 0a 20 20 3a 63 61 74 65 67 6f table. :catego
0f70: 72 79 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ry
0f80: 20 3a 20 73 65 74 20 74 68 65 20 63 61 74 65 67 : set the categ
0f90: 6f 72 79 20 66 69 65 6c 64 20 28 6f 70 74 69 6f ory field (optio
0fa0: 6e 61 6c 29 0a 20 20 3a 76 61 72 69 61 62 6c 65 nal). :variable
0fb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a :
0fc0: 20 73 65 74 20 74 68 65 20 76 61 72 69 61 62 6c set the variabl
0fd0: 65 20 6e 61 6d 65 20 28 6f 70 74 69 6f 6e 61 6c e name (optional
0fe0: 29 0a 20 20 3a 76 61 6c 75 65 20 20 20 20 20 20 ). :value
0ff0: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 76 61 : va
1000: 6c 75 65 20 6d 65 61 73 75 72 65 64 20 28 72 65 lue measured (re
1010: 71 75 69 72 65 64 29 0a 20 20 3a 65 78 70 65 63 quired). :expec
1020: 74 65 64 20 20 20 20 20 20 20 20 20 20 20 20 20 ted
1030: 20 20 3a 20 76 61 6c 75 65 20 65 78 70 65 63 74 : value expect
1040: 65 64 20 28 72 65 71 75 69 72 65 64 29 0a 20 20 ed (required).
1050: 3a 74 6f 6c 20 20 20 20 20 20 20 20 20 20 20 20 :tol
1060: 20 20 20 20 20 20 20 20 3a 20 7c 76 61 6c 75 65 : |value
1070: 2d 65 78 70 65 63 74 7c 20 3c 3d 20 74 6f 6c 20 -expect| <= tol
1080: 28 72 65 71 75 69 72 65 64 2c 20 63 61 6e 20 62 (required, can b
1090: 65 20 3c 2c 20 3e 2c 20 3e 3d 2c 20 3c 3d 20 6f e <, >, >=, <= o
10a0: 72 20 6e 75 6d 62 65 72 29 0a 20 20 3a 75 6e 69 r number). :uni
10b0: 74 73 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ts
10c0: 20 20 20 20 3a 20 6e 61 6d 65 20 6f 66 20 74 68 : name of th
10d0: 65 20 75 6e 69 74 73 20 66 6f 72 20 76 61 6c 75 e units for valu
10e0: 65 2c 20 65 78 70 65 63 74 65 64 5f 76 61 6c 75 e, expected_valu
10f0: 65 20 65 74 63 2e 20 28 6f 70 74 69 6f 6e 61 6c e etc. (optional
1100: 29 0a 20 20 2d 6c 6f 61 64 2d 74 65 73 74 2d 64 ). -load-test-d
1110: 61 74 61 20 20 20 20 20 20 20 20 20 3a 20 72 65 ata : re
1120: 61 64 20 74 65 73 74 20 73 70 65 63 69 66 69 63 ad test specific
1130: 20 64 61 74 61 20 66 6f 72 20 73 74 6f 72 61 67 data for storag
1140: 65 20 69 6e 20 74 68 65 20 74 65 73 74 5f 64 61 e in the test_da
1150: 74 61 20 74 61 62 6c 65 0a 20 20 20 20 20 20 20 ta table.
1160: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1170: 20 20 20 20 20 66 72 6f 6d 20 73 74 61 6e 64 61 from standa
1180: 72 64 20 69 6e 2e 20 45 61 63 68 20 6c 69 6e 65 rd in. Each line
1190: 20 69 73 20 63 6f 6d 6d 61 20 64 65 6c 69 6d 69 is comma delimi
11a0: 74 65 64 20 77 69 74 68 20 66 6f 75 72 0a 20 20 ted with four.
11b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11c0: 20 20 20 20 20 20 20 20 20 20 66 69 65 6c 64 73 fields
11d0: 20 63 61 74 65 67 6f 72 79 2c 76 61 72 69 61 62 category,variab
11e0: 6c 65 2c 76 61 6c 75 65 2c 63 6f 6d 6d 65 6e 74 le,value,comment
11f0: 0a 0a 51 75 65 72 69 65 73 0a 20 20 2d 6c 69 73 ..Queries. -lis
1200: 74 2d 72 75 6e 73 20 70 61 74 74 20 20 20 20 20 t-runs patt
1210: 20 20 20 20 3a 20 6c 69 73 74 20 72 75 6e 73 20 : list runs
1220: 6d 61 74 63 68 69 6e 67 20 70 61 74 74 65 72 6e matching pattern
1230: 20 5c 22 70 61 74 74 5c 22 2c 20 25 20 69 73 20 \"patt\", % is
1240: 74 68 65 20 77 69 6c 64 63 61 72 64 0a 20 20 2d the wildcard. -
1250: 73 68 6f 77 6b 65 79 73 20 20 20 20 20 20 20 20 showkeys
1260: 20 20 20 20 20 20 20 3a 20 73 68 6f 77 20 74 68 : show th
1270: 65 20 6b 65 79 73 20 75 73 65 64 20 69 6e 20 74 e keys used in t
1280: 68 69 73 20 6d 65 67 61 74 65 73 74 20 73 65 74 his megatest set
1290: 75 70 0a 20 20 2d 74 65 73 74 2d 66 69 6c 65 73 up. -test-files
12a0: 20 74 61 72 67 70 61 74 74 20 20 20 20 20 3a 20 targpatt :
12b0: 67 65 74 20 74 68 65 20 6d 6f 73 74 20 72 65 63 get the most rec
12c0: 65 6e 74 20 74 65 73 74 20 70 61 74 68 2f 66 69 ent test path/fi
12d0: 6c 65 20 6d 61 74 63 68 69 6e 67 20 74 61 72 67 le matching targ
12e0: 70 61 74 74 20 65 2e 67 2e 20 25 2f 25 2e 2e 2e patt e.g. %/%...
12f0: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1300: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 72 65 re
1310: 74 75 72 6e 73 20 6c 69 73 74 20 73 6f 72 74 65 turns list sorte
1320: 64 20 62 79 20 61 67 65 20 61 73 63 65 6e 64 69 d by age ascendi
1330: 6e 67 2c 20 73 65 65 20 65 78 61 6d 70 6c 65 73 ng, see examples
1340: 20 62 65 6c 6f 77 0a 20 20 2d 74 65 73 74 2d 70 below. -test-p
1350: 61 74 68 73 20 20 20 20 20 20 20 20 20 20 20 20 aths
1360: 20 3a 20 67 65 74 20 74 68 65 20 74 65 73 74 20 : get the test
1370: 70 61 74 68 73 20 6d 61 74 63 68 69 6e 67 20 74 paths matching t
1380: 61 72 67 65 74 2c 20 72 75 6e 6e 61 6d 65 2c 20 arget, runname,
1390: 69 74 65 6d 20 61 6e 64 20 74 65 73 74 0a 20 20 item and test.
13a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13b0: 20 20 20 20 20 20 20 20 20 20 70 61 74 74 65 72 patter
13c0: 6e 73 2e 0a 20 20 2d 6c 69 73 74 2d 64 69 73 6b ns.. -list-disk
13d0: 73 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 s :
13e0: 6c 69 73 74 20 74 68 65 20 64 69 73 6b 73 20 61 list the disks a
13f0: 76 61 69 6c 61 62 6c 65 20 66 6f 72 20 73 74 6f vailable for sto
1400: 72 69 6e 67 20 72 75 6e 73 0a 20 20 2d 6c 69 73 ring runs. -lis
1410: 74 2d 74 61 72 67 65 74 73 20 20 20 20 20 20 20 t-targets
1420: 20 20 20 20 3a 20 6c 69 73 74 20 74 68 65 20 74 : list the t
1430: 61 72 67 65 74 73 20 69 6e 20 72 75 6e 63 6f 6e argets in runcon
1440: 66 69 67 73 2e 63 6f 6e 66 69 67 0a 20 20 2d 6c figs.config. -l
1450: 69 73 74 2d 64 62 2d 74 61 72 67 65 74 73 20 20 ist-db-targets
1460: 20 20 20 20 20 20 3a 20 6c 69 73 74 20 74 68 65 : list the
1470: 20 74 61 72 67 65 74 20 63 6f 6d 62 69 6e 61 74 target combinat
1480: 69 6f 6e 73 20 75 73 65 64 20 69 6e 20 74 68 65 ions used in the
1490: 20 64 62 0a 20 20 2d 73 68 6f 77 2d 63 6f 6e 66 db. -show-conf
14a0: 69 67 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 ig :
14b0: 64 75 6d 70 20 74 68 65 20 69 6e 74 65 72 6e 61 dump the interna
14c0: 6c 20 72 65 70 72 65 73 65 6e 74 61 74 69 6f 6e l representation
14d0: 20 6f 66 20 74 68 65 20 6d 65 67 61 74 65 73 74 of the megatest
14e0: 2e 63 6f 6e 66 69 67 20 66 69 6c 65 0a 20 20 2d .config file. -
14f0: 73 68 6f 77 2d 72 75 6e 63 6f 6e 66 69 67 20 20 show-runconfig
1500: 20 20 20 20 20 20 20 3a 20 64 75 6d 70 20 74 68 : dump th
1510: 65 20 69 6e 74 65 72 6e 61 6c 20 72 65 70 72 65 e internal repre
1520: 73 65 6e 74 61 74 69 6f 6e 20 6f 66 20 74 68 65 sentation of the
1530: 20 72 75 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 runconfigs.conf
1540: 69 67 20 66 69 6c 65 0a 20 20 2d 64 75 6d 70 6d ig file. -dumpm
1550: 6f 64 65 20 6a 73 6f 6e 20 20 20 20 20 20 20 20 ode json
1560: 20 20 3a 20 64 75 6d 70 20 69 6e 20 6a 73 6f 6e : dump in json
1570: 20 66 6f 72 6d 61 74 20 69 6e 73 74 65 61 64 20 format instead
1580: 6f 66 20 73 65 78 70 72 0a 0a 4d 69 73 63 20 0a of sexpr..Misc .
1590: 20 20 2d 72 65 62 75 69 6c 64 2d 64 62 20 20 20 -rebuild-db
15a0: 20 20 20 20 20 20 20 20 20 20 3a 20 62 72 69 6e : brin
15b0: 67 20 74 68 65 20 64 61 74 61 62 61 73 65 20 73 g the database s
15c0: 63 68 65 6d 61 20 75 70 20 74 6f 20 64 61 74 65 chema up to date
15d0: 0a 20 20 2d 75 70 64 61 74 65 2d 6d 65 74 61 20 . -update-meta
15e0: 20 20 20 20 20 20 20 20 20 20 20 3a 20 75 70 64 : upd
15f0: 61 74 65 20 74 68 65 20 74 65 73 74 73 20 6d 65 ate the tests me
1600: 74 61 64 61 74 61 20 66 6f 72 20 61 6c 6c 20 74 tadata for all t
1610: 65 73 74 73 0a 20 20 2d 65 6e 76 32 66 69 6c 65 ests. -env2file
1620: 20 66 6e 61 6d 65 20 20 20 20 20 20 20 20 20 3a fname :
1630: 20 77 72 69 74 65 20 74 68 65 20 65 6e 76 69 72 write the envir
1640: 6f 6e 6d 65 6e 74 20 74 6f 20 66 6e 61 6d 65 2e onment to fname.
1650: 63 73 68 20 61 6e 64 20 66 6e 61 6d 65 2e 73 68 csh and fname.sh
1660: 0a 20 20 2d 73 65 74 76 61 72 73 20 56 41 52 31 . -setvars VAR1
1670: 3d 76 61 6c 31 2c 56 41 52 32 3d 76 61 6c 32 20 =val1,VAR2=val2
1680: 3a 20 41 64 64 20 65 6e 76 69 72 6f 6e 6d 65 6e : Add environmen
1690: 74 20 76 61 72 69 61 62 6c 65 73 20 74 6f 20 61 t variables to a
16a0: 20 72 75 6e 20 4e 42 2f 2f 20 74 68 65 73 65 20 run NB// these
16b0: 61 72 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 are.
16c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16d0: 20 20 20 20 20 6f 76 65 72 77 72 69 74 74 65 6e overwritten
16e0: 20 62 79 20 76 61 6c 75 65 73 20 73 65 74 20 69 by values set i
16f0: 6e 20 63 6f 6e 66 69 67 20 66 69 6c 65 73 2e 0a n config files..
1700: 20 20 2d 73 65 72 76 65 72 20 2d 7c 68 6f 73 74 -server -|host
1710: 6e 61 6d 65 20 20 20 20 20 20 3a 20 73 74 61 72 name : star
1720: 74 20 74 68 65 20 73 65 72 76 65 72 20 28 72 65 t the server (re
1730: 64 75 63 65 73 20 63 6f 6e 74 65 6e 74 69 6f 6e duces contention
1740: 20 6f 6e 20 6d 65 67 61 74 65 73 74 2e 64 62 29 on megatest.db)
1750: 2c 20 75 73 65 0a 20 20 20 20 20 20 20 20 20 20 , use.
1760: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1770: 20 20 2d 20 74 6f 20 61 75 74 6f 6d 61 74 69 63 - to automatic
1780: 61 6c 6c 79 20 66 69 67 75 72 65 20 6f 75 74 20 ally figure out
1790: 68 6f 73 74 6e 61 6d 65 0a 20 20 2d 74 72 61 6e hostname. -tran
17a0: 73 70 6f 72 74 20 68 74 74 70 7c 66 73 20 20 20 sport http|fs
17b0: 20 20 20 3a 20 75 73 65 20 68 74 74 70 20 6f 72 : use http or
17c0: 20 64 69 72 65 63 74 20 61 63 63 65 73 73 20 66 direct access f
17d0: 6f 72 20 74 72 61 6e 73 70 6f 72 74 20 28 64 65 or transport (de
17e0: 66 61 75 6c 74 20 69 73 20 68 74 74 70 29 20 0a fault is http) .
17f0: 20 20 2d 64 61 65 6d 6f 6e 69 7a 65 20 20 20 20 -daemonize
1800: 20 20 20 20 20 20 20 20 20 20 3a 20 66 6f 72 6b : fork
1810: 20 69 6e 74 6f 20 62 61 63 6b 67 72 6f 75 6e 64 into background
1820: 20 61 6e 64 20 64 69 73 63 6f 6e 6e 65 63 74 20 and disconnect
1830: 66 72 6f 6d 20 73 74 64 69 6e 2f 6f 75 74 0a 20 from stdin/out.
1840: 20 2d 6c 69 73 74 2d 73 65 72 76 65 72 73 20 20 -list-servers
1850: 20 20 20 20 20 20 20 20 20 3a 20 6c 69 73 74 20 : list
1860: 74 68 65 20 73 65 72 76 65 72 73 20 0a 20 20 2d the servers . -
1870: 73 74 6f 70 2d 73 65 72 76 65 72 20 69 64 20 20 stop-server id
1880: 20 20 20 20 20 20 20 3a 20 73 74 6f 70 20 73 65 : stop se
1890: 72 76 65 72 20 73 70 65 63 69 66 69 65 64 20 62 rver specified b
18a0: 79 20 69 64 20 28 73 65 65 20 6f 75 74 70 75 74 y id (see output
18b0: 20 6f 66 20 2d 6c 69 73 74 2d 73 65 72 76 65 72 of -list-server
18c0: 73 29 0a 20 20 2d 72 65 70 6c 20 20 20 20 20 20 s). -repl
18d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 : s
18e0: 74 61 72 74 20 61 20 72 65 70 6c 20 28 75 73 65 tart a repl (use
18f0: 66 75 6c 20 66 6f 72 20 65 78 74 65 6e 64 69 6e ful for extendin
1900: 67 20 6d 65 67 61 74 65 73 74 29 0a 20 20 2d 6c g megatest). -l
1910: 6f 61 64 20 66 69 6c 65 2e 73 63 6d 20 20 20 20 oad file.scm
1920: 20 20 20 20 20 20 3a 20 6c 6f 61 64 20 61 6e 64 : load and
1930: 20 72 75 6e 20 66 69 6c 65 2e 73 63 6d 0a 0a 53 run file.scm..S
1940: 70 72 65 61 64 73 68 65 65 74 20 67 65 6e 65 72 preadsheet gener
1950: 61 74 69 6f 6e 0a 20 20 2d 65 78 74 72 61 63 74 ation. -extract
1960: 2d 6f 64 73 20 66 6e 61 6d 65 2e 6f 64 73 20 20 -ods fname.ods
1970: 3a 20 65 78 74 72 61 63 74 20 61 6e 20 6f 70 65 : extract an ope
1980: 6e 20 64 6f 63 75 6d 65 6e 74 20 73 70 72 65 61 n document sprea
1990: 64 73 68 65 65 74 20 66 72 6f 6d 20 74 68 65 20 dsheet from the
19a0: 64 61 74 61 62 61 73 65 0a 20 20 2d 70 61 74 68 database. -path
19b0: 6d 6f 64 20 70 61 74 68 20 20 20 20 20 20 20 20 mod path
19c0: 20 20 20 3a 20 69 6e 73 65 72 74 20 70 61 74 68 : insert path
19d0: 2c 20 69 2e 65 2e 20 70 61 74 68 2f 72 75 6e 61 , i.e. path/runa
19e0: 6d 65 2f 69 74 65 6d 70 61 74 68 2f 6c 6f 67 66 me/itempath/logf
19f0: 69 6c 65 2e 68 74 6d 6c 0a 20 20 20 20 20 20 20 ile.html.
1a00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a10: 20 20 20 20 20 77 69 6c 6c 20 63 6c 65 61 72 20 will clear
1a20: 74 68 65 20 66 69 65 6c 64 20 69 66 20 6e 6f 20 the field if no
1a30: 72 75 6e 64 69 72 2f 74 65 73 74 6e 61 6d 65 2f rundir/testname/
1a40: 69 74 65 6d 70 61 74 68 2f 6c 6f 67 66 69 6c 65 itempath/logfile
1a50: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1a60: 20 20 20 20 20 20 20 20 20 20 20 20 20 69 66 20 if
1a70: 69 74 20 63 6f 6e 74 61 69 6e 73 20 66 6f 72 77 it contains forw
1a80: 61 72 64 20 73 6c 61 73 68 65 73 20 74 68 65 20 ard slashes the
1a90: 70 61 74 68 20 77 69 6c 6c 20 62 65 20 63 6f 6e path will be con
1aa0: 76 65 72 74 65 64 0a 20 20 20 20 20 20 20 20 20 verted.
1ab0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ac0: 20 20 20 74 6f 20 77 69 6e 64 6f 77 73 20 73 74 to windows st
1ad0: 79 6c 65 0a 47 65 74 74 69 6e 67 20 73 74 61 72 yle.Getting star
1ae0: 74 65 64 0a 20 20 2d 67 65 6e 2d 6d 65 67 61 74 ted. -gen-megat
1af0: 65 73 74 2d 61 72 65 61 20 20 20 20 20 20 20 3a est-area :
1b00: 20 63 72 65 61 74 65 20 61 20 73 6b 65 6c 65 74 create a skelet
1b10: 6f 6e 20 6d 65 67 61 74 65 73 74 20 61 72 65 61 on megatest area
1b20: 2e 20 59 6f 75 20 77 69 6c 6c 20 62 65 20 70 72 . You will be pr
1b30: 6f 6d 70 74 65 64 20 66 6f 72 20 70 61 74 68 73 ompted for paths
1b40: 0a 20 20 2d 67 65 6e 2d 6d 65 67 61 74 65 73 74 . -gen-megatest
1b50: 2d 74 65 73 74 20 74 6e 61 6d 65 20 3a 20 63 72 -test tname : cr
1b60: 65 61 74 65 20 61 20 73 6b 65 6c 65 74 6f 6e 20 eate a skeleton
1b70: 6d 65 67 61 74 65 73 74 20 74 65 73 74 2e 20 59 megatest test. Y
1b80: 6f 75 20 77 69 6c 6c 20 62 65 20 70 72 6f 6d 70 ou will be promp
1b90: 74 65 64 20 66 6f 72 20 69 6e 66 6f 0a 0a 45 78 ted for info..Ex
1ba0: 61 6d 70 6c 65 73 0a 0a 23 20 47 65 74 20 74 65 amples..# Get te
1bb0: 73 74 20 70 61 74 68 2c 20 75 73 65 20 27 2e 27 st path, use '.'
1bc0: 20 74 6f 20 67 65 74 20 61 20 73 69 6e 67 6c 65 to get a single
1bd0: 20 70 61 74 68 20 6f 72 20 61 20 73 70 65 63 69 path or a speci
1be0: 66 69 63 20 70 61 74 68 2f 66 69 6c 65 20 70 61 fic path/file pa
1bf0: 74 74 65 72 6e 0a 6d 65 67 61 74 65 73 74 20 2d ttern.megatest -
1c00: 74 65 73 74 2d 66 69 6c 65 73 20 27 6c 6f 67 73 test-files 'logs
1c10: 2f 2a 2e 6c 6f 67 27 20 2d 74 61 72 67 65 74 20 /*.log' -target
1c20: 75 62 75 6e 74 75 2f 6e 25 2f 6e 6f 25 20 3a 72 ubuntu/n%/no% :r
1c30: 75 6e 6e 61 6d 65 20 77 34 39 25 20 2d 74 65 73 unname w49% -tes
1c40: 74 70 61 74 74 20 74 65 73 74 5f 6d 74 25 0a 0a tpatt test_mt%..
1c50: 43 61 6c 6c 65 64 20 61 73 20 22 20 28 73 74 72 Called as " (str
1c60: 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 ing-intersperse
1c70: 28 61 72 67 76 29 20 22 20 22 29 20 22 0a 56 65 (argv) " ") ".Ve
1c80: 72 73 69 6f 6e 20 22 20 6d 65 67 61 74 65 73 74 rsion " megatest
1c90: 2d 76 65 72 73 69 6f 6e 20 22 2c 20 62 75 69 6c -version ", buil
1ca0: 74 20 66 72 6f 6d 20 22 20 6d 65 67 61 74 65 73 t from " megates
1cb0: 74 2d 66 6f 73 73 69 6c 2d 68 61 73 68 20 29 29 t-fossil-hash ))
1cc0: 0a 0a 3b 3b 20 20 2d 67 75 69 20 20 20 20 20 20 ..;; -gui
1cd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 :
1ce0: 73 74 61 72 74 20 61 20 67 75 69 20 69 6e 74 65 start a gui inte
1cf0: 72 66 61 63 65 0a 3b 3b 20 20 2d 63 6f 6e 66 69 rface.;; -confi
1d00: 67 20 66 6e 61 6d 65 20 20 20 20 20 20 20 20 20 g fname
1d10: 20 20 3a 20 6f 76 65 72 72 69 64 65 20 74 68 65 : override the
1d20: 20 72 75 6e 63 6f 6e 66 69 67 20 66 69 6c 65 20 runconfig file
1d30: 77 69 74 68 20 66 6e 61 6d 65 0a 0a 3b 3b 20 70 with fname..;; p
1d40: 72 6f 63 65 73 73 20 61 72 67 73 0a 28 64 65 66 rocess args.(def
1d50: 69 6e 65 20 72 65 6d 61 72 67 73 20 28 61 72 67 ine remargs (arg
1d60: 73 3a 67 65 74 2d 61 72 67 73 20 0a 09 09 20 28 s:get-args ... (
1d70: 61 72 67 76 29 0a 09 09 20 28 6c 69 73 74 20 20 argv)... (list
1d80: 22 2d 72 75 6e 74 65 73 74 73 22 20 20 3b 3b 20 "-runtests" ;;
1d90: 72 75 6e 20 61 20 73 70 65 63 69 66 69 63 20 74 run a specific t
1da0: 65 73 74 0a 09 09 09 22 2d 63 6f 6e 66 69 67 22 est...."-config"
1db0: 20 20 20 20 3b 3b 20 6f 76 65 72 72 69 64 65 20 ;; override
1dc0: 74 68 65 20 63 6f 6e 66 69 67 20 66 69 6c 65 20 the config file
1dd0: 6e 61 6d 65 0a 09 09 09 22 2d 65 78 65 63 75 74 name...."-execut
1de0: 65 22 20 20 20 3b 3b 20 72 75 6e 20 74 68 65 20 e" ;; run the
1df0: 63 6f 6d 6d 61 6e 64 20 65 6e 63 6f 64 65 64 20 command encoded
1e00: 69 6e 20 74 68 65 20 62 61 73 65 36 34 20 70 61 in the base64 pa
1e10: 72 61 6d 65 74 65 72 0a 09 09 09 22 2d 73 74 65 rameter...."-ste
1e20: 70 22 0a 09 09 09 22 3a 72 75 6e 6e 61 6d 65 22 p"....":runname"
1e30: 20 20 20 0a 09 09 09 22 2d 74 61 72 67 65 74 22 ...."-target"
1e40: 0a 09 09 09 22 2d 72 65 71 74 61 72 67 22 0a 09 ...."-reqtarg"..
1e50: 09 09 22 3a 72 75 6e 6e 61 6d 65 22 0a 09 09 09 ..":runname"....
1e60: 22 2d 72 75 6e 6e 61 6d 65 22 0a 09 09 09 22 3a "-runname"....":
1e70: 73 74 61 74 65 22 20 20 0a 09 09 09 22 2d 73 74 state" ...."-st
1e80: 61 74 65 22 0a 09 09 09 22 3a 73 74 61 74 75 73 ate"....":status
1e90: 22 0a 09 09 09 22 2d 73 74 61 74 75 73 22 0a 09 "...."-status"..
1ea0: 09 09 22 2d 6c 69 73 74 2d 72 75 6e 73 22 0a 09 .."-list-runs"..
1eb0: 09 09 22 2d 74 65 73 74 70 61 74 74 22 20 0a 09 .."-testpatt" ..
1ec0: 09 09 22 2d 69 74 65 6d 70 61 74 74 22 0a 09 09 .."-itempatt"...
1ed0: 09 22 2d 73 65 74 6c 6f 67 22 0a 09 09 09 22 2d ."-setlog"...."-
1ee0: 73 65 74 2d 74 6f 70 6c 6f 67 22 0a 09 09 09 22 set-toplog"...."
1ef0: 2d 72 75 6e 73 74 65 70 22 0a 09 09 09 22 2d 6c -runstep"...."-l
1f00: 6f 67 70 72 6f 22 0a 09 09 09 22 2d 6d 22 0a 09 ogpro"...."-m"..
1f10: 09 09 22 2d 72 65 72 75 6e 22 0a 09 09 09 22 2d .."-rerun"...."-
1f20: 64 61 79 73 22 0a 09 09 09 22 2d 72 65 6e 61 6d days"...."-renam
1f30: 65 2d 72 75 6e 22 0a 09 09 09 22 2d 74 6f 22 0a e-run"...."-to".
1f40: 09 09 09 3b 3b 20 76 61 6c 75 65 73 20 61 6e 64 ...;; values and
1f50: 20 6d 65 73 73 61 67 65 73 0a 09 09 09 22 3a 63 messages....":c
1f60: 61 74 65 67 6f 72 79 22 0a 09 09 09 22 3a 76 61 ategory"....":va
1f70: 72 69 61 62 6c 65 22 0a 09 09 09 22 3a 76 61 6c riable"....":val
1f80: 75 65 22 0a 09 09 09 22 3a 65 78 70 65 63 74 65 ue"....":expecte
1f90: 64 22 0a 09 09 09 22 3a 74 6f 6c 22 0a 09 09 09 d"....":tol"....
1fa0: 22 3a 75 6e 69 74 73 22 0a 09 09 09 3b 3b 20 6d ":units"....;; m
1fb0: 69 73 63 0a 09 09 09 22 2d 73 65 72 76 65 72 22 isc...."-server"
1fc0: 0a 09 09 09 22 2d 74 72 61 6e 73 70 6f 72 74 22 ...."-transport"
1fd0: 0a 09 09 09 22 2d 73 74 6f 70 2d 73 65 72 76 65 ...."-stop-serve
1fe0: 72 22 0a 09 09 09 22 2d 70 6f 72 74 22 0a 09 09 r"...."-port"...
1ff0: 09 22 2d 65 78 74 72 61 63 74 2d 6f 64 73 22 0a ."-extract-ods".
2000: 09 09 09 22 2d 70 61 74 68 6d 6f 64 22 0a 09 09 ..."-pathmod"...
2010: 09 22 2d 65 6e 76 32 66 69 6c 65 22 0a 09 09 09 ."-env2file"....
2020: 22 2d 73 65 74 76 61 72 73 22 0a 09 09 09 22 2d "-setvars"...."-
2030: 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 set-state-status
2040: 22 0a 09 09 09 22 2d 64 65 62 75 67 22 20 3b 3b "...."-debug" ;;
2050: 20 66 6f 72 20 2a 76 65 72 62 6f 73 69 74 79 2a for *verbosity*
2060: 20 3e 20 32 0a 09 09 09 22 2d 67 65 6e 2d 6d 65 > 2...."-gen-me
2070: 67 61 74 65 73 74 2d 74 65 73 74 22 0a 09 09 09 gatest-test"....
2080: 22 2d 6f 76 65 72 72 69 64 65 2d 74 69 6d 65 6f "-override-timeo
2090: 75 74 22 0a 09 09 09 22 2d 74 65 73 74 2d 66 69 ut"...."-test-fi
20a0: 6c 65 73 22 20 20 3b 3b 20 2d 74 65 73 74 2d 70 les" ;; -test-p
20b0: 61 74 68 73 20 69 73 20 66 6f 72 20 6c 69 73 74 aths is for list
20c0: 69 6e 67 20 61 6c 6c 0a 09 09 09 22 2d 6c 6f 61 ing all...."-loa
20d0: 64 22 20 20 20 20 20 20 20 20 3b 3b 20 6c 6f 61 d" ;; loa
20e0: 64 20 61 6e 64 20 65 78 65 63 74 75 74 65 20 61 d and exectute a
20f0: 20 73 63 68 65 6d 65 20 66 69 6c 65 0a 09 09 09 scheme file....
2100: 22 2d 64 75 6d 70 6d 6f 64 65 22 0a 09 09 09 29 "-dumpmode"....)
2110: 20 0a 09 09 20 28 6c 69 73 74 20 20 22 2d 68 22 ... (list "-h"
2120: 0a 09 09 09 22 2d 76 65 72 73 69 6f 6e 22 0a 09 ...."-version"..
2130: 09 20 20 20 20 20 20 20 20 22 2d 66 6f 72 63 65 . "-force
2140: 22 0a 09 09 20 20 20 20 20 20 20 20 22 2d 78 74 "... "-xt
2150: 65 72 6d 22 0a 09 09 20 20 20 20 20 20 20 20 22 erm"... "
2160: 2d 73 68 6f 77 6b 65 79 73 22 0a 09 09 20 20 20 -showkeys"...
2170: 20 20 20 20 20 22 2d 74 65 73 74 2d 73 74 61 74 "-test-stat
2180: 75 73 22 0a 09 09 09 22 2d 73 65 74 2d 76 61 6c us"...."-set-val
2190: 75 65 73 22 0a 09 09 09 22 2d 6c 6f 61 64 2d 74 ues"...."-load-t
21a0: 65 73 74 2d 64 61 74 61 22 0a 09 09 09 22 2d 73 est-data"...."-s
21b0: 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 22 0a ummarize-items".
21c0: 09 09 20 20 20 20 20 20 20 20 22 2d 67 75 69 22 .. "-gui"
21d0: 0a 09 09 09 22 2d 64 61 65 6d 6f 6e 69 7a 65 22 ...."-daemonize"
21e0: 0a 09 09 09 3b 3b 20 6d 69 73 63 0a 09 09 09 22 ....;; misc...."
21f0: 2d 61 72 63 68 69 76 65 22 0a 09 09 09 22 2d 72 -archive"...."-r
2200: 65 70 6c 22 0a 09 09 09 22 2d 6c 6f 63 6b 22 0a epl"...."-lock".
2210: 09 09 09 22 2d 75 6e 6c 6f 63 6b 22 0a 09 09 09 ..."-unlock"....
2220: 22 2d 6c 69 73 74 2d 73 65 72 76 65 72 73 22 0a "-list-servers".
2230: 09 09 09 3b 3b 20 6d 69 73 74 20 71 75 65 72 69 ...;; mist queri
2240: 65 73 0a 09 09 09 22 2d 6c 69 73 74 2d 64 69 73 es...."-list-dis
2250: 6b 73 22 0a 09 09 09 22 2d 6c 69 73 74 2d 74 61 ks"...."-list-ta
2260: 72 67 65 74 73 22 0a 09 09 09 22 2d 6c 69 73 74 rgets"...."-list
2270: 2d 64 62 2d 74 61 72 67 65 74 73 22 0a 09 09 09 -db-targets"....
2280: 22 2d 73 68 6f 77 2d 72 75 6e 63 6f 6e 66 69 67 "-show-runconfig
2290: 22 0a 09 09 09 22 2d 73 68 6f 77 2d 63 6f 6e 66 "...."-show-conf
22a0: 69 67 22 0a 09 09 09 3b 3b 20 71 75 65 72 69 65 ig"....;; querie
22b0: 73 0a 09 09 09 22 2d 74 65 73 74 2d 70 61 74 68 s...."-test-path
22c0: 73 22 20 3b 3b 20 67 65 74 20 70 61 74 68 28 73 s" ;; get path(s
22d0: 29 20 74 6f 20 61 20 74 65 73 74 2c 20 6f 72 64 ) to a test, ord
22e0: 65 72 65 64 20 62 79 20 79 6f 75 6e 67 65 73 74 ered by youngest
22f0: 20 66 69 72 73 74 0a 0a 09 09 09 22 2d 72 75 6e first....."-run
2300: 61 6c 6c 22 20 20 20 20 3b 3b 20 72 75 6e 20 61 all" ;; run a
2310: 6c 6c 20 74 65 73 74 73 0a 09 09 09 22 2d 72 65 ll tests...."-re
2320: 6d 6f 76 65 2d 72 75 6e 73 22 0a 09 09 09 22 2d move-runs"...."-
2330: 72 65 62 75 69 6c 64 2d 64 62 22 0a 09 09 09 22 rebuild-db"...."
2340: 2d 72 6f 6c 6c 75 70 22 0a 09 09 09 22 2d 75 70 -rollup"...."-up
2350: 64 61 74 65 2d 6d 65 74 61 22 0a 09 09 09 22 2d date-meta"...."-
2360: 67 65 6e 2d 6d 65 67 61 74 65 73 74 2d 61 72 65 gen-megatest-are
2370: 61 22 0a 0a 09 09 09 22 2d 6c 6f 67 67 69 6e 67 a"....."-logging
2380: 22 0a 09 09 09 22 2d 76 22 20 3b 3b 20 76 65 72 "...."-v" ;; ver
2390: 62 6f 73 65 20 32 2c 20 6d 6f 72 65 20 74 68 61 bose 2, more tha
23a0: 6e 20 6e 6f 72 6d 61 6c 20 28 6e 6f 72 6d 61 6c n normal (normal
23b0: 20 69 73 20 31 29 0a 09 09 09 22 2d 71 22 20 3b is 1)...."-q" ;
23c0: 3b 20 71 75 69 65 74 20 30 2c 20 65 72 72 6f 72 ; quiet 0, error
23d0: 73 2f 77 61 72 6e 69 6e 67 73 20 6f 6e 6c 79 0a s/warnings only.
23e0: 09 09 20 20 20 20 20 20 20 29 0a 09 09 20 61 72 .. )... ar
23f0: 67 73 3a 61 72 67 2d 68 61 73 68 0a 09 09 20 30 gs:arg-hash... 0
2400: 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ))..(if (args:ge
2410: 74 2d 61 72 67 20 22 2d 68 22 29 0a 20 20 20 20 t-arg "-h").
2420: 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 70 72 (begin. (pr
2430: 69 6e 74 20 68 65 6c 70 29 0a 20 20 20 20 20 20 int help).
2440: 28 65 78 69 74 29 29 29 0a 0a 28 69 66 20 28 61 (exit)))..(if (a
2450: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 76 65 rgs:get-arg "-ve
2460: 72 73 69 6f 6e 22 29 0a 20 20 20 20 28 62 65 67 rsion"). (beg
2470: 69 6e 0a 20 20 20 20 20 20 28 70 72 69 6e 74 20 in. (print
2480: 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e megatest-version
2490: 29 0a 20 20 20 20 20 20 28 65 78 69 74 29 29 29 ). (exit)))
24a0: 0a 0a 28 64 65 66 69 6e 65 20 2a 64 69 64 73 6f ..(define *didso
24b0: 6d 65 74 68 69 6e 67 2a 20 23 66 29 0a 0a 3b 3b mething* #f)..;;
24c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
24d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
24e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
24f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2500: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4d 69 73 63 20 73 ======.;; Misc s
2510: 65 74 75 70 20 73 74 75 66 66 0a 3b 3b 3d 3d 3d etup stuff.;;===
2520: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2530: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2540: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2550: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2560: 3d 3d 3d 0a 0a 28 64 65 62 75 67 3a 73 65 74 75 ===..(debug:setu
2570: 70 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 p)..(if (args:ge
2580: 74 2d 61 72 67 20 22 2d 6c 6f 67 67 69 6e 67 22 t-arg "-logging"
2590: 29 28 73 65 74 21 20 2a 6c 6f 67 67 69 6e 67 2a )(set! *logging*
25a0: 20 23 74 29 29 0a 0a 28 69 66 20 28 64 65 62 75 #t))..(if (debu
25b0: 67 3a 64 65 62 75 67 2d 6d 6f 64 65 20 33 29 20 g:debug-mode 3)
25c0: 3b 3b 20 77 65 20 61 72 65 20 6f 62 76 69 6f 75 ;; we are obviou
25d0: 73 6c 79 20 64 65 62 75 67 67 69 6e 67 0a 20 20 sly debugging.
25e0: 20 20 28 73 65 74 21 20 6f 70 65 6e 2d 72 75 6e (set! open-run
25f0: 2d 63 6c 6f 73 65 20 6f 70 65 6e 2d 72 75 6e 2d -close open-run-
2600: 63 6c 6f 73 65 2d 6e 6f 2d 65 78 63 65 70 74 69 close-no-excepti
2610: 6f 6e 2d 68 61 6e 64 6c 69 6e 67 29 29 0a 0a 28 on-handling))..(
2620: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
2630: 20 22 2d 69 74 65 6d 70 61 74 74 22 29 0a 20 20 "-itempatt").
2640: 20 20 28 6c 65 74 20 28 28 6e 65 77 76 61 6c 20 (let ((newval
2650: 28 63 6f 6e 63 20 28 61 72 67 73 3a 67 65 74 2d (conc (args:get-
2660: 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 arg "-testpatt")
2670: 20 22 2f 22 20 28 61 72 67 73 3a 67 65 74 2d 61 "/" (args:get-a
2680: 72 67 20 22 2d 69 74 65 6d 70 61 74 74 22 29 29 rg "-itempatt"))
2690: 29 29 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a )). (debug:
26a0: 70 72 69 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 print 0 "WARNING
26b0: 3a 20 2d 69 74 65 6d 70 61 74 74 20 68 61 73 20 : -itempatt has
26c0: 62 65 65 6e 20 64 65 70 72 65 63 61 74 65 64 2c been deprecated,
26d0: 20 70 6c 65 61 73 65 20 75 73 65 20 2d 74 65 73 please use -tes
26e0: 74 70 61 74 74 20 74 65 73 74 70 61 74 74 2f 69 tpatt testpatt/i
26f0: 74 65 6d 70 61 74 74 20 6d 65 74 68 6f 64 2c 20 tempatt method,
2700: 6e 65 77 20 74 65 73 74 70 61 74 74 20 69 73 20 new testpatt is
2710: 22 6e 65 77 76 61 6c 29 0a 20 20 20 20 20 20 28 "newval). (
2720: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set!
2730: 61 72 67 73 3a 61 72 67 2d 68 61 73 68 20 22 2d args:arg-hash "-
2740: 74 65 73 74 70 61 74 74 22 20 6e 65 77 76 61 6c testpatt" newval
2750: 29 0a 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 ). (hash-ta
2760: 62 6c 65 2d 64 65 6c 65 74 65 21 20 61 72 67 73 ble-delete! args
2770: 3a 61 72 67 2d 68 61 73 68 20 22 2d 69 74 65 6d :arg-hash "-item
2780: 70 61 74 74 22 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d patt")))..;;====
2790: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
27a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
27b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
27c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
27d0: 3d 3d 0a 3b 3b 20 4d 69 73 63 20 67 65 6e 65 72 ==.;; Misc gener
27e0: 61 6c 20 63 61 6c 6c 73 0a 3b 3b 3d 3d 3d 3d 3d al calls.;;=====
27f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2800: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2810: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2820: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2830: 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 =..(if (args:get
2840: 2d 61 72 67 20 22 2d 65 6e 76 32 66 69 6c 65 22 -arg "-env2file"
2850: 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 ). (begin.
2860: 20 20 20 28 73 61 76 65 2d 65 6e 76 69 72 6f 6e (save-environ
2870: 6d 65 6e 74 2d 61 73 2d 66 69 6c 65 73 20 28 61 ment-as-files (a
2880: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 6e rgs:get-arg "-en
2890: 76 32 66 69 6c 65 22 29 29 0a 20 20 20 20 20 20 v2file")).
28a0: 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
28b0: 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 ing* #t)))..(if
28c0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
28d0: 6c 69 73 74 2d 64 69 73 6b 73 22 29 0a 20 20 20 list-disks").
28e0: 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 70 (begin. (p
28f0: 72 69 6e 74 20 0a 20 20 20 20 20 20 20 28 73 74 rint . (st
2900: 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse
2910: 20 0a 09 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 ..(map (lambda
2920: 28 78 29 0a 09 20 20 20 20 20 20 20 28 73 74 72 (x).. (str
2930: 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 ing-intersperse
2940: 0a 09 09 78 0a 09 09 22 20 3d 3e 20 22 29 29 0a ...x..." => ")).
2950: 09 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 67 65 . (common:ge
2960: 74 2d 64 69 73 6b 73 29 20 29 0a 09 22 5c 6e 22 t-disks) ).."\n"
2970: 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a )). (set! *
2980: 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
2990: 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
29a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
29b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
29c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
29d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
29e0: 20 53 74 61 72 74 20 74 68 65 20 73 65 72 76 65 Start the serve
29f0: 72 20 2d 20 63 61 6e 20 62 65 20 64 6f 6e 65 20 r - can be done
2a00: 69 6e 20 63 6f 6e 6a 75 6e 63 74 69 6f 6e 20 77 in conjunction w
2a10: 69 74 68 20 2d 72 75 6e 61 6c 6c 20 6f 72 20 2d ith -runall or -
2a20: 72 75 6e 74 65 73 74 73 20 28 6f 6e 65 20 64 61 runtests (one da
2a30: 79 2e 2e 2e 29 0a 3b 3b 20 20 20 77 65 20 73 74 y...).;; we st
2a40: 61 72 74 20 74 68 65 20 73 65 72 76 65 72 20 69 art the server i
2a50: 66 20 6e 6f 74 20 72 75 6e 6e 69 6e 67 20 65 6c f not running el
2a60: 73 65 20 73 74 61 72 74 20 74 68 65 20 63 6c 69 se start the cli
2a70: 65 6e 74 20 74 68 72 65 61 64 0a 3b 3b 3d 3d 3d ent thread.;;===
2a80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2a90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2aa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2ab0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2ac0: 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 ===..(if (args:g
2ad0: 65 74 2d 61 72 67 20 22 2d 73 65 72 76 65 72 22 et-arg "-server"
2ae0: 29 0a 20 20 20 20 28 6c 65 74 20 28 28 74 72 61 ). (let ((tra
2af0: 6e 73 70 6f 72 74 20 28 61 72 67 73 3a 67 65 74 nsport (args:get
2b00: 2d 61 72 67 20 22 2d 74 72 61 6e 73 70 6f 72 74 -arg "-transport
2b10: 22 20 22 68 74 74 70 22 29 29 29 0a 20 20 20 20 " "http"))).
2b20: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 (debug:print 2
2b30: 20 22 4c 61 75 6e 63 68 69 6e 67 20 73 65 72 76 "Launching serv
2b40: 65 72 20 75 73 69 6e 67 20 74 72 61 6e 73 70 6f er using transpo
2b50: 72 74 20 22 20 74 72 61 6e 73 70 6f 72 74 29 0a rt " transport).
2b60: 20 20 20 20 20 20 28 73 65 72 76 65 72 3a 6c 61 (server:la
2b70: 75 6e 63 68 20 28 73 74 72 69 6e 67 2d 3e 73 79 unch (string->sy
2b80: 6d 62 6f 6c 20 74 72 61 6e 73 70 6f 72 74 29 29 mbol transport))
2b90: 29 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 ). (if (not (
2ba0: 6e 75 6c 6c 3f 20 28 6c 73 65 74 2d 69 6e 74 65 null? (lset-inte
2bb0: 72 73 65 63 74 69 6f 6e 20 0a 09 09 20 20 20 20 rsection ...
2bc0: 20 65 71 75 61 6c 3f 0a 09 09 20 20 20 20 20 28 equal?... (
2bd0: 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 hash-table-keys
2be0: 61 72 67 73 3a 61 72 67 2d 68 61 73 68 29 0a 09 args:arg-hash)..
2bf0: 09 20 20 20 20 20 27 28 22 2d 72 75 6e 74 65 73 . '("-runtes
2c00: 74 73 22 20 20 20 20 22 2d 6c 69 73 74 2d 72 75 ts" "-list-ru
2c10: 6e 73 22 20 20 20 22 2d 72 6f 6c 6c 75 70 22 0a ns" "-rollup".
2c20: 09 09 20 20 20 20 20 20 20 22 2d 72 65 6d 6f 76 .. "-remov
2c30: 65 2d 72 75 6e 73 22 20 22 2d 6c 6f 63 6b 22 20 e-runs" "-lock"
2c40: 20 20 20 20 20 20 20 22 2d 75 6e 6c 6f 63 6b 22 "-unlock"
2c50: 0a 09 09 20 20 20 20 20 20 20 22 2d 75 70 64 61 ... "-upda
2c60: 74 65 2d 6d 65 74 61 22 20 22 2d 65 78 74 72 61 te-meta" "-extra
2c70: 63 74 2d 6f 64 73 22 29 29 29 29 0a 09 28 69 66 ct-ods"))))..(if
2c80: 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 (setup-for-run)
2c90: 0a 09 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 .. (let loop
2ca0: 28 28 73 65 72 76 65 72 73 20 20 28 6f 70 65 6e ((servers (open
2cb0: 2d 72 75 6e 2d 63 6c 6f 73 65 20 74 61 73 6b 73 -run-close tasks
2cc0: 3a 67 65 74 2d 62 65 73 74 2d 73 65 72 76 65 72 :get-best-server
2cd0: 20 74 61 73 6b 73 3a 6f 70 65 6e 2d 64 62 29 29 tasks:open-db))
2ce0: 0a 09 09 20 20 20 20 20 20 20 28 74 72 79 63 6f ... (tryco
2cf0: 75 6e 74 20 30 29 29 0a 09 20 20 20 20 20 20 28 unt 0)).. (
2d00: 69 66 20 28 6f 72 20 28 6e 6f 74 20 73 65 72 76 if (or (not serv
2d10: 65 72 73 29 0a 09 09 20 20 20 20 20 20 28 6e 75 ers)... (nu
2d20: 6c 6c 3f 20 73 65 72 76 65 72 73 29 29 0a 09 09 ll? servers))...
2d30: 20 20 28 62 65 67 69 6e 0a 09 09 20 20 20 20 28 (begin... (
2d40: 69 66 20 28 65 71 3f 20 74 72 79 63 6f 75 6e 74 if (eq? trycount
2d50: 20 30 29 20 3b 3b 20 6a 75 73 74 20 64 6f 20 74 0) ;; just do t
2d60: 68 65 20 73 65 72 76 65 72 20 73 74 61 72 74 20 he server start
2d70: 6f 6e 63 65 0a 09 09 09 28 62 65 67 69 6e 0a 09 once....(begin..
2d80: 09 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
2d90: 20 30 20 22 49 4e 46 4f 3a 20 53 74 61 72 74 69 0 "INFO: Starti
2da0: 6e 67 20 73 65 72 76 65 72 20 61 73 20 6e 6f 6e ng server as non
2db0: 65 20 72 75 6e 6e 69 6e 67 20 2e 2e 2e 22 29 0a e running ...").
2dc0: 09 09 09 20 20 3b 3b 20 28 73 65 72 76 65 72 3a ... ;; (server:
2dd0: 6c 61 75 6e 63 68 20 28 73 74 72 69 6e 67 2d 3e launch (string->
2de0: 73 79 6d 62 6f 6c 20 28 61 72 67 73 3a 67 65 74 symbol (args:get
2df0: 2d 61 72 67 20 22 2d 74 72 61 6e 73 70 6f 72 74 -arg "-transport
2e00: 22 20 22 68 74 74 70 22 29 29 29 29 0a 09 09 09 " "http"))))....
2e10: 20 20 3b 3b 20 28 70 72 6f 63 65 73 73 2d 72 75 ;; (process-ru
2e20: 6e 20 28 63 61 72 20 28 61 72 67 76 29 29 20 28 n (car (argv)) (
2e30: 6c 69 73 74 20 22 2d 73 65 72 76 65 72 22 20 22 list "-server" "
2e40: 2d 22 20 22 2d 64 61 65 6d 6f 6e 69 7a 65 22 20 -" "-daemonize"
2e50: 22 2d 74 72 61 6e 73 70 6f 72 74 22 20 28 61 72 "-transport" (ar
2e60: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 72 61 gs:get-arg "-tra
2e70: 6e 73 70 6f 72 74 22 20 22 68 74 74 70 22 29 29 nsport" "http"))
2e80: 29 0a 09 09 09 20 20 28 70 72 6f 63 65 73 73 2d ).... (process-
2e90: 66 6f 72 6b 20 28 6c 61 6d 62 64 61 20 28 29 0a fork (lambda ().
2ea0: 09 09 09 09 09 20 20 28 64 61 65 6d 6f 6e 3a 69 ..... (daemon:i
2eb0: 7a 65 29 0a 09 09 09 09 09 20 20 28 73 65 72 76 ze)...... (serv
2ec0: 65 72 3a 6c 61 75 6e 63 68 20 28 73 74 72 69 6e er:launch (strin
2ed0: 67 2d 3e 73 79 6d 62 6f 6c 20 28 61 72 67 73 3a g->symbol (args:
2ee0: 67 65 74 2d 61 72 67 20 22 2d 74 72 61 6e 73 70 get-arg "-transp
2ef0: 6f 72 74 22 20 22 68 74 74 70 22 29 29 29 29 29 ort" "http")))))
2f00: 0a 09 09 09 20 20 28 74 68 72 65 61 64 2d 73 6c .... (thread-sl
2f10: 65 65 70 21 20 33 29 29 0a 09 09 09 28 64 65 62 eep! 3))....(deb
2f20: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 ug:print-info 0
2f30: 22 57 61 69 74 69 6e 67 20 66 6f 72 20 73 65 72 "Waiting for ser
2f40: 76 65 72 20 74 6f 20 73 74 61 72 74 22 29 29 0a ver to start")).
2f50: 09 09 20 20 20 20 28 6c 6f 6f 70 20 28 6f 70 65 .. (loop (ope
2f60: 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 74 61 73 6b n-run-close task
2f70: 73 3a 67 65 74 2d 62 65 73 74 2d 73 65 72 76 65 s:get-best-serve
2f80: 72 20 74 61 73 6b 73 3a 6f 70 65 6e 2d 64 62 29 r tasks:open-db)
2f90: 20 0a 09 09 09 20 20 28 2b 20 74 72 79 63 6f 75 .... (+ trycou
2fa0: 6e 74 20 31 29 29 29 0a 09 09 20 20 28 64 65 62 nt 1)))... (deb
2fb0: 75 67 3a 70 72 69 6e 74 20 30 20 22 49 4e 46 4f ug:print 0 "INFO
2fc0: 3a 20 53 65 72 76 65 72 28 73 29 20 72 75 6e 6e : Server(s) runn
2fd0: 69 6e 67 20 22 20 73 65 72 76 65 72 73 29 0a 09 ing " servers)..
2fe0: 09 20 20 29 29 29 29 29 0a 0a 28 69 66 20 28 6f . )))))..(if (o
2ff0: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
3000: 22 2d 6c 69 73 74 2d 73 65 72 76 65 72 73 22 29 "-list-servers")
3010: 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ..(args:get-arg
3020: 22 2d 73 74 6f 70 2d 73 65 72 76 65 72 22 29 29 "-stop-server"))
3030: 0a 20 20 20 20 28 6c 65 74 20 28 28 74 6c 20 28 . (let ((tl (
3040: 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 29 setup-for-run)))
3050: 0a 20 20 20 20 20 20 28 69 66 20 74 6c 20 0a 09 . (if tl ..
3060: 20 20 28 6c 65 74 2a 20 28 28 73 65 72 76 65 72 (let* ((server
3070: 73 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 s (open-run-clos
3080: 65 20 74 61 73 6b 73 3a 67 65 74 2d 61 6c 6c 2d e tasks:get-all-
3090: 73 65 72 76 65 72 73 20 74 61 73 6b 73 3a 6f 70 servers tasks:op
30a0: 65 6e 2d 64 62 29 29 0a 09 09 20 28 66 6d 74 73 en-db))... (fmts
30b0: 74 72 20 20 22 7e 35 61 7e 38 61 7e 38 61 7e 32 tr "~5a~8a~8a~2
30c0: 30 61 7e 32 30 61 7e 31 30 61 7e 31 30 61 7e 31 0a~20a~10a~10a~1
30d0: 30 61 7e 31 30 61 7e 31 30 61 5c 6e 22 29 0a 09 0a~10a~10a\n")..
30e0: 09 20 28 73 65 72 76 65 72 73 2d 74 6f 2d 6b 69 . (servers-to-ki
30f0: 6c 6c 20 27 28 29 29 0a 09 09 20 28 6b 69 6c 6c ll '())... (kill
3100: 69 6e 66 6f 20 20 20 28 61 72 67 73 3a 67 65 74 info (args:get
3110: 2d 61 72 67 20 22 2d 73 74 6f 70 2d 73 65 72 76 -arg "-stop-serv
3120: 65 72 22 29 29 0a 09 09 20 28 6b 68 6f 73 74 2d er"))... (khost-
3130: 70 6f 72 74 20 28 69 66 20 6b 69 6c 6c 69 6e 66 port (if killinf
3140: 6f 20 28 69 66 20 28 73 75 62 73 74 72 69 6e 67 o (if (substring
3150: 2d 69 6e 64 65 78 20 22 3a 22 20 6b 69 6c 6c 69 -index ":" killi
3160: 6e 66 6f 29 28 73 74 72 69 6e 67 2d 73 70 6c 69 nfo)(string-spli
3170: 74 20 22 3a 22 29 20 23 66 29 20 23 66 29 29 0a t ":") #f) #f)).
3180: 09 09 20 28 73 69 64 20 20 20 20 20 20 20 20 28 .. (sid (
3190: 69 66 20 6b 69 6c 6c 69 6e 66 6f 20 28 69 66 20 if killinfo (if
31a0: 28 73 75 62 73 74 72 69 6e 67 2d 69 6e 64 65 78 (substring-index
31b0: 20 22 3a 22 20 6b 69 6c 6c 69 6e 66 6f 29 20 23 ":" killinfo) #
31c0: 66 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 f (string->numbe
31d0: 72 20 6b 69 6c 6c 69 6e 66 6f 29 29 20 23 66 29 r killinfo)) #f)
31e0: 29 29 0a 09 20 20 20 20 28 66 6f 72 6d 61 74 20 )).. (format
31f0: 23 74 20 66 6d 74 73 74 72 20 22 49 64 22 20 22 #t fmtstr "Id" "
3200: 4d 54 76 65 72 22 20 22 50 69 64 22 20 22 48 6f MTver" "Pid" "Ho
3210: 73 74 22 20 22 49 6e 74 65 72 66 61 63 65 22 20 st" "Interface"
3220: 22 4f 75 74 50 6f 72 74 22 20 22 49 6e 50 6f 72 "OutPort" "InPor
3230: 74 22 20 22 4c 61 73 74 42 65 61 74 22 20 22 53 t" "LastBeat" "S
3240: 74 61 74 65 22 20 22 54 72 61 6e 73 70 6f 72 74 tate" "Transport
3250: 22 29 0a 09 20 20 20 20 28 66 6f 72 6d 61 74 20 ").. (format
3260: 23 74 20 66 6d 74 73 74 72 20 22 3d 3d 22 20 22 #t fmtstr "==" "
3270: 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 22 20 22 3d 3d =====" "===" "==
3280: 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d 3d 3d 3d 22 20 ==" "========="
3290: 22 3d 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d "=======" "=====
32a0: 3d 22 20 22 3d 3d 3d 3d 3d 3d 3d 3d 22 20 22 3d =" "========" "=
32b0: 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d 3d 3d 3d ====" "=========
32c0: 22 29 0a 09 20 20 20 20 28 66 6f 72 2d 65 61 63 ").. (for-eac
32d0: 68 20 0a 09 20 20 20 20 20 28 6c 61 6d 62 64 61 h .. (lambda
32e0: 20 28 73 65 72 76 65 72 29 0a 09 20 20 20 20 20 (server)..
32f0: 20 20 28 6c 65 74 2a 20 28 28 69 64 20 20 20 20 (let* ((id
3300: 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 (vector-ref
3310: 20 73 65 72 76 65 72 20 30 29 29 0a 09 09 20 20 server 0))...
3320: 20 20 20 20 28 70 69 64 20 20 20 20 20 20 20 20 (pid
3330: 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 (vector-ref serv
3340: 65 72 20 31 29 29 0a 09 09 20 20 20 20 20 20 28 er 1))... (
3350: 68 6f 73 74 6e 61 6d 65 20 20 20 28 76 65 63 74 hostname (vect
3360: 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 32 29 or-ref server 2)
3370: 29 0a 09 09 20 20 20 20 20 20 28 69 6e 74 65 72 )... (inter
3380: 66 61 63 65 20 20 28 76 65 63 74 6f 72 2d 72 65 face (vector-re
3390: 66 20 73 65 72 76 65 72 20 33 29 29 0a 09 09 20 f server 3))...
33a0: 20 20 20 20 20 28 70 75 6c 6c 70 6f 72 74 20 20 (pullport
33b0: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 (vector-ref ser
33c0: 76 65 72 20 34 29 29 0a 09 09 20 20 20 20 20 20 ver 4))...
33d0: 28 70 75 62 70 6f 72 74 20 20 20 20 28 76 65 63 (pubport (vec
33e0: 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 35 tor-ref server 5
33f0: 29 29 0a 09 09 20 20 20 20 20 20 28 73 74 61 72 ))... (star
3400: 74 2d 74 69 6d 65 20 28 76 65 63 74 6f 72 2d 72 t-time (vector-r
3410: 65 66 20 73 65 72 76 65 72 20 36 29 29 0a 09 09 ef server 6))...
3420: 20 20 20 20 20 20 28 70 72 69 6f 72 69 74 79 20 (priority
3430: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 (vector-ref se
3440: 72 76 65 72 20 37 29 29 0a 09 09 20 20 20 20 20 rver 7))...
3450: 20 28 73 74 61 74 65 20 20 20 20 20 20 28 76 65 (state (ve
3460: 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 ctor-ref server
3470: 38 29 29 0a 09 09 20 20 20 20 20 20 28 6d 74 2d 8))... (mt-
3480: 76 65 72 20 20 20 20 20 28 76 65 63 74 6f 72 2d ver (vector-
3490: 72 65 66 20 73 65 72 76 65 72 20 39 29 29 0a 09 ref server 9))..
34a0: 09 20 20 20 20 20 20 28 6c 61 73 74 2d 75 70 64 . (last-upd
34b0: 61 74 65 20 28 76 65 63 74 6f 72 2d 72 65 66 20 ate (vector-ref
34c0: 73 65 72 76 65 72 20 31 30 29 29 20 3b 3b 20 20 server 10)) ;;
34d0: 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 (open-run-close
34e0: 20 74 61 73 6b 73 3a 73 65 72 76 65 72 2d 61 6c tasks:server-al
34f0: 69 76 65 3f 20 74 61 73 6b 73 3a 6f 70 65 6e 2d ive? tasks:open-
3500: 64 62 20 23 66 20 68 6f 73 74 6e 61 6d 65 3a 20 db #f hostname:
3510: 68 6f 73 74 6e 61 6d 65 20 70 6f 72 74 3a 20 70 hostname port: p
3520: 6f 72 74 29 29 0a 09 09 20 20 20 20 20 20 28 74 ort))... (t
3530: 72 61 6e 73 70 6f 72 74 20 20 28 76 65 63 74 6f ransport (vecto
3540: 72 2d 72 65 66 20 73 65 72 76 65 72 20 31 31 29 r-ref server 11)
3550: 29 0a 09 09 20 20 20 20 20 20 28 6b 69 6c 6c 65 )... (kille
3560: 64 20 20 20 20 20 23 66 29 0a 09 09 20 20 20 20 d #f)...
3570: 20 20 28 73 74 61 74 75 73 20 20 20 20 20 28 3c (status (<
3580: 20 6c 61 73 74 2d 75 70 64 61 74 65 20 32 30 29 last-update 20)
3590: 29 29 0a 09 09 20 3b 3b 20 20 20 28 7a 6d 71 2d ))... ;; (zmq-
35a0: 73 6f 63 6b 65 74 73 20 28 69 66 20 73 74 61 74 sockets (if stat
35b0: 75 73 20 28 73 65 72 76 65 72 3a 63 6c 69 65 6e us (server:clien
35c0: 74 2d 63 6f 6e 6e 65 63 74 20 68 6f 73 74 6e 61 t-connect hostna
35d0: 6d 65 20 70 6f 72 74 29 20 23 66 29 29 29 0a 09 me port) #f)))..
35e0: 09 20 3b 3b 20 6e 6f 20 6e 65 65 64 20 74 6f 20 . ;; no need to
35f0: 6c 6f 67 69 6e 20 61 73 20 73 74 61 74 75 73 20 login as status
3600: 6f 66 20 23 74 20 69 6e 64 69 63 61 74 65 73 20 of #t indicates
3610: 77 65 20 61 72 65 20 63 6f 6e 6e 65 63 74 69 6e we are connectin
3620: 67 20 74 6f 20 63 6f 72 72 65 63 74 20 0a 09 09 g to correct ...
3630: 20 3b 3b 20 73 65 72 76 65 72 0a 09 09 20 28 69 ;; server... (i
3640: 66 20 28 65 71 75 61 6c 3f 20 73 74 61 74 65 20 f (equal? state
3650: 22 64 65 61 64 22 29 0a 09 09 20 20 20 20 20 28 "dead")... (
3660: 69 66 20 28 3e 20 6c 61 73 74 2d 75 70 64 61 74 if (> last-updat
3670: 65 20 28 2a 20 32 35 20 36 30 20 36 30 29 29 20 e (* 25 60 60))
3680: 3b 3b 20 6b 65 65 70 20 72 65 63 6f 72 64 73 20 ;; keep records
3690: 61 72 6f 75 6e 64 20 66 6f 72 20 73 6c 69 67 68 around for sligh
36a0: 6c 79 20 6f 76 65 72 20 61 20 64 61 79 2e 0a 09 ly over a day...
36b0: 09 09 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f .. (open-run-clo
36c0: 73 65 20 74 61 73 6b 73 3a 73 65 72 76 65 72 2d se tasks:server-
36d0: 64 65 72 65 67 69 73 74 65 72 20 74 61 73 6b 73 deregister tasks
36e0: 3a 6f 70 65 6e 2d 64 62 20 68 6f 73 74 6e 61 6d :open-db hostnam
36f0: 65 20 70 75 6c 6c 70 6f 72 74 3a 20 70 75 6c 6c e pullport: pull
3700: 70 6f 72 74 20 70 69 64 3a 20 70 69 64 20 61 63 port pid: pid ac
3710: 74 69 6f 6e 3a 20 27 64 65 6c 65 74 65 29 29 0a tion: 'delete)).
3720: 09 09 20 20 20 20 20 28 69 66 20 28 3e 20 6c 61 .. (if (> la
3730: 73 74 2d 75 70 64 61 74 65 20 32 30 29 20 20 20 st-update 20)
3740: 20 20 20 20 20 3b 3b 20 4d 61 72 6b 20 61 73 20 ;; Mark as
3750: 64 65 61 64 20 69 66 20 6e 6f 74 20 75 70 64 61 dead if not upda
3760: 74 65 64 20 69 6e 20 6c 61 73 74 20 32 30 20 73 ted in last 20 s
3770: 65 63 6f 6e 64 73 0a 09 09 09 20 28 6f 70 65 6e econds.... (open
3780: 2d 72 75 6e 2d 63 6c 6f 73 65 20 74 61 73 6b 73 -run-close tasks
3790: 3a 73 65 72 76 65 72 2d 64 65 72 65 67 69 73 74 :server-deregist
37a0: 65 72 20 74 61 73 6b 73 3a 6f 70 65 6e 2d 64 62 er tasks:open-db
37b0: 20 68 6f 73 74 6e 61 6d 65 20 70 75 6c 6c 70 6f hostname pullpo
37c0: 72 74 3a 20 70 75 6c 6c 70 6f 72 74 20 70 69 64 rt: pullport pid
37d0: 3a 20 70 69 64 29 29 29 0a 09 09 20 28 66 6f 72 : pid)))... (for
37e0: 6d 61 74 20 23 74 20 66 6d 74 73 74 72 20 69 64 mat #t fmtstr id
37f0: 20 6d 74 2d 76 65 72 20 70 69 64 20 68 6f 73 74 mt-ver pid host
3800: 6e 61 6d 65 20 69 6e 74 65 72 66 61 63 65 20 70 name interface p
3810: 75 6c 6c 70 6f 72 74 20 70 75 62 70 6f 72 74 20 ullport pubport
3820: 6c 61 73 74 2d 75 70 64 61 74 65 0a 09 09 09 20 last-update....
3830: 28 69 66 20 73 74 61 74 75 73 20 22 61 6c 69 76 (if status "aliv
3840: 65 22 20 22 64 65 61 64 22 29 20 74 72 61 6e 73 e" "dead") trans
3850: 70 6f 72 74 29 0a 09 09 20 28 69 66 20 28 65 71 port)... (if (eq
3860: 75 61 6c 3f 20 69 64 20 73 69 64 29 0a 09 09 20 ual? id sid)...
3870: 20 20 20 20 28 62 65 67 69 6e 0a 09 09 20 20 20 (begin...
3880: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
3890: 2d 69 6e 66 6f 20 30 20 22 41 74 74 65 6d 70 74 -info 0 "Attempt
38a0: 69 6e 67 20 74 6f 20 73 74 6f 70 20 73 65 72 76 ing to stop serv
38b0: 65 72 20 77 69 74 68 20 70 69 64 20 22 20 70 69 er with pid " pi
38c0: 64 29 0a 09 09 20 20 20 20 20 20 20 28 74 61 73 d)... (tas
38d0: 6b 73 3a 6b 69 6c 6c 2d 73 65 72 76 65 72 20 73 ks:kill-server s
38e0: 74 61 74 75 73 20 68 6f 73 74 6e 61 6d 65 20 70 tatus hostname p
38f0: 75 6c 6c 70 6f 72 74 20 70 69 64 20 74 72 61 6e ullport pid tran
3900: 73 70 6f 72 74 29 29 29 29 29 0a 09 20 20 20 20 sport)))))..
3910: 20 73 65 72 76 65 72 73 29 0a 09 20 20 20 20 28 servers).. (
3920: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
3930: 20 31 20 22 44 6f 6e 65 20 77 69 74 68 20 6c 69 1 "Done with li
3940: 73 74 73 65 72 76 65 72 73 22 29 0a 09 20 20 20 stservers")..
3950: 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 (set! *didsomet
3960: 68 69 6e 67 2a 20 23 74 29 0a 09 20 20 20 20 28 hing* #t).. (
3970: 65 78 69 74 29 29 20 3b 3b 20 6d 75 73 74 20 64 exit)) ;; must d
3980: 6f 2c 20 77 6f 75 6c 64 20 68 61 76 65 20 74 6f o, would have to
3990: 20 61 64 64 20 63 68 65 63 6b 73 20 74 6f 20 6d add checks to m
39a0: 61 6e 79 2f 61 6c 6c 20 63 61 6c 6c 73 20 62 65 any/all calls be
39b0: 6c 6f 77 0a 09 20 20 28 65 78 69 74 29 29 29 0a low.. (exit))).
39c0: 20 20 20 20 3b 3b 20 69 66 20 6e 6f 74 20 6c 69 ;; if not li
39d0: 73 74 20 6f 72 20 6b 69 6c 6c 20 74 68 65 6e 20 st or kill then
39e0: 73 74 61 72 74 20 61 20 63 6c 69 65 6e 74 20 28 start a client (
39f0: 69 66 20 61 70 70 72 6f 70 72 69 61 74 65 29 0a if appropriate).
3a00: 20 20 20 20 28 69 66 20 28 6f 72 20 28 61 72 67 (if (or (arg
3a10: 73 2d 64 65 66 69 6e 65 64 3f 20 22 2d 68 22 20 s-defined? "-h"
3a20: 22 2d 76 65 72 73 69 6f 6e 22 20 22 2d 67 65 6e "-version" "-gen
3a30: 2d 6d 65 67 61 74 65 73 74 2d 61 72 65 61 22 20 -megatest-area"
3a40: 22 2d 67 65 6e 2d 6d 65 67 61 74 65 73 74 2d 74 "-gen-megatest-t
3a50: 65 73 74 22 29 0a 09 20 20 20 20 28 65 71 3f 20 est").. (eq?
3a60: 28 6c 65 6e 67 74 68 20 28 68 61 73 68 2d 74 61 (length (hash-ta
3a70: 62 6c 65 2d 6b 65 79 73 20 61 72 67 73 3a 61 72 ble-keys args:ar
3a80: 67 2d 68 61 73 68 29 29 20 30 29 29 0a 09 28 64 g-hash)) 0))..(d
3a90: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
3aa0: 31 20 22 53 65 72 76 65 72 20 63 6f 6e 6e 65 63 1 "Server connec
3ab0: 74 69 6f 6e 20 6e 6f 74 20 6e 65 65 64 65 64 22 tion not needed"
3ac0: 29 0a 09 3b 3b 20 6f 6b 2c 20 73 6f 20 6c 65 74 )..;; ok, so let
3ad0: 73 20 63 6f 6e 6e 65 63 74 20 74 6f 20 74 68 65 s connect to the
3ae0: 20 73 65 72 76 65 72 0a 09 28 63 6c 69 65 6e 74 server..(client
3af0: 3a 6c 61 75 6e 63 68 29 29 29 0a 0a 3b 3b 3d 3d :launch)))..;;==
3b00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3b10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3b20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3b30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3b40: 3d 3d 3d 3d 0a 3b 3b 20 57 65 69 72 64 20 73 70 ====.;; Weird sp
3b50: 65 63 69 61 6c 20 63 61 6c 6c 73 20 74 68 61 74 ecial calls that
3b60: 20 6e 65 65 64 20 74 6f 20 72 75 6e 20 2a 61 66 need to run *af
3b70: 74 65 72 2a 20 74 68 65 20 73 65 72 76 65 72 20 ter* the server
3b80: 68 61 73 20 73 74 61 72 74 65 64 3f 0a 3b 3b 3d has started?.;;=
3b90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3ba0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3bb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3bc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3bd0: 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 =====..(if (args
3be0: 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d :get-arg "-list-
3bf0: 74 61 72 67 65 74 73 22 29 0a 20 20 20 20 28 6c targets"). (l
3c00: 65 74 20 28 28 74 61 72 67 65 74 73 20 28 63 6f et ((targets (co
3c10: 6d 6d 6f 6e 3a 67 65 74 2d 72 75 6e 63 6f 6e 66 mmon:get-runconf
3c20: 69 67 2d 74 61 72 67 65 74 73 29 29 29 0a 20 20 ig-targets))).
3c30: 20 20 20 20 28 70 72 69 6e 74 20 22 46 6f 75 6e (print "Foun
3c40: 64 20 22 28 6c 65 6e 67 74 68 20 74 61 72 67 65 d "(length targe
3c50: 74 73 29 20 22 20 74 61 72 67 65 74 73 22 29 0a ts) " targets").
3c60: 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 (for-each
3c70: 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 20 20 (lambda (x)...
3c80: 3b 3b 20 28 70 72 69 6e 74 20 22 5b 22 20 78 20 ;; (print "[" x
3c90: 22 5d 22 29 29 0a 09 09 20 20 28 70 72 69 6e 74 "]"))... (print
3ca0: 20 78 29 29 0a 09 09 74 61 72 67 65 74 73 29 0a x))...targets).
3cb0: 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 (set! *did
3cc0: 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 something* #t)))
3cd0: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
3ce0: 61 72 67 20 22 2d 73 68 6f 77 2d 72 75 6e 63 6f arg "-show-runco
3cf0: 6e 66 69 67 22 29 0a 20 20 20 20 28 6c 65 74 2a nfig"). (let*
3d00: 20 28 28 74 61 72 67 65 74 20 28 69 66 20 28 61 ((target (if (a
3d10: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 rgs:get-arg "-re
3d20: 71 74 61 72 67 22 29 0a 09 09 20 20 20 20 20 20 qtarg")...
3d30: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
3d40: 2d 72 65 71 74 61 72 67 22 29 0a 09 09 20 20 20 -reqtarg")...
3d50: 20 20 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 (if (args:ge
3d60: 74 2d 61 72 67 20 22 2d 74 61 72 67 65 74 22 29 t-arg "-target")
3d70: 0a 09 09 09 20 20 20 28 61 72 67 73 3a 67 65 74 .... (args:get
3d80: 2d 61 72 67 20 22 2d 74 61 72 67 65 74 22 29 0a -arg "-target").
3d90: 09 09 09 20 20 20 23 66 29 29 29 0a 09 20 20 20 ... #f)))..
3da0: 28 73 65 63 74 69 6f 6e 73 20 28 69 66 20 74 61 (sections (if ta
3db0: 72 67 65 74 20 28 6c 69 73 74 20 22 64 65 66 61 rget (list "defa
3dc0: 75 6c 74 22 20 74 61 72 67 65 74 29 20 23 66 29 ult" target) #f)
3dd0: 29 0a 09 20 20 20 28 64 61 74 61 20 20 20 20 20 ).. (data
3de0: 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 22 72 75 (read-config "ru
3df0: 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 69 67 22 nconfigs.config"
3e00: 20 23 66 20 23 74 20 73 65 63 74 69 6f 6e 73 3a #f #t sections:
3e10: 20 73 65 63 74 69 6f 6e 73 29 29 29 0a 0a 20 20 sections)))..
3e20: 20 20 20 20 3b 3b 20 6b 65 65 70 20 74 68 69 73 ;; keep this
3e30: 20 6f 6e 65 20 6c 6f 63 61 6c 0a 20 20 20 20 20 one local.
3e40: 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 28 28 (cond. ((
3e50: 6e 6f 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 not (args:get-ar
3e60: 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 29 0a g "-dumpmode")).
3e70: 09 28 70 70 20 28 68 61 73 68 2d 74 61 62 6c 65 .(pp (hash-table
3e80: 2d 3e 61 6c 69 73 74 20 64 61 74 61 29 29 29 0a ->alist data))).
3e90: 20 20 20 20 20 20 20 28 28 73 74 72 69 6e 67 3d ((string=
3ea0: 3f 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ? (args:get-arg
3eb0: 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 6a 73 "-dumpmode") "js
3ec0: 6f 6e 22 29 0a 09 28 6a 73 6f 6e 2d 77 72 69 74 on")..(json-writ
3ed0: 65 20 64 61 74 61 29 29 0a 20 20 20 20 20 20 20 e data)).
3ee0: 28 65 6c 73 65 0a 09 28 64 65 62 75 67 3a 70 72 (else..(debug:pr
3ef0: 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 2d 64 int 0 "ERROR: -d
3f00: 75 6d 70 6d 6f 64 65 20 6f 66 20 22 20 28 61 72 umpmode of " (ar
3f10: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d gs:get-arg "-dum
3f20: 70 6d 6f 64 65 22 29 20 22 20 6e 6f 74 20 72 65 pmode") " not re
3f30: 63 6f 67 6e 69 73 65 64 22 29 29 29 0a 20 20 20 cognised"))).
3f40: 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d (set! *didsom
3f50: 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 ething* #t)))..(
3f60: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
3f70: 20 22 2d 73 68 6f 77 2d 63 6f 6e 66 69 67 22 29 "-show-config")
3f80: 0a 20 20 20 20 28 6c 65 74 20 28 28 64 61 74 61 . (let ((data
3f90: 20 2a 63 6f 6e 66 69 67 64 61 74 2a 29 29 20 3b *configdat*)) ;
3fa0: 3b 20 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 22 ; (read-config "
3fb0: 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 22 megatest.config"
3fc0: 20 23 66 20 23 74 29 29 29 0a 20 20 20 20 20 20 #f #t))).
3fd0: 3b 3b 20 6b 65 65 70 20 74 68 69 73 20 6f 6e 65 ;; keep this one
3fe0: 20 6c 6f 63 61 6c 0a 20 20 20 20 20 20 28 63 6f local. (co
3ff0: 6e 64 20 0a 20 20 20 20 20 20 20 28 28 6e 6f 74 nd . ((not
4000: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
4010: 2d 64 75 6d 70 6d 6f 64 65 22 29 29 0a 09 28 70 -dumpmode"))..(p
4020: 70 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 3e 61 p (hash-table->a
4030: 6c 69 73 74 20 64 61 74 61 29 29 29 0a 20 20 20 list data))).
4040: 20 20 20 20 28 28 73 74 72 69 6e 67 3d 3f 20 28 ((string=? (
4050: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 args:get-arg "-d
4060: 75 6d 70 6d 6f 64 65 22 29 20 22 6a 73 6f 6e 22 umpmode") "json"
4070: 29 0a 09 28 6a 73 6f 6e 2d 77 72 69 74 65 20 64 )..(json-write d
4080: 61 74 61 29 29 0a 20 20 20 20 20 20 20 28 65 6c ata)). (el
4090: 73 65 0a 09 28 64 65 62 75 67 3a 70 72 69 6e 74 se..(debug:print
40a0: 20 30 20 22 45 52 52 4f 52 3a 20 2d 64 75 6d 70 0 "ERROR: -dump
40b0: 6d 6f 64 65 20 6f 66 20 22 20 28 61 72 67 73 3a mode of " (args:
40c0: 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f get-arg "-dumpmo
40d0: 64 65 22 29 20 22 20 6e 6f 74 20 72 65 63 6f 67 de") " not recog
40e0: 6e 69 73 65 64 22 29 29 29 0a 20 20 20 20 20 20 nised"))).
40f0: 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
4100: 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d ing* #t)))..;;==
4110: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4120: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4130: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4140: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4150: 3d 3d 3d 3d 0a 3b 3b 20 52 65 6d 6f 76 65 20 6f ====.;; Remove o
4160: 6c 64 20 72 75 6e 28 73 29 0a 3b 3b 3d 3d 3d 3d ld run(s).;;====
4170: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4180: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4190: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
41a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
41b0: 3d 3d 0a 0a 3b 3b 20 73 69 6e 63 65 20 73 65 76 ==..;; since sev
41c0: 65 72 61 6c 20 61 63 74 69 6f 6e 73 20 63 61 6e eral actions can
41d0: 20 62 65 20 73 70 65 63 69 66 69 65 64 20 6f 6e be specified on
41e0: 20 74 68 65 20 63 6f 6d 6d 61 6e 64 20 6c 69 6e the command lin
41f0: 65 20 74 68 65 20 72 65 6d 6f 76 61 6c 0a 3b 3b e the removal.;;
4200: 20 69 73 20 64 6f 6e 65 20 66 69 72 73 74 0a 28 is done first.(
4210: 64 65 66 69 6e 65 20 28 6f 70 65 72 61 74 65 2d define (operate-
4220: 6f 6e 20 61 63 74 69 6f 6e 29 0a 20 20 28 63 6f on action). (co
4230: 6e 64 0a 20 20 20 28 28 6e 6f 74 20 28 61 72 67 nd. ((not (arg
4240: 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e s:get-arg ":runn
4250: 61 6d 65 22 29 29 0a 20 20 20 20 28 64 65 62 75 ame")). (debu
4260: 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 g:print 0 "ERROR
4270: 3a 20 4d 69 73 73 69 6e 67 20 72 65 71 75 69 72 : Missing requir
4280: 65 64 20 70 61 72 61 6d 65 74 65 72 20 66 6f 72 ed parameter for
4290: 20 22 20 61 63 74 69 6f 6e 20 22 2c 20 79 6f 75 " action ", you
42a0: 20 6d 75 73 74 20 73 70 65 63 69 66 79 20 74 68 must specify th
42b0: 65 20 72 75 6e 20 6e 61 6d 65 20 70 61 74 74 65 e run name patte
42c0: 72 6e 20 77 69 74 68 20 3a 72 75 6e 6e 61 6d 65 rn with :runname
42d0: 20 70 61 74 74 22 29 0a 20 20 20 20 28 65 78 69 patt"). (exi
42e0: 74 20 32 29 29 0a 20 20 20 28 28 6e 6f 74 20 28 t 2)). ((not (
42f0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 args:get-arg "-t
4300: 65 73 74 70 61 74 74 22 29 29 0a 20 20 20 20 28 estpatt")). (
4310: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 debug:print 0 "E
4320: 52 52 4f 52 3a 20 4d 69 73 73 69 6e 67 20 72 65 RROR: Missing re
4330: 71 75 69 72 65 64 20 70 61 72 61 6d 65 74 65 72 quired parameter
4340: 20 66 6f 72 20 22 20 61 63 74 69 6f 6e 20 22 2c for " action ",
4350: 20 79 6f 75 20 6d 75 73 74 20 73 70 65 63 69 66 you must specif
4360: 79 20 74 68 65 20 74 65 73 74 20 70 61 74 74 65 y the test patte
4370: 72 6e 20 77 69 74 68 20 2d 74 65 73 74 70 61 74 rn with -testpat
4380: 74 22 29 0a 20 20 20 20 28 65 78 69 74 20 33 29 t"). (exit 3)
4390: 29 0a 20 20 20 28 65 6c 73 65 0a 20 20 20 20 28 ). (else. (
43a0: 69 66 20 28 6e 6f 74 20 28 63 61 72 20 2a 63 6f if (not (car *co
43b0: 6e 66 69 67 69 6e 66 6f 2a 29 29 0a 09 28 62 65 nfiginfo*))..(be
43c0: 67 69 6e 0a 09 20 20 28 64 65 62 75 67 3a 70 72 gin.. (debug:pr
43d0: 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 41 74 int 0 "ERROR: At
43e0: 74 65 6d 70 74 65 64 20 22 20 61 63 74 69 6f 6e tempted " action
43f0: 20 22 6f 6e 20 74 65 73 74 28 73 29 20 62 75 74 "on test(s) but
4400: 20 72 75 6e 20 61 72 65 61 20 63 6f 6e 66 69 67 run area config
4410: 20 66 69 6c 65 20 6e 6f 74 20 66 6f 75 6e 64 22 file not found"
4420: 29 0a 09 20 20 28 65 78 69 74 20 31 29 29 0a 09 ).. (exit 1))..
4430: 3b 3b 20 70 75 74 20 74 65 73 74 20 70 61 72 61 ;; put test para
4440: 6d 65 74 65 72 73 20 69 6e 74 6f 20 63 6f 6e 76 meters into conv
4450: 65 6e 69 65 6e 74 20 76 61 72 69 61 62 6c 65 73 enient variables
4460: 0a 09 28 72 75 6e 73 3a 6f 70 65 72 61 74 65 2d ..(runs:operate-
4470: 6f 6e 20 20 61 63 74 69 6f 6e 0a 09 09 09 20 20 on action....
4480: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a (args:get-arg ":
4490: 72 75 6e 6e 61 6d 65 22 29 0a 09 09 09 20 20 28 runname").... (
44a0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 args:get-arg "-t
44b0: 65 73 74 70 61 74 74 22 29 0a 09 09 09 20 20 73 estpatt").... s
44c0: 74 61 74 65 3a 20 28 61 72 67 73 3a 67 65 74 2d tate: (args:get-
44d0: 61 72 67 20 22 3a 73 74 61 74 65 22 29 20 0a 09 arg ":state") ..
44e0: 09 09 20 20 73 74 61 74 75 73 3a 20 28 61 72 67 .. status: (arg
44f0: 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 s:get-arg ":stat
4500: 75 73 22 29 0a 09 09 09 20 20 6e 65 77 2d 73 74 us").... new-st
4510: 61 74 65 2d 73 74 61 74 75 73 3a 20 28 61 72 67 ate-status: (arg
4520: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d s:get-arg "-set-
4530: 73 74 61 74 65 2d 73 74 61 74 75 73 22 29 29 29 state-status")))
4540: 0a 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 . (set! *dids
4550: 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 29 omething* #t))))
4560: 0a 09 20 20 0a 28 69 66 20 28 61 72 67 73 3a 67 .. .(if (args:g
4570: 65 74 2d 61 72 67 20 22 2d 72 65 6d 6f 76 65 2d et-arg "-remove-
4580: 72 75 6e 73 22 29 0a 20 20 20 20 28 67 65 6e 65 runs"). (gene
4590: 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 ral-run-call .
45a0: 20 20 20 22 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 "-remove-runs
45b0: 22 0a 20 20 20 20 20 22 72 65 6d 6f 76 65 20 72 ". "remove r
45c0: 75 6e 73 22 0a 20 20 20 20 20 28 6c 61 6d 62 64 uns". (lambd
45d0: 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e 61 6d a (target runnam
45e0: 65 20 6b 65 79 73 20 6b 65 79 6e 61 6d 65 73 20 e keys keynames
45f0: 6b 65 79 76 61 6c 6c 73 74 29 0a 20 20 20 20 20 keyvallst).
4600: 20 20 28 6f 70 65 72 61 74 65 2d 6f 6e 20 27 72 (operate-on 'r
4610: 65 6d 6f 76 65 2d 72 75 6e 73 29 29 29 29 0a 0a emove-runs))))..
4620: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
4630: 67 20 22 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 g "-set-state-st
4640: 61 74 75 73 22 29 0a 20 20 20 20 28 67 65 6e 65 atus"). (gene
4650: 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 ral-run-call .
4660: 20 20 20 22 2d 73 65 74 2d 73 74 61 74 65 2d 73 "-set-state-s
4670: 74 61 74 75 73 22 0a 20 20 20 20 20 22 73 65 74 tatus". "set
4680: 20 73 74 61 74 65 20 61 6e 64 20 73 74 61 74 75 state and statu
4690: 73 22 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 s". (lambda
46a0: 28 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 (target runname
46b0: 6b 65 79 73 20 6b 65 79 6e 61 6d 65 73 20 6b 65 keys keynames ke
46c0: 79 76 61 6c 6c 73 74 29 0a 20 20 20 20 20 20 20 yvallst).
46d0: 28 6f 70 65 72 61 74 65 2d 6f 6e 20 27 73 65 74 (operate-on 'set
46e0: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 29 29 29 -state-status)))
46f0: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
4700: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4710: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4720: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4730: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 51 ===========.;; Q
4740: 75 65 72 79 20 72 75 6e 73 0a 3b 3b 3d 3d 3d 3d uery runs.;;====
4750: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4760: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4770: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4780: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4790: 3d 3d 0a 0a 28 69 66 20 28 6f 72 20 28 61 72 67 ==..(if (or (arg
47a0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 s:get-arg "-list
47b0: 2d 72 75 6e 73 22 29 0a 09 28 61 72 67 73 3a 67 -runs")..(args:g
47c0: 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d 64 62 et-arg "-list-db
47d0: 2d 74 61 72 67 65 74 73 22 29 29 0a 20 20 20 20 -targets")).
47e0: 28 69 66 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 (if (setup-for-r
47f0: 75 6e 29 0a 09 28 6c 65 74 2a 20 28 28 64 62 20 un)..(let* ((db
4800: 20 20 20 20 20 20 23 66 29 0a 09 20 20 20 20 20 #f)..
4810: 20 20 28 72 75 6e 70 61 74 74 20 20 28 61 72 67 (runpatt (arg
4820: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 s:get-arg "-list
4830: 2d 72 75 6e 73 22 29 29 0a 09 20 20 20 20 20 20 -runs"))..
4840: 20 28 74 65 73 74 70 61 74 74 20 28 69 66 20 28 (testpatt (if (
4850: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 args:get-arg "-t
4860: 65 73 74 70 61 74 74 22 29 20 0a 09 09 09 20 20 estpatt") ....
4870: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
4880: 20 22 2d 74 65 73 74 70 61 74 74 22 29 20 0a 09 "-testpatt") ..
4890: 09 09 20 20 20 20 20 22 25 22 29 29 0a 09 20 20 .. "%"))..
48a0: 20 20 20 20 20 28 72 75 6e 73 64 61 74 20 20 28 (runsdat (
48b0: 63 64 62 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 64 cdb:remote-run d
48c0: 62 3a 67 65 74 2d 72 75 6e 73 20 23 66 20 72 75 b:get-runs #f ru
48d0: 6e 70 61 74 74 20 23 66 20 23 66 20 27 28 29 29 npatt #f #f '())
48e0: 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 73 20 ).. (runs
48f0: 20 20 20 20 28 64 62 3a 67 65 74 2d 72 6f 77 73 (db:get-rows
4900: 20 72 75 6e 73 64 61 74 29 29 0a 09 20 20 20 20 runsdat))..
4910: 20 20 20 28 68 65 61 64 65 72 20 20 20 28 64 62 (header (db
4920: 3a 67 65 74 2d 68 65 61 64 65 72 20 72 75 6e 73 :get-header runs
4930: 64 61 74 29 29 0a 09 20 20 20 20 20 20 20 28 6b dat)).. (k
4940: 65 79 73 20 20 20 20 20 28 63 64 62 3a 72 65 6d eys (cdb:rem
4950: 6f 74 65 2d 72 75 6e 20 64 62 3a 67 65 74 2d 6b ote-run db:get-k
4960: 65 79 73 20 23 66 29 29 0a 09 20 20 20 20 20 20 eys #f))..
4970: 20 28 6b 65 79 6e 61 6d 65 73 20 28 6d 61 70 20 (keynames (map
4980: 6b 65 79 3a 67 65 74 2d 66 69 65 6c 64 6e 61 6d key:get-fieldnam
4990: 65 20 6b 65 79 73 29 29 0a 09 20 20 20 20 20 20 e keys))..
49a0: 20 28 64 62 2d 74 61 72 67 65 74 73 20 28 61 72 (db-targets (ar
49b0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 gs:get-arg "-lis
49c0: 74 2d 64 62 2d 74 61 72 67 65 74 73 22 29 29 0a t-db-targets")).
49d0: 09 20 20 20 20 20 20 20 28 73 65 65 6e 20 20 20 . (seen
49e0: 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 (make-hash-tab
49f0: 6c 65 29 29 29 0a 09 20 20 3b 3b 20 45 61 63 68 le))).. ;; Each
4a00: 20 72 75 6e 0a 09 20 20 28 66 6f 72 2d 65 61 63 run.. (for-eac
4a10: 68 20 0a 09 20 20 20 28 6c 61 6d 62 64 61 20 28 h .. (lambda (
4a20: 72 75 6e 29 0a 09 20 20 20 20 20 28 6c 65 74 20 run).. (let
4a30: 28 28 74 61 72 67 65 74 73 74 72 20 28 73 74 72 ((targetstr (str
4a40: 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 ing-intersperse
4a50: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 78 29 (map (lambda (x)
4a60: 0a 09 09 09 09 09 09 09 20 28 64 62 3a 67 65 74 ........ (db:get
4a70: 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 -value-by-header
4a80: 20 72 75 6e 20 68 65 61 64 65 72 20 78 29 29 0a run header x)).
4a90: 09 09 09 09 09 09 20 20 20 20 20 20 20 6b 65 79 ...... key
4aa0: 6e 61 6d 65 73 29 20 22 2f 22 29 29 29 0a 09 20 names) "/")))..
4ab0: 20 20 20 20 20 20 28 69 66 20 64 62 2d 74 61 72 (if db-tar
4ac0: 67 65 74 73 0a 09 09 20 20 20 28 69 66 20 28 6e gets... (if (n
4ad0: 6f 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 ot (hash-table-r
4ae0: 65 66 2f 64 65 66 61 75 6c 74 20 73 65 65 6e 20 ef/default seen
4af0: 74 61 72 67 65 74 73 74 72 20 23 66 29 29 0a 09 targetstr #f))..
4b00: 09 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 . (begin..
4b10: 09 09 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 .. (hash-table-s
4b20: 65 74 21 20 73 65 65 6e 20 74 61 72 67 65 74 73 et! seen targets
4b30: 74 72 20 23 74 29 0a 09 09 09 20 3b 3b 20 28 70 tr #t).... ;; (p
4b40: 72 69 6e 74 20 22 5b 22 20 74 61 72 67 65 74 73 rint "[" targets
4b50: 74 72 20 22 5d 22 29 29 29 29 0a 09 09 09 20 28 tr "]")))).... (
4b60: 70 72 69 6e 74 20 74 61 72 67 65 74 73 74 72 29 print targetstr)
4b70: 29 29 29 0a 09 20 20 20 20 20 20 20 28 69 66 20 ))).. (if
4b80: 28 6e 6f 74 20 64 62 2d 74 61 72 67 65 74 73 29 (not db-targets)
4b90: 0a 09 09 20 20 20 28 6c 65 74 2a 20 28 28 72 75 ... (let* ((ru
4ba0: 6e 2d 69 64 20 28 64 62 3a 67 65 74 2d 76 61 6c n-id (db:get-val
4bb0: 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e ue-by-header run
4bc0: 20 68 65 61 64 65 72 20 22 69 64 22 29 29 0a 09 header "id"))..
4bd0: 09 09 20 20 28 74 65 73 74 73 20 20 28 63 64 62 .. (tests (cdb
4be0: 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 64 62 3a 67 :remote-run db:g
4bf0: 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e et-tests-for-run
4c00: 20 23 66 20 72 75 6e 2d 69 64 20 74 65 73 74 70 #f run-id testp
4c10: 61 74 74 20 27 28 29 20 27 28 29 29 29 29 0a 09 att '() '())))..
4c20: 09 20 20 20 20 20 28 70 72 69 6e 74 20 22 52 75 . (print "Ru
4c30: 6e 3a 20 22 20 74 61 72 67 65 74 73 74 72 20 22 n: " targetstr "
4c40: 2f 22 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 /" (db:get-value
4c50: 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 -by-header run h
4c60: 65 61 64 65 72 20 22 72 75 6e 6e 61 6d 65 22 29 eader "runname")
4c70: 20 0a 09 09 09 20 20 20 20 22 20 73 74 61 74 75 .... " statu
4c80: 73 3a 20 22 20 28 64 62 3a 67 65 74 2d 76 61 6c s: " (db:get-val
4c90: 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e ue-by-header run
4ca0: 20 68 65 61 64 65 72 20 22 73 74 61 74 65 22 29 header "state")
4cb0: 0a 09 09 09 20 20 20 20 22 20 72 75 6e 2d 69 64 .... " run-id
4cc0: 3a 20 22 20 72 75 6e 2d 69 64 20 22 2c 20 6e 75 : " run-id ", nu
4cd0: 6d 62 65 72 20 74 65 73 74 73 3a 20 22 20 28 6c mber tests: " (l
4ce0: 65 6e 67 74 68 20 74 65 73 74 73 29 29 0a 09 09 ength tests))...
4cf0: 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a (for-each .
4d00: 09 09 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 .. (lambda
4d10: 28 74 65 73 74 29 0a 09 09 09 28 66 6f 72 6d 61 (test)....(forma
4d20: 74 20 23 74 0a 09 09 09 09 22 20 20 54 65 73 74 t #t....." Test
4d30: 3a 20 7e 32 35 61 20 53 74 61 74 65 3a 20 7e 31 : ~25a State: ~1
4d40: 35 61 20 53 74 61 74 75 73 3a 20 7e 31 35 61 20 5a Status: ~15a
4d50: 52 75 6e 74 69 6d 65 3a 20 7e 35 40 61 73 20 54 Runtime: ~5@as T
4d60: 69 6d 65 3a 20 7e 32 32 61 20 48 6f 73 74 3a 20 ime: ~22a Host:
4d70: 7e 31 30 61 5c 6e 22 0a 09 09 09 09 28 63 6f 6e ~10a\n".....(con
4d80: 63 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 74 c (db:test-get-t
4d90: 65 73 74 6e 61 6d 65 20 74 65 73 74 29 0a 09 09 estname test)...
4da0: 09 09 20 20 20 20 20 20 28 69 66 20 28 65 71 75 .. (if (equ
4db0: 61 6c 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 74 al? (db:test-get
4dc0: 2d 69 74 65 6d 2d 70 61 74 68 20 74 65 73 74 29 -item-path test)
4dd0: 20 22 22 29 0a 09 09 09 09 09 20 20 22 22 20 0a "")...... "" .
4de0: 09 09 09 09 09 20 20 28 63 6f 6e 63 20 22 28 22 ..... (conc "("
4df0: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 74 (db:test-get-it
4e00: 65 6d 2d 70 61 74 68 20 74 65 73 74 29 20 22 29 em-path test) ")
4e10: 22 29 29 29 0a 09 09 09 09 28 64 62 3a 74 65 73 "))).....(db:tes
4e20: 74 2d 67 65 74 2d 73 74 61 74 65 20 74 65 73 74 t-get-state test
4e30: 29 0a 09 09 09 09 28 64 62 3a 74 65 73 74 2d 67 ).....(db:test-g
4e40: 65 74 2d 73 74 61 74 75 73 20 74 65 73 74 29 0a et-status test).
4e50: 09 09 09 09 28 64 62 3a 74 65 73 74 2d 67 65 74 ....(db:test-get
4e60: 2d 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 74 65 -run_duration te
4e70: 73 74 29 0a 09 09 09 09 28 64 62 3a 74 65 73 74 st).....(db:test
4e80: 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 -get-event_time
4e90: 74 65 73 74 29 0a 09 09 09 09 28 64 62 3a 74 65 test).....(db:te
4ea0: 73 74 2d 67 65 74 2d 68 6f 73 74 20 74 65 73 74 st-get-host test
4eb0: 29 29 0a 09 09 09 28 69 66 20 28 6e 6f 74 20 28 ))....(if (not (
4ec0: 6f 72 20 28 65 71 75 61 6c 3f 20 28 64 62 3a 74 or (equal? (db:t
4ed0: 65 73 74 2d 67 65 74 2d 73 74 61 74 75 73 20 74 est-get-status t
4ee0: 65 73 74 29 20 22 50 41 53 53 22 29 0a 09 09 09 est) "PASS")....
4ef0: 09 20 20 20 20 20 28 65 71 75 61 6c 3f 20 28 64 . (equal? (d
4f00: 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 75 b:test-get-statu
4f10: 73 20 74 65 73 74 29 20 22 57 41 52 4e 22 29 0a s test) "WARN").
4f20: 09 09 09 09 20 20 20 20 20 28 65 71 75 61 6c 3f .... (equal?
4f30: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 (db:test-get-st
4f40: 61 74 65 20 74 65 73 74 29 20 20 22 4e 4f 54 5f ate test) "NOT_
4f50: 53 54 41 52 54 45 44 22 29 29 29 0a 09 09 09 20 STARTED")))....
4f60: 20 20 20 28 62 65 67 69 6e 0a 09 09 09 20 20 20 (begin....
4f70: 20 20 20 28 70 72 69 6e 74 20 22 20 20 20 20 20 (print "
4f80: 20 20 20 20 63 70 75 6c 6f 61 64 3a 20 20 22 20 cpuload: "
4f90: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 63 70 75 (db:test-get-cpu
4fa0: 6c 6f 61 64 20 74 65 73 74 29 0a 09 09 09 09 20 load test).....
4fb0: 20 20 20 20 22 5c 6e 20 20 20 20 20 20 20 20 20 "\n
4fc0: 64 69 73 6b 66 72 65 65 3a 20 22 20 28 64 62 3a diskfree: " (db:
4fd0: 74 65 73 74 2d 67 65 74 2d 64 69 73 6b 66 72 65 test-get-diskfre
4fe0: 65 20 74 65 73 74 29 0a 09 09 09 09 20 20 20 20 e test).....
4ff0: 20 22 5c 6e 20 20 20 20 20 20 20 20 20 75 6e 61 "\n una
5000: 6d 65 3a 20 20 20 20 22 20 28 64 62 3a 74 65 73 me: " (db:tes
5010: 74 2d 67 65 74 2d 75 6e 61 6d 65 20 74 65 73 74 t-get-uname test
5020: 29 0a 09 09 09 09 20 20 20 20 20 22 5c 6e 20 20 )..... "\n
5030: 20 20 20 20 20 20 20 72 75 6e 64 69 72 3a 20 20 rundir:
5040: 20 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d " (db:test-get-
5050: 72 75 6e 64 69 72 20 74 65 73 74 29 0a 09 09 09 rundir test)....
5060: 09 20 20 20 20 20 29 0a 09 09 09 20 20 20 20 20 . )....
5070: 20 3b 3b 20 45 61 63 68 20 74 65 73 74 0a 09 09 ;; Each test...
5080: 09 20 20 20 20 20 20 3b 3b 20 44 4f 20 4e 4f 54 . ;; DO NOT
5090: 20 72 65 6d 6f 74 65 20 72 75 6e 0a 09 09 09 20 remote run....
50a0: 20 20 20 20 20 28 6c 65 74 20 28 28 73 74 65 70 (let ((step
50b0: 73 20 28 64 62 3a 67 65 74 2d 73 74 65 70 73 2d s (db:get-steps-
50c0: 66 6f 72 2d 74 65 73 74 20 23 66 20 28 64 62 3a for-test #f (db:
50d0: 74 65 73 74 2d 67 65 74 2d 69 64 20 74 65 73 74 test-get-id test
50e0: 29 29 29 29 0a 09 09 09 09 28 66 6f 72 2d 65 61 )))).....(for-ea
50f0: 63 68 20 0a 09 09 09 09 20 28 6c 61 6d 62 64 61 ch ..... (lambda
5100: 20 28 73 74 65 70 29 0a 09 09 09 09 20 20 20 28 (step)..... (
5110: 66 6f 72 6d 61 74 20 23 74 20 0a 09 09 09 09 09 format #t ......
5120: 20 20 20 22 20 20 20 20 53 74 65 70 3a 20 7e 32 " Step: ~2
5130: 30 61 20 53 74 61 74 65 3a 20 7e 31 30 61 20 53 0a State: ~10a S
5140: 74 61 74 75 73 3a 20 7e 31 30 61 20 54 69 6d 65 tatus: ~10a Time
5150: 20 7e 32 32 61 5c 6e 22 0a 09 09 09 09 09 20 20 ~22a\n"......
5160: 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 (db:step-get-st
5170: 65 70 6e 61 6d 65 20 73 74 65 70 29 0a 09 09 09 epname step)....
5180: 09 09 20 20 20 28 64 62 3a 73 74 65 70 2d 67 65 .. (db:step-ge
5190: 74 2d 73 74 61 74 65 20 73 74 65 70 29 0a 09 09 t-state step)...
51a0: 09 09 09 20 20 20 28 64 62 3a 73 74 65 70 2d 67 ... (db:step-g
51b0: 65 74 2d 73 74 61 74 75 73 20 73 74 65 70 29 0a et-status step).
51c0: 09 09 09 09 09 20 20 20 28 64 62 3a 73 74 65 70 ..... (db:step
51d0: 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 -get-event_time
51e0: 73 74 65 70 29 29 29 0a 09 09 09 09 20 73 74 65 step)))..... ste
51f0: 70 73 29 29 29 29 29 0a 09 09 20 20 20 20 20 20 ps)))))...
5200: 74 65 73 74 73 29 29 29 29 29 0a 09 20 20 20 20 tests)))))..
5210: 20 72 75 6e 73 29 0a 09 20 20 20 28 73 65 74 21 runs).. (set!
5220: 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 *didsomething*
5230: 23 74 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d #t))))..;;======
5240: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5250: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5270: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5280: 0a 3b 3b 20 66 75 6c 6c 20 72 75 6e 0a 3b 3b 3d .;; full run.;;=
5290: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
52a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
52b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
52c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
52d0: 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 67 65 74 20 6c 6f =====..;; get lo
52e0: 63 6b 20 69 6e 20 64 62 20 66 6f 72 20 66 75 6c ck in db for ful
52f0: 6c 20 72 75 6e 20 66 6f 72 20 74 68 69 73 20 64 l run for this d
5300: 69 72 65 63 74 6f 72 79 0a 3b 3b 20 66 6f 72 20 irectory.;; for
5310: 61 6c 6c 20 74 65 73 74 73 20 77 69 74 68 20 64 all tests with d
5320: 65 70 73 0a 3b 3b 20 20 20 77 61 6c 6b 20 74 72 eps.;; walk tr
5330: 65 65 20 6f 66 20 74 65 73 74 73 20 74 6f 20 66 ee of tests to f
5340: 69 6e 64 20 68 65 61 64 20 74 61 73 6b 73 0a 3b ind head tasks.;
5350: 3b 20 20 20 61 64 64 20 68 65 61 64 20 74 61 73 ; add head tas
5360: 6b 73 20 74 6f 20 74 61 73 6b 20 71 75 65 75 65 ks to task queue
5370: 0a 3b 3b 20 20 20 61 64 64 20 64 65 70 65 6e 64 .;; add depend
5380: 61 6e 74 20 74 61 73 6b 73 20 74 6f 20 74 61 73 ant tasks to tas
5390: 6b 20 71 75 65 75 65 20 0a 3b 3b 20 20 20 61 64 k queue .;; ad
53a0: 64 20 72 65 6d 61 69 6e 69 6e 67 20 74 61 73 6b d remaining task
53b0: 73 20 74 6f 20 74 61 73 6b 20 71 75 65 75 65 0a s to task queue.
53c0: 3b 3b 20 66 6f 72 20 65 61 63 68 20 74 61 73 6b ;; for each task
53d0: 20 69 6e 20 74 61 73 6b 20 71 75 65 75 65 0a 3b in task queue.;
53e0: 3b 20 20 20 69 66 20 68 61 76 65 20 61 64 65 71 ; if have adeq
53f0: 75 61 74 65 20 72 65 73 6f 75 72 63 65 73 0a 3b uate resources.;
5400: 3b 20 20 20 20 20 6c 61 75 6e 63 68 20 74 61 73 ; launch tas
5410: 6b 0a 3b 3b 20 20 20 65 6c 73 65 0a 3b 3b 20 20 k.;; else.;;
5420: 20 20 20 70 75 74 20 74 61 73 6b 20 69 6e 20 64 put task in d
5430: 65 66 65 72 72 65 64 20 71 75 65 75 65 0a 3b 3b eferred queue.;;
5440: 20 69 66 20 73 74 69 6c 6c 20 6f 6b 20 74 6f 20 if still ok to
5450: 72 75 6e 20 74 61 73 6b 73 0a 3b 3b 20 20 20 70 run tasks.;; p
5460: 72 6f 63 65 73 73 20 64 65 66 65 72 72 65 64 20 rocess deferred
5470: 74 61 73 6b 73 20 70 65 72 20 61 62 6f 76 65 20 tasks per above
5480: 73 74 65 70 73 0a 0a 3b 3b 20 72 75 6e 20 61 6c steps..;; run al
5490: 6c 20 74 65 73 74 73 20 61 72 65 20 61 72 65 20 l tests are are
54a0: 4e 6f 74 20 43 4f 4d 50 4c 45 54 45 44 20 61 6e Not COMPLETED an
54b0: 64 20 50 41 53 53 20 6f 72 20 43 48 45 43 4b 0a d PASS or CHECK.
54c0: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
54d0: 67 20 22 2d 72 75 6e 61 6c 6c 22 29 0a 20 20 20 g "-runall").
54e0: 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 (general-run-ca
54f0: 6c 6c 20 0a 20 20 20 20 20 22 2d 72 75 6e 61 6c ll . "-runal
5500: 6c 22 0a 20 20 20 20 20 22 72 75 6e 20 61 6c 6c l". "run all
5510: 20 74 65 73 74 73 22 0a 20 20 20 20 20 28 6c 61 tests". (la
5520: 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 75 6e mbda (target run
5530: 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 6e 61 6d name keys keynam
5540: 65 73 20 6b 65 79 76 61 6c 6c 73 74 29 0a 20 20 es keyvallst).
5550: 20 20 20 20 20 28 72 75 6e 73 3a 72 75 6e 2d 74 (runs:run-t
5560: 65 73 74 73 20 74 61 72 67 65 74 0a 09 09 20 20 ests target...
5570: 20 20 20 20 20 72 75 6e 6e 61 6d 65 0a 09 09 20 runname...
5580: 20 20 20 20 20 20 22 25 22 0a 09 09 20 20 20 20 "%"...
5590: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
55a0: 20 22 2d 74 65 73 74 70 61 74 74 22 29 0a 09 09 "-testpatt")...
55b0: 20 20 20 20 20 20 20 75 73 65 72 0a 09 09 20 20 user...
55c0: 20 20 20 20 20 61 72 67 73 3a 61 72 67 2d 68 61 args:arg-ha
55d0: 73 68 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d sh))))..;;======
55e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
55f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5600: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5610: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5620: 0a 3b 3b 20 72 75 6e 20 6f 6e 65 20 74 65 73 74 .;; run one test
5630: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
5640: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5650: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5660: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5670: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 31 2e =========..;; 1.
5680: 20 66 69 6e 64 20 74 68 65 20 63 6f 6e 66 69 67 find the config
5690: 20 66 69 6c 65 0a 3b 3b 20 32 2e 20 63 68 61 6e file.;; 2. chan
56a0: 67 65 20 74 6f 20 74 68 65 20 74 65 73 74 20 64 ge to the test d
56b0: 69 72 65 63 74 6f 72 79 0a 3b 3b 20 33 2e 20 75 irectory.;; 3. u
56c0: 70 64 61 74 65 20 74 68 65 20 64 62 20 77 69 74 pdate the db wit
56d0: 68 20 22 74 65 73 74 20 73 74 61 72 74 65 64 22 h "test started"
56e0: 20 73 74 61 74 75 73 2c 20 73 65 74 20 72 75 6e status, set run
56f0: 6e 69 6e 67 20 68 6f 73 74 0a 3b 3b 20 34 2e 20 ning host.;; 4.
5700: 70 72 6f 63 65 73 73 20 6c 61 75 6e 63 68 20 74 process launch t
5710: 68 65 20 74 65 73 74 0a 3b 3b 20 20 20 20 2d 20 he test.;; -
5720: 6d 6f 6e 69 74 6f 72 20 74 68 65 20 70 72 6f 63 monitor the proc
5730: 65 73 73 2c 20 75 70 64 61 74 65 20 73 74 61 74 ess, update stat
5740: 73 20 69 6e 20 74 68 65 20 64 62 20 65 76 65 72 s in the db ever
5750: 79 20 32 5e 6e 20 6d 69 6e 75 74 65 73 0a 3b 3b y 2^n minutes.;;
5760: 20 35 2e 20 61 73 20 74 68 65 20 74 65 73 74 20 5. as the test
5770: 70 72 6f 63 65 65 64 73 20 69 6e 74 65 72 6e 61 proceeds interna
5780: 6c 6c 79 20 69 74 20 63 61 6c 6c 73 20 6d 65 67 lly it calls meg
5790: 61 74 65 73 74 20 61 73 20 65 61 63 68 20 73 74 atest as each st
57a0: 65 70 20 69 73 0a 3b 3b 20 20 20 20 73 74 61 72 ep is.;; star
57b0: 74 65 64 20 61 6e 64 20 63 6f 6d 70 6c 65 74 65 ted and complete
57c0: 64 0a 3b 3b 20 20 20 20 2d 20 73 74 65 70 20 73 d.;; - step s
57d0: 74 61 72 74 65 64 2c 20 74 69 6d 65 73 74 61 6d tarted, timestam
57e0: 70 0a 3b 3b 20 20 20 20 2d 20 73 74 65 70 20 63 p.;; - step c
57f0: 6f 6d 70 6c 65 74 65 64 2c 20 65 78 69 74 20 73 ompleted, exit s
5800: 74 61 74 75 73 2c 20 74 69 6d 65 73 74 61 6d 70 tatus, timestamp
5810: 0a 3b 3b 20 36 2e 20 74 65 73 74 20 70 68 6f 6e .;; 6. test phon
5820: 65 20 68 6f 6d 65 0a 3b 3b 20 20 20 20 2d 20 69 e home.;; - i
5830: 66 20 74 65 73 74 20 72 75 6e 20 74 69 6d 65 20 f test run time
5840: 3e 20 61 6c 6c 6f 77 65 64 20 72 75 6e 20 74 69 > allowed run ti
5850: 6d 65 20 74 68 65 6e 20 6b 69 6c 6c 20 6a 6f 62 me then kill job
5860: 0a 3b 3b 20 20 20 20 2d 20 69 66 20 63 61 6e 6e .;; - if cann
5870: 6f 74 20 61 63 63 65 73 73 20 64 62 20 3e 20 61 ot access db > a
5880: 6c 6c 6f 77 65 64 20 64 69 73 63 6f 6e 6e 65 63 llowed disconnec
5890: 74 20 74 69 6d 65 20 74 68 65 6e 20 6b 69 6c 6c t time then kill
58a0: 20 6a 6f 62 0a 0a 28 69 66 20 28 61 72 67 73 3a job..(if (args:
58b0: 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 get-arg "-runtes
58c0: 74 73 22 29 0a 20 20 28 67 65 6e 65 72 61 6c 2d ts"). (general-
58d0: 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 22 2d 72 run-call . "-r
58e0: 75 6e 74 65 73 74 73 22 20 0a 20 20 20 22 72 75 untests" . "ru
58f0: 6e 20 61 20 74 65 73 74 22 20 0a 20 20 20 28 6c n a test" . (l
5900: 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 75 ambda (target ru
5910: 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 6e 61 nname keys keyna
5920: 6d 65 73 20 6b 65 79 76 61 6c 6c 73 74 29 0a 20 mes keyvallst).
5930: 20 20 20 20 28 72 75 6e 73 3a 72 75 6e 2d 74 65 (runs:run-te
5940: 73 74 73 20 74 61 72 67 65 74 0a 09 09 20 20 20 sts target...
5950: 20 20 72 75 6e 6e 61 6d 65 0a 09 09 20 20 20 20 runname...
5960: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
5970: 2d 72 75 6e 74 65 73 74 73 22 29 0a 09 09 20 20 -runtests")...
5980: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
5990: 20 22 2d 74 65 73 74 70 61 74 74 22 29 0a 09 09 "-testpatt")...
59a0: 20 20 20 20 20 75 73 65 72 0a 09 09 20 20 20 20 user...
59b0: 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 29 29 args:arg-hash))
59c0: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
59d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
59e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
59f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5a00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
5a10: 52 6f 6c 6c 75 70 20 69 6e 74 6f 20 61 20 72 75 Rollup into a ru
5a20: 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d n.;;============
5a30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5a40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5a50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5a60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 ==========..(if
5a70: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
5a80: 72 6f 6c 6c 75 70 22 29 0a 20 20 20 20 28 62 65 rollup"). (be
5a90: 67 69 6e 0a 20 20 20 20 20 20 28 64 65 62 75 67 gin. (debug
5aa0: 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a :print 0 "ERROR:
5ab0: 20 52 6f 6c 6c 75 70 20 69 73 20 63 75 72 72 65 Rollup is curre
5ac0: 6e 74 6c 79 20 6e 6f 74 20 77 6f 72 6b 69 6e 67 ntly not working
5ad0: 2e 20 49 66 20 79 6f 75 20 6e 65 65 64 20 69 74 . If you need it
5ae0: 20 70 6c 65 61 73 65 20 73 75 62 6d 69 74 20 61 please submit a
5af0: 20 74 69 63 6b 65 74 20 61 74 20 68 74 74 70 3a ticket at http:
5b00: 2f 2f 77 77 77 2e 6b 69 61 74 6f 61 2e 63 6f 6d //www.kiatoa.com
5b10: 2f 66 6f 73 73 69 6c 73 2f 6d 65 67 61 74 65 73 /fossils/megates
5b20: 74 22 29 0a 20 20 20 20 20 20 28 65 78 69 74 20 t"). (exit
5b30: 34 29 29 29 0a 3b 3b 20 20 20 20 20 28 67 65 6e 4))).;; (gen
5b40: 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 3b eral-run-call .;
5b50: 3b 20 20 20 20 20 20 22 2d 72 6f 6c 6c 75 70 22 ; "-rollup"
5b60: 20 0a 3b 3b 20 20 20 20 20 20 22 72 6f 6c 6c 75 .;; "rollu
5b70: 70 20 74 65 73 74 73 22 20 0a 3b 3b 20 20 20 20 p tests" .;;
5b80: 20 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 (lambda (targe
5b90: 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b t runname keys k
5ba0: 65 79 6e 61 6d 65 73 20 6b 65 79 76 61 6c 6c 73 eynames keyvalls
5bb0: 74 29 0a 3b 3b 20 20 20 20 20 20 20 20 28 72 75 t).;; (ru
5bc0: 6e 73 3a 72 6f 6c 6c 75 70 2d 72 75 6e 20 6b 65 ns:rollup-run ke
5bd0: 79 73 0a 3b 3b 20 09 09 09 28 6b 65 79 73 2d 3e ys.;; ...(keys->
5be0: 61 6c 69 73 74 20 6b 65 79 73 20 22 6e 61 22 29 alist keys "na")
5bf0: 0a 3b 3b 20 09 09 09 28 61 72 67 73 3a 67 65 74 .;; ...(args:get
5c00: 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 -arg ":runname")
5c10: 20 0a 3b 3b 20 09 09 09 75 73 65 72 29 29 29 29 .;; ...user))))
5c20: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
5c30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5c40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5c50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5c60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4c 6f ==========.;; Lo
5c70: 63 6b 20 6f 72 20 75 6e 6c 6f 63 6b 20 61 20 72 ck or unlock a r
5c80: 75 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d un.;;===========
5c90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5ca0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5cb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5cc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 ===========..(if
5cd0: 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 (or (args:get-a
5ce0: 72 67 20 22 2d 6c 6f 63 6b 22 29 28 61 72 67 73 rg "-lock")(args
5cf0: 3a 67 65 74 2d 61 72 67 20 22 2d 75 6e 6c 6f 63 :get-arg "-unloc
5d00: 6b 22 29 29 0a 20 20 20 20 28 67 65 6e 65 72 61 k")). (genera
5d10: 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 l-run-call .
5d20: 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
5d30: 72 67 20 22 2d 6c 6f 63 6b 22 29 20 22 2d 6c 6f rg "-lock") "-lo
5d40: 63 6b 22 20 22 2d 75 6e 6c 6f 63 6b 22 29 0a 20 ck" "-unlock").
5d50: 20 20 20 20 22 6c 6f 63 6b 2f 75 6e 6c 6f 63 6b "lock/unlock
5d60: 20 74 65 73 74 73 22 20 0a 20 20 20 20 20 28 6c tests" . (l
5d70: 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 75 ambda (target ru
5d80: 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 6e 61 nname keys keyna
5d90: 6d 65 73 20 6b 65 79 76 61 6c 6c 73 74 29 0a 20 mes keyvallst).
5da0: 20 20 20 20 20 20 28 72 75 6e 73 3a 68 61 6e 64 (runs:hand
5db0: 6c 65 2d 6c 6f 63 6b 69 6e 67 20 0a 09 09 20 20 le-locking ...
5dc0: 74 61 72 67 65 74 0a 09 09 20 20 6b 65 79 73 0a target... keys.
5dd0: 09 09 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 .. (args:get-ar
5de0: 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 20 0a 09 g ":runname") ..
5df0: 09 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 . (args:get-arg
5e00: 20 22 2d 6c 6f 63 6b 22 29 0a 09 09 20 20 28 61 "-lock")... (a
5e10: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 75 6e rgs:get-arg "-un
5e20: 6c 6f 63 6b 22 29 0a 09 09 20 20 75 73 65 72 29 lock")... user)
5e30: 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
5e40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5e50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5e60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5e70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
5e80: 20 47 65 74 20 70 61 74 68 73 20 74 6f 20 74 65 Get paths to te
5e90: 73 74 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d sts.;;==========
5ea0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5eb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5ec0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5ed0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
5ee0: 47 65 74 20 74 65 73 74 20 70 61 74 68 73 20 6d Get test paths m
5ef0: 61 74 63 68 69 6e 67 20 74 61 72 67 65 74 2c 20 atching target,
5f00: 72 75 6e 6e 61 6d 65 2c 20 61 6e 64 20 74 65 73 runname, and tes
5f10: 74 70 61 74 74 0a 28 69 66 20 28 6f 72 20 28 61 tpatt.(if (or (a
5f20: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 rgs:get-arg "-te
5f30: 73 74 2d 66 69 6c 65 73 22 29 28 61 72 67 73 3a st-files")(args:
5f40: 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 2d 70 get-arg "-test-p
5f50: 61 74 68 73 22 29 29 0a 20 20 20 20 3b 3b 20 69 aths")). ;; i
5f60: 66 20 77 65 20 61 72 65 20 69 6e 20 61 20 74 65 f we are in a te
5f70: 73 74 20 75 73 65 20 74 68 65 20 4d 54 5f 43 4d st use the MT_CM
5f80: 44 49 4e 46 4f 20 64 61 74 61 0a 20 20 20 20 28 DINFO data. (
5f90: 69 66 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 if (getenv "MT_C
5fa0: 4d 44 49 4e 46 4f 22 29 0a 09 28 6c 65 74 2a 20 MDINFO")..(let*
5fb0: 28 28 73 74 61 72 74 69 6e 67 64 69 72 20 28 63 ((startingdir (c
5fc0: 75 72 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 urrent-directory
5fd0: 29 29 0a 09 20 20 20 20 20 20 20 28 63 6d 64 69 )).. (cmdi
5fe0: 6e 66 6f 20 20 20 28 72 65 61 64 20 28 6f 70 65 nfo (read (ope
5ff0: 6e 2d 69 6e 70 75 74 2d 73 74 72 69 6e 67 20 28 n-input-string (
6000: 62 61 73 65 36 34 3a 62 61 73 65 36 34 2d 64 65 base64:base64-de
6010: 63 6f 64 65 20 28 67 65 74 65 6e 76 20 22 4d 54 code (getenv "MT
6020: 5f 43 4d 44 49 4e 46 4f 22 29 29 29 29 29 0a 09 _CMDINFO")))))..
6030: 20 20 20 20 20 20 20 3b 3b 20 28 72 75 6e 72 65 ;; (runre
6040: 6d 6f 74 65 20 28 61 73 73 6f 63 2f 64 65 66 61 mote (assoc/defa
6050: 75 6c 74 20 27 72 75 6e 72 65 6d 6f 74 65 20 63 ult 'runremote c
6060: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
6070: 20 28 74 72 61 6e 73 70 6f 72 74 20 28 61 73 73 (transport (ass
6080: 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 72 61 6e oc/default 'tran
6090: 73 70 6f 72 74 20 63 6d 64 69 6e 66 6f 29 29 0a sport cmdinfo)).
60a0: 09 20 20 20 20 20 20 20 28 74 65 73 74 70 61 74 . (testpat
60b0: 68 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c h (assoc/defaul
60c0: 74 20 27 74 65 73 74 70 61 74 68 20 20 63 6d 64 t 'testpath cmd
60d0: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
60e0: 74 65 73 74 2d 6e 61 6d 65 20 28 61 73 73 6f 63 test-name (assoc
60f0: 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 2d 6e /default 'test-n
6100: 61 6d 65 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 ame cmdinfo))..
6110: 20 20 20 20 20 20 28 72 75 6e 73 63 72 69 70 74 (runscript
6120: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
6130: 27 72 75 6e 73 63 72 69 70 74 20 63 6d 64 69 6e 'runscript cmdin
6140: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 64 62 fo)).. (db
6150: 2d 68 6f 73 74 20 20 20 28 61 73 73 6f 63 2f 64 -host (assoc/d
6160: 65 66 61 75 6c 74 20 27 64 62 2d 68 6f 73 74 20 efault 'db-host
6170: 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 cmdinfo))..
6180: 20 20 20 20 28 72 75 6e 2d 69 64 20 20 20 20 28 (run-id (
6190: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 assoc/default 'r
61a0: 75 6e 2d 69 64 20 20 20 20 63 6d 64 69 6e 66 6f un-id cmdinfo
61b0: 29 29 0a 09 20 20 20 20 20 20 20 28 69 74 65 6d )).. (item
61c0: 64 61 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 dat (assoc/def
61d0: 61 75 6c 74 20 27 69 74 65 6d 64 61 74 20 20 20 ault 'itemdat
61e0: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
61f0: 20 20 28 64 62 20 20 20 20 20 20 20 20 23 66 29 (db #f)
6200: 0a 09 20 20 20 20 20 20 20 28 73 74 61 74 65 20 .. (state
6210: 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
6220: 67 20 22 3a 73 74 61 74 65 22 29 29 0a 09 20 20 g ":state"))..
6230: 20 20 20 20 20 28 73 74 61 74 75 73 20 20 20 20 (status
6240: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a (args:get-arg ":
6250: 73 74 61 74 75 73 22 29 29 0a 09 20 20 20 20 20 status"))..
6260: 20 20 28 74 61 72 67 65 74 20 20 20 20 28 61 72 (target (ar
6270: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 61 72 gs:get-arg "-tar
6280: 67 65 74 22 29 29 0a 09 20 20 20 20 20 20 20 28 get")).. (
6290: 74 6f 70 70 61 74 68 20 20 20 28 61 73 73 6f 63 toppath (assoc
62a0: 2f 64 65 66 61 75 6c 74 20 27 74 6f 70 70 61 74 /default 'toppat
62b0: 68 20 20 20 63 6d 64 69 6e 66 6f 29 29 29 0a 09 h cmdinfo)))..
62c0: 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 (change-direct
62d0: 6f 72 79 20 74 6f 70 70 61 74 68 29 0a 09 20 20 ory toppath)..
62e0: 3b 3b 20 28 73 65 74 21 20 2a 72 75 6e 72 65 6d ;; (set! *runrem
62f0: 6f 74 65 2a 20 72 75 6e 72 65 6d 6f 74 65 29 0a ote* runremote).
6300: 09 20 20 28 73 65 74 21 20 2a 74 72 61 6e 73 70 . (set! *transp
6310: 6f 72 74 2d 74 79 70 65 2a 20 28 73 74 72 69 6e ort-type* (strin
6320: 67 2d 3e 73 79 6d 62 6f 6c 20 74 72 61 6e 73 70 g->symbol transp
6330: 6f 72 74 29 29 0a 09 20 20 28 69 66 20 28 6e 6f ort)).. (if (no
6340: 74 20 74 61 72 67 65 74 29 0a 09 20 20 20 20 20 t target)..
6350: 20 28 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 (begin...(debug
6360: 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a :print 0 "ERROR:
6370: 20 2d 74 61 72 67 65 74 20 69 73 20 72 65 71 75 -target is requ
6380: 69 72 65 64 2e 22 29 0a 09 09 28 65 78 69 74 20 ired.")...(exit
6390: 31 29 29 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 1))).. (if (not
63a0: 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 (setup-for-run)
63b0: 29 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a ).. (begin.
63c0: 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 ..(debug:print 0
63d0: 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 "Failed to setu
63e0: 70 2c 20 67 69 76 69 6e 67 20 75 70 20 6f 6e 20 p, giving up on
63f0: 2d 74 65 73 74 2d 70 61 74 68 73 20 6f 72 20 2d -test-paths or -
6400: 74 65 73 74 2d 66 69 6c 65 73 2c 20 65 78 69 74 test-files, exit
6410: 69 6e 67 22 29 0a 09 09 28 65 78 69 74 20 31 29 ing")...(exit 1)
6420: 29 29 0a 09 20 20 28 6c 65 74 2a 20 28 28 6b 65 )).. (let* ((ke
6430: 79 73 20 20 20 20 20 28 63 64 62 3a 72 65 6d 6f ys (cdb:remo
6440: 74 65 2d 72 75 6e 20 64 62 3a 67 65 74 2d 6b 65 te-run db:get-ke
6450: 79 73 20 64 62 29 29 0a 09 09 20 28 6b 65 79 6e ys db))... (keyn
6460: 61 6d 65 73 20 28 6d 61 70 20 6b 65 79 3a 67 65 ames (map key:ge
6470: 74 2d 66 69 65 6c 64 6e 61 6d 65 20 6b 65 79 73 t-fieldname keys
6480: 29 29 0a 09 09 20 3b 3b 20 64 62 3a 74 65 73 74 ))... ;; db:test
6490: 2d 67 65 74 2d 70 61 74 68 73 20 6d 75 73 74 20 -get-paths must
64a0: 6e 6f 74 20 62 65 20 72 75 6e 20 72 65 6d 6f 74 not be run remot
64b0: 65 0a 09 09 20 28 70 61 74 68 73 20 20 20 20 28 e... (paths (
64c0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 70 61 74 68 db:test-get-path
64d0: 73 2d 6d 61 74 63 68 69 6e 67 20 64 62 20 6b 65 s-matching db ke
64e0: 79 6e 61 6d 65 73 20 74 61 72 67 65 74 20 28 61 ynames target (a
64f0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 rgs:get-arg "-te
6500: 73 74 2d 66 69 6c 65 73 22 29 29 29 29 0a 09 20 st-files"))))..
6510: 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d (set! *didsom
6520: 65 74 68 69 6e 67 2a 20 23 74 29 0a 09 20 20 20 ething* #t)..
6530: 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 (for-each (lamb
6540: 64 61 20 28 70 61 74 68 29 0a 09 09 09 28 70 72 da (path)....(pr
6550: 69 6e 74 20 70 61 74 68 29 29 0a 09 09 20 20 20 int path))...
6560: 20 20 20 70 61 74 68 73 29 29 29 0a 09 3b 3b 20 paths)))..;;
6570: 65 6c 73 65 20 64 6f 20 61 20 67 65 6e 65 72 61 else do a genera
6580: 6c 2d 72 75 6e 2d 63 61 6c 6c 0a 09 28 67 65 6e l-run-call..(gen
6590: 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 09 eral-run-call ..
65a0: 20 22 2d 74 65 73 74 2d 66 69 6c 65 73 22 0a 09 "-test-files"..
65b0: 20 22 47 65 74 20 70 61 74 68 73 20 74 6f 20 74 "Get paths to t
65c0: 65 73 74 22 0a 09 20 28 6c 61 6d 62 64 61 20 28 est".. (lambda (
65d0: 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b target runname k
65e0: 65 79 73 20 6b 65 79 6e 61 6d 65 73 20 6b 65 79 eys keynames key
65f0: 76 61 6c 6c 73 74 29 0a 09 20 20 20 28 6c 65 74 vallst).. (let
6600: 2a 20 28 28 64 62 20 20 20 20 20 20 20 23 66 29 * ((db #f)
6610: 0a 09 09 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 72 ... ;; DO NOT r
6620: 75 6e 20 72 65 6d 6f 74 65 0a 09 09 20 20 28 70 un remote... (p
6630: 61 74 68 73 20 20 20 20 28 64 62 3a 74 65 73 74 aths (db:test
6640: 2d 67 65 74 2d 70 61 74 68 73 2d 6d 61 74 63 68 -get-paths-match
6650: 69 6e 67 20 64 62 20 6b 65 79 6e 61 6d 65 73 20 ing db keynames
6660: 74 61 72 67 65 74 20 28 61 72 67 73 3a 67 65 74 target (args:get
6670: 2d 61 72 67 20 22 2d 74 65 73 74 2d 66 69 6c 65 -arg "-test-file
6680: 73 22 29 29 29 29 0a 09 20 20 20 20 20 28 66 6f s")))).. (fo
6690: 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 r-each (lambda (
66a0: 70 61 74 68 29 0a 09 09 09 20 28 70 72 69 6e 74 path).... (print
66b0: 20 70 61 74 68 29 29 0a 09 09 20 20 20 20 20 20 path))...
66c0: 20 70 61 74 68 73 29 29 29 29 29 29 0a 0a 3b 3b paths))))))..;;
66d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
66e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
66f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6700: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6710: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 41 72 63 68 69 76 ======.;; Archiv
6720: 65 20 74 65 73 74 73 0a 3b 3b 3d 3d 3d 3d 3d 3d e tests.;;======
6730: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6740: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6750: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6760: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6770: 0a 3b 3b 20 41 72 63 68 69 76 65 20 74 65 73 74 .;; Archive test
6780: 73 20 6d 61 74 63 68 69 6e 67 20 74 61 72 67 65 s matching targe
6790: 74 2c 20 72 75 6e 6e 61 6d 65 2c 20 61 6e 64 20 t, runname, and
67a0: 74 65 73 74 70 61 74 74 0a 28 69 66 20 28 61 72 testpatt.(if (ar
67b0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 61 72 63 gs:get-arg "-arc
67c0: 68 69 76 65 22 29 0a 20 20 20 20 3b 3b 20 69 66 hive"). ;; if
67d0: 20 77 65 20 61 72 65 20 69 6e 20 61 20 74 65 73 we are in a tes
67e0: 74 20 75 73 65 20 74 68 65 20 4d 54 5f 43 4d 44 t use the MT_CMD
67f0: 49 4e 46 4f 20 64 61 74 61 0a 20 20 20 20 28 69 INFO data. (i
6800: 66 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d f (getenv "MT_CM
6810: 44 49 4e 46 4f 22 29 0a 09 28 6c 65 74 2a 20 28 DINFO")..(let* (
6820: 28 73 74 61 72 74 69 6e 67 64 69 72 20 28 63 75 (startingdir (cu
6830: 72 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 rrent-directory)
6840: 29 0a 09 20 20 20 20 20 20 20 28 63 6d 64 69 6e ).. (cmdin
6850: 66 6f 20 20 20 28 72 65 61 64 20 28 6f 70 65 6e fo (read (open
6860: 2d 69 6e 70 75 74 2d 73 74 72 69 6e 67 20 28 62 -input-string (b
6870: 61 73 65 36 34 3a 62 61 73 65 36 34 2d 64 65 63 ase64:base64-dec
6880: 6f 64 65 20 28 67 65 74 65 6e 76 20 22 4d 54 5f ode (getenv "MT_
6890: 43 4d 44 49 4e 46 4f 22 29 29 29 29 29 0a 09 20 CMDINFO")))))..
68a0: 20 20 20 20 20 20 3b 3b 20 28 72 75 6e 72 65 6d ;; (runrem
68b0: 6f 74 65 20 28 61 73 73 6f 63 2f 64 65 66 61 75 ote (assoc/defau
68c0: 6c 74 20 27 72 75 6e 72 65 6d 6f 74 65 20 63 6d lt 'runremote cm
68d0: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
68e0: 28 74 72 61 6e 73 70 6f 72 74 20 28 61 73 73 6f (transport (asso
68f0: 63 2f 64 65 66 61 75 6c 74 20 27 74 72 61 6e 73 c/default 'trans
6900: 70 6f 72 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 port cmdinfo))..
6910: 20 20 20 20 20 20 20 28 74 65 73 74 70 61 74 68 (testpath
6920: 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
6930: 20 27 74 65 73 74 70 61 74 68 20 20 63 6d 64 69 'testpath cmdi
6940: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 74 nfo)).. (t
6950: 65 73 74 2d 6e 61 6d 65 20 28 61 73 73 6f 63 2f est-name (assoc/
6960: 64 65 66 61 75 6c 74 20 27 74 65 73 74 2d 6e 61 default 'test-na
6970: 6d 65 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 me cmdinfo))..
6980: 20 20 20 20 20 28 72 75 6e 73 63 72 69 70 74 20 (runscript
6990: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
69a0: 72 75 6e 73 63 72 69 70 74 20 63 6d 64 69 6e 66 runscript cmdinf
69b0: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 64 62 2d o)).. (db-
69c0: 68 6f 73 74 20 20 20 28 61 73 73 6f 63 2f 64 65 host (assoc/de
69d0: 66 61 75 6c 74 20 27 64 62 2d 68 6f 73 74 20 20 fault 'db-host
69e0: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
69f0: 20 20 20 28 72 75 6e 2d 69 64 20 20 20 20 28 61 (run-id (a
6a00: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 ssoc/default 'ru
6a10: 6e 2d 69 64 20 20 20 20 63 6d 64 69 6e 66 6f 29 n-id cmdinfo)
6a20: 29 0a 09 20 20 20 20 20 20 20 28 69 74 65 6d 64 ).. (itemd
6a30: 61 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 at (assoc/defa
6a40: 75 6c 74 20 27 69 74 65 6d 64 61 74 20 20 20 63 ult 'itemdat c
6a50: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
6a60: 20 28 64 62 20 20 20 20 20 20 20 20 23 66 29 0a (db #f).
6a70: 09 20 20 20 20 20 20 20 28 73 74 61 74 65 20 20 . (state
6a80: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
6a90: 20 22 3a 73 74 61 74 65 22 29 29 0a 09 20 20 20 ":state"))..
6aa0: 20 20 20 20 28 73 74 61 74 75 73 20 20 20 20 28 (status (
6ab0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 args:get-arg ":s
6ac0: 74 61 74 75 73 22 29 29 0a 09 20 20 20 20 20 20 tatus"))..
6ad0: 20 28 74 61 72 67 65 74 20 20 20 20 28 61 72 67 (target (arg
6ae0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 61 72 67 s:get-arg "-targ
6af0: 65 74 22 29 29 29 0a 09 20 20 28 63 68 61 6e 67 et"))).. (chang
6b00: 65 2d 64 69 72 65 63 74 6f 72 79 20 74 65 73 74 e-directory test
6b10: 70 61 74 68 29 0a 09 20 20 3b 3b 20 28 73 65 74 path).. ;; (set
6b20: 21 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 72 75 ! *runremote* ru
6b30: 6e 72 65 6d 6f 74 65 29 0a 09 20 20 28 73 65 74 nremote).. (set
6b40: 21 20 2a 74 72 61 6e 73 70 6f 72 74 2d 74 79 70 ! *transport-typ
6b50: 65 2a 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 e* (string->symb
6b60: 6f 6c 20 74 72 61 6e 73 70 6f 72 74 29 29 0a 09 ol transport))..
6b70: 20 20 28 69 66 20 28 6e 6f 74 20 74 61 72 67 65 (if (not targe
6b80: 74 29 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e t).. (begin
6b90: 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 ...(debug:print
6ba0: 30 20 22 45 52 52 4f 52 3a 20 2d 74 61 72 67 65 0 "ERROR: -targe
6bb0: 74 20 69 73 20 72 65 71 75 69 72 65 64 2e 22 29 t is required.")
6bc0: 0a 09 09 28 65 78 69 74 20 31 29 29 29 0a 09 20 ...(exit 1)))..
6bd0: 20 28 69 66 20 28 6e 6f 74 20 28 73 65 74 75 70 (if (not (setup
6be0: 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 20 20 20 20 -for-run))..
6bf0: 20 20 28 62 65 67 69 6e 0a 09 09 28 64 65 62 75 (begin...(debu
6c00: 67 3a 70 72 69 6e 74 20 30 20 22 46 61 69 6c 65 g:print 0 "Faile
6c10: 64 20 74 6f 20 73 65 74 75 70 2c 20 67 69 76 69 d to setup, givi
6c20: 6e 67 20 75 70 20 6f 6e 20 2d 61 72 63 68 69 76 ng up on -archiv
6c30: 65 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 09 28 e, exiting")...(
6c40: 65 78 69 74 20 31 29 29 29 0a 09 20 20 28 6c 65 exit 1))).. (le
6c50: 74 2a 20 28 28 6b 65 79 73 20 20 20 20 20 28 63 t* ((keys (c
6c60: 64 62 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 64 62 db:remote-run db
6c70: 3a 67 65 74 2d 6b 65 79 73 20 64 62 29 29 0a 09 :get-keys db))..
6c80: 09 20 28 6b 65 79 6e 61 6d 65 73 20 28 6d 61 70 . (keynames (map
6c90: 20 6b 65 79 3a 67 65 74 2d 66 69 65 6c 64 6e 61 key:get-fieldna
6ca0: 6d 65 20 6b 65 79 73 29 29 0a 09 09 20 3b 3b 20 me keys))... ;;
6cb0: 44 4f 20 4e 4f 54 20 72 75 6e 20 72 65 6d 6f 74 DO NOT run remot
6cc0: 65 0a 09 09 20 28 70 61 74 68 73 20 20 20 20 28 e... (paths (
6cd0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 70 61 74 68 db:test-get-path
6ce0: 73 2d 6d 61 74 63 68 69 6e 67 20 64 62 20 6b 65 s-matching db ke
6cf0: 79 6e 61 6d 65 73 20 74 61 72 67 65 74 29 29 29 ynames target)))
6d00: 0a 09 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 .. (set! *did
6d10: 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 0a 09 something* #t)..
6d20: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c (for-each (l
6d30: 61 6d 62 64 61 20 28 70 61 74 68 29 0a 09 09 09 ambda (path)....
6d40: 28 70 72 69 6e 74 20 70 61 74 68 29 29 0a 09 09 (print path))...
6d50: 20 20 20 20 20 20 70 61 74 68 73 29 29 29 0a 09 paths)))..
6d60: 3b 3b 20 65 6c 73 65 20 64 6f 20 61 20 67 65 6e ;; else do a gen
6d70: 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 0a 09 28 eral-run-call..(
6d80: 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c general-run-call
6d90: 20 0a 09 20 22 2d 74 65 73 74 2d 70 61 74 68 73 .. "-test-paths
6da0: 22 0a 09 20 22 47 65 74 20 70 61 74 68 73 20 74 ".. "Get paths t
6db0: 6f 20 74 65 73 74 73 22 0a 09 20 28 6c 61 6d 62 o tests".. (lamb
6dc0: 64 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e 61 da (target runna
6dd0: 6d 65 20 6b 65 79 73 20 6b 65 79 6e 61 6d 65 73 me keys keynames
6de0: 20 6b 65 79 76 61 6c 6c 73 74 29 0a 09 20 20 20 keyvallst)..
6df0: 28 6c 65 74 2a 20 28 28 64 62 20 20 20 20 20 20 (let* ((db
6e00: 20 23 66 29 0a 09 09 20 20 3b 3b 20 44 4f 20 4e #f)... ;; DO N
6e10: 4f 54 20 72 75 6e 20 72 65 6d 6f 74 65 0a 09 09 OT run remote...
6e20: 20 20 28 70 61 74 68 73 20 20 20 20 28 64 62 3a (paths (db:
6e30: 74 65 73 74 2d 67 65 74 2d 70 61 74 68 73 2d 6d test-get-paths-m
6e40: 61 74 63 68 69 6e 67 20 64 62 20 6b 65 79 6e 61 atching db keyna
6e50: 6d 65 73 20 74 61 72 67 65 74 29 29 29 0a 09 20 mes target)))..
6e60: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c (for-each (l
6e70: 61 6d 62 64 61 20 28 70 61 74 68 29 0a 09 09 09 ambda (path)....
6e80: 20 28 70 72 69 6e 74 20 70 61 74 68 29 29 0a 09 (print path))..
6e90: 09 20 20 20 20 20 20 20 70 61 74 68 73 29 29 29 . paths)))
6ea0: 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
6eb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6ec0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6ed0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6ee0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
6ef0: 20 45 78 74 72 61 63 74 20 61 20 73 70 72 65 61 Extract a sprea
6f00: 64 73 68 65 65 74 20 66 72 6f 6d 20 74 68 65 20 dsheet from the
6f10: 72 75 6e 73 20 64 61 74 61 62 61 73 65 0a 3b 3b runs database.;;
6f20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6f30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6f40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6f50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6f60: 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 ======..(if (arg
6f70: 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 74 72 s:get-arg "-extr
6f80: 61 63 74 2d 6f 64 73 22 29 0a 20 20 20 20 28 67 act-ods"). (g
6f90: 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 0a eneral-run-call.
6fa0: 20 20 20 20 20 22 2d 65 78 74 72 61 63 74 2d 6f "-extract-o
6fb0: 64 73 22 0a 20 20 20 20 20 22 4d 61 6b 65 20 6f ds". "Make o
6fc0: 64 73 20 73 70 72 65 61 64 73 68 65 65 74 22 0a ds spreadsheet".
6fd0: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 (lambda (ta
6fe0: 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 rget runname key
6ff0: 73 20 6b 65 79 6e 61 6d 65 73 20 6b 65 79 76 61 s keynames keyva
7000: 6c 6c 73 74 29 0a 20 20 20 20 20 20 20 28 6c 65 llst). (le
7010: 74 20 28 28 64 62 20 20 20 20 20 20 20 20 20 23 t ((db #
7020: 66 29 0a 09 20 20 20 20 20 28 6f 75 74 70 75 74 f).. (output
7030: 66 69 6c 65 20 28 61 72 67 73 3a 67 65 74 2d 61 file (args:get-a
7040: 72 67 20 22 2d 65 78 74 72 61 63 74 2d 6f 64 73 rg "-extract-ods
7050: 22 29 29 0a 09 20 20 20 20 20 28 72 75 6e 73 70 ")).. (runsp
7060: 61 74 74 20 20 20 28 61 72 67 73 3a 67 65 74 2d att (args:get-
7070: 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 29 arg ":runname"))
7080: 0a 09 20 20 20 20 20 28 70 61 74 68 6d 6f 64 20 .. (pathmod
7090: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
70a0: 20 22 2d 70 61 74 68 6d 6f 64 22 29 29 0a 09 20 "-pathmod"))..
70b0: 20 20 20 20 28 6b 65 79 76 61 6c 61 6c 69 73 74 (keyvalalist
70c0: 20 28 6b 65 79 73 2d 3e 61 6c 69 73 74 20 6b 65 (keys->alist ke
70d0: 79 73 20 22 25 22 29 29 29 0a 09 20 28 64 65 62 ys "%"))).. (deb
70e0: 75 67 3a 70 72 69 6e 74 20 32 20 22 45 78 74 72 ug:print 2 "Extr
70f0: 61 63 74 20 6f 64 73 2c 20 6f 75 74 70 75 74 66 act ods, outputf
7100: 69 6c 65 3a 20 22 20 6f 75 74 70 75 74 66 69 6c ile: " outputfil
7110: 65 20 22 20 72 75 6e 73 70 61 74 74 3a 20 22 20 e " runspatt: "
7120: 72 75 6e 73 70 61 74 74 20 22 20 6b 65 79 76 61 runspatt " keyva
7130: 6c 61 6c 69 73 74 3a 20 22 20 6b 65 79 76 61 6c lalist: " keyval
7140: 61 6c 69 73 74 29 0a 09 20 28 63 64 62 3a 72 65 alist).. (cdb:re
7150: 6d 6f 74 65 2d 72 75 6e 20 64 62 3a 65 78 74 72 mote-run db:extr
7160: 61 63 74 2d 6f 64 73 2d 66 69 6c 65 20 64 62 20 act-ods-file db
7170: 6f 75 74 70 75 74 66 69 6c 65 20 6b 65 79 76 61 outputfile keyva
7180: 6c 61 6c 69 73 74 20 28 69 66 20 72 75 6e 73 70 lalist (if runsp
7190: 61 74 74 20 72 75 6e 73 70 61 74 74 20 22 25 22 att runspatt "%"
71a0: 29 20 70 61 74 68 6d 6f 64 29 29 29 29 29 0a 0a ) pathmod)))))..
71b0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
71c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
71d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
71e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
71f0: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 65 78 65 63 ========.;; exec
7200: 75 74 65 20 74 68 65 20 74 65 73 74 0a 3b 3b 20 ute the test.;;
7210: 20 20 20 2d 20 67 65 74 73 20 63 61 6c 6c 65 64 - gets called
7220: 20 6f 6e 20 72 65 6d 6f 74 65 20 68 6f 73 74 0a on remote host.
7230: 3b 3b 20 20 20 20 2d 20 72 65 63 65 69 76 65 73 ;; - receives
7240: 20 69 6e 66 6f 20 66 72 6f 6d 20 74 68 65 20 2d info from the -
7250: 65 78 65 63 75 74 65 20 70 61 72 61 6d 0a 3b 3b execute param.;;
7260: 20 20 20 20 2d 20 70 61 73 73 65 73 20 69 6e 66 - passes inf
7270: 6f 20 74 6f 20 73 74 65 70 73 20 76 69 61 20 4d o to steps via M
7280: 54 5f 43 4d 44 49 4e 46 4f 20 65 6e 76 20 76 61 T_CMDINFO env va
7290: 72 20 28 66 75 74 75 72 65 20 69 73 20 74 6f 20 r (future is to
72a0: 75 73 65 20 61 20 64 6f 74 20 66 69 6c 65 29 0a use a dot file).
72b0: 3b 3b 20 20 20 20 2d 20 67 61 74 68 65 72 73 20 ;; - gathers
72c0: 68 6f 73 74 20 69 6e 66 6f 20 61 6e 64 20 0a 3b host info and .;
72d0: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
72e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
72f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7300: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7310: 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 =======..(if (ar
7320: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 65 gs:get-arg "-exe
7330: 63 75 74 65 22 29 0a 20 20 20 20 28 62 65 67 69 cute"). (begi
7340: 6e 0a 20 20 20 20 20 20 28 6c 61 75 6e 63 68 3a n. (launch:
7350: 65 78 65 63 75 74 65 20 28 61 72 67 73 3a 67 65 execute (args:ge
7360: 74 2d 61 72 67 20 22 2d 65 78 65 63 75 74 65 22 t-arg "-execute"
7370: 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a )). (set! *
7380: 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
7390: 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
73a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
73b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
73c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
73d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
73e0: 20 54 65 73 74 20 63 6f 6d 6d 61 6e 64 73 20 28 Test commands (
73f0: 69 2e 65 2e 20 66 6f 72 20 75 73 65 20 69 6e 73 i.e. for use ins
7400: 69 64 65 20 74 65 73 74 73 29 0a 3b 3b 3d 3d 3d ide tests).;;===
7410: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7420: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7430: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7440: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7450: 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 6d 65 ===..(define (me
7460: 67 61 74 65 73 74 3a 73 74 65 70 20 73 74 65 70 gatest:step step
7470: 20 73 74 61 74 65 20 73 74 61 74 75 73 20 6c 6f state status lo
7480: 67 66 69 6c 65 20 6d 73 67 29 0a 20 20 28 69 66 gfile msg). (if
7490: 20 28 6e 6f 74 20 28 67 65 74 65 6e 76 20 22 4d (not (getenv "M
74a0: 54 5f 43 4d 44 49 4e 46 4f 22 29 29 0a 20 20 20 T_CMDINFO")).
74b0: 20 20 20 28 62 65 67 69 6e 0a 09 28 64 65 62 75 (begin..(debu
74c0: 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 g:print 0 "ERROR
74d0: 3a 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 65 6e 76 : MT_CMDINFO env
74e0: 20 76 61 72 20 6e 6f 74 20 73 65 74 2c 20 2d 73 var not set, -s
74f0: 74 65 70 20 6d 75 73 74 20 62 65 20 63 61 6c 6c tep must be call
7500: 65 64 20 2a 69 6e 73 69 64 65 2a 20 61 20 6d 65 ed *inside* a me
7510: 67 61 74 65 73 74 20 69 6e 76 6f 6b 65 64 20 65 gatest invoked e
7520: 6e 76 69 72 6f 6e 6d 65 6e 74 21 22 29 0a 09 28 nvironment!")..(
7530: 65 78 69 74 20 35 29 29 0a 20 20 20 20 20 20 28 exit 5)). (
7540: 6c 65 74 2a 20 28 28 63 6d 64 69 6e 66 6f 20 20 let* ((cmdinfo
7550: 20 28 72 65 61 64 20 28 6f 70 65 6e 2d 69 6e 70 (read (open-inp
7560: 75 74 2d 73 74 72 69 6e 67 20 28 62 61 73 65 36 ut-string (base6
7570: 34 3a 62 61 73 65 36 34 2d 64 65 63 6f 64 65 20 4:base64-decode
7580: 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 (getenv "MT_CMDI
7590: 4e 46 4f 22 29 29 29 29 29 0a 09 20 20 20 20 20 NFO")))))..
75a0: 3b 3b 20 28 72 75 6e 72 65 6d 6f 74 65 20 28 61 ;; (runremote (a
75b0: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 ssoc/default 'ru
75c0: 6e 72 65 6d 6f 74 65 20 63 6d 64 69 6e 66 6f 29 nremote cmdinfo)
75d0: 29 0a 09 20 20 20 20 20 28 74 72 61 6e 73 70 6f ).. (transpo
75e0: 72 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c rt (assoc/defaul
75f0: 74 20 27 74 72 61 6e 73 70 6f 72 74 20 63 6d 64 t 'transport cmd
7600: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 74 65 info)).. (te
7610: 73 74 70 61 74 68 20 20 28 61 73 73 6f 63 2f 64 stpath (assoc/d
7620: 65 66 61 75 6c 74 20 27 74 65 73 74 70 61 74 68 efault 'testpath
7630: 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 cmdinfo))..
7640: 20 20 28 74 65 73 74 2d 6e 61 6d 65 20 28 61 73 (test-name (as
7650: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 soc/default 'tes
7660: 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 6f 29 29 t-name cmdinfo))
7670: 0a 09 20 20 20 20 20 28 72 75 6e 73 63 72 69 70 .. (runscrip
7680: 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 t (assoc/default
7690: 20 27 72 75 6e 73 63 72 69 70 74 20 63 6d 64 69 'runscript cmdi
76a0: 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 64 62 2d nfo)).. (db-
76b0: 68 6f 73 74 20 20 20 28 61 73 73 6f 63 2f 64 65 host (assoc/de
76c0: 66 61 75 6c 74 20 27 64 62 2d 68 6f 73 74 20 20 fault 'db-host
76d0: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
76e0: 20 28 72 75 6e 2d 69 64 20 20 20 20 28 61 73 73 (run-id (ass
76f0: 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 2d oc/default 'run-
7700: 69 64 20 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a id cmdinfo)).
7710: 09 20 20 20 20 20 28 74 65 73 74 2d 69 64 20 20 . (test-id
7720: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
7730: 27 74 65 73 74 2d 69 64 20 20 20 63 6d 64 69 6e 'test-id cmdin
7740: 66 6f 29 29 0a 09 20 20 20 20 20 28 69 74 65 6d fo)).. (item
7750: 64 61 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 dat (assoc/def
7760: 61 75 6c 74 20 27 69 74 65 6d 64 61 74 20 20 20 ault 'itemdat
7770: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
7780: 28 64 62 20 20 20 20 20 20 20 20 23 66 29 29 0a (db #f)).
7790: 09 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f .(change-directo
77a0: 72 79 20 74 65 73 74 70 61 74 68 29 0a 09 3b 3b ry testpath)..;;
77b0: 20 28 73 65 74 21 20 2a 72 75 6e 72 65 6d 6f 74 (set! *runremot
77c0: 65 2a 20 72 75 6e 72 65 6d 6f 74 65 29 0a 09 28 e* runremote)..(
77d0: 73 65 74 21 20 2a 74 72 61 6e 73 70 6f 72 74 2d set! *transport-
77e0: 74 79 70 65 2a 20 28 73 74 72 69 6e 67 2d 3e 73 type* (string->s
77f0: 79 6d 62 6f 6c 20 74 72 61 6e 73 70 6f 72 74 29 ymbol transport)
7800: 29 0a 09 28 69 66 20 28 6e 6f 74 20 28 73 65 74 )..(if (not (set
7810: 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 20 20 up-for-run))..
7820: 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 20 (begin..
7830: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
7840: 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c Failed to setup,
7850: 20 65 78 69 74 69 6e 67 22 29 0a 09 20 20 20 20 exiting")..
7860: 20 20 28 65 78 69 74 20 31 29 29 29 0a 09 28 69 (exit 1)))..(i
7870: 66 20 28 61 6e 64 20 73 74 61 74 65 20 73 74 61 f (and state sta
7880: 74 75 73 29 0a 09 20 20 20 20 3b 3b 20 44 4f 20 tus).. ;; DO
7890: 4e 4f 54 20 72 65 6d 6f 74 65 20 72 75 6e 2c 20 NOT remote run,
78a0: 6d 61 6b 65 73 20 63 61 6c 6c 73 20 74 6f 20 74 makes calls to t
78b0: 68 65 20 74 65 73 74 64 61 74 2e 64 62 20 74 65 he testdat.db te
78c0: 73 74 20 64 62 2e 0a 09 20 20 20 20 28 64 62 3a st db... (db:
78d0: 74 65 73 74 73 74 65 70 2d 73 65 74 2d 73 74 61 teststep-set-sta
78e0: 74 75 73 21 20 64 62 20 74 65 73 74 2d 69 64 20 tus! db test-id
78f0: 73 74 65 70 20 73 74 61 74 65 20 73 74 61 74 75 step state statu
7900: 73 20 6d 73 67 20 6c 6f 67 66 69 6c 65 20 74 65 s msg logfile te
7910: 73 74 70 61 74 68 3a 20 74 65 73 74 70 61 74 68 stpath: testpath
7920: 29 0a 09 20 20 20 20 28 62 65 67 69 6e 0a 09 20 ).. (begin..
7930: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
7940: 74 20 30 20 22 45 52 52 4f 52 3a 20 59 6f 75 20 t 0 "ERROR: You
7950: 6d 75 73 74 20 73 70 65 63 69 66 79 20 3a 73 74 must specify :st
7960: 61 74 65 20 61 6e 64 20 3a 73 74 61 74 75 73 20 ate and :status
7970: 77 69 74 68 20 65 76 65 72 79 20 63 61 6c 6c 20 with every call
7980: 74 6f 20 2d 73 74 65 70 22 29 0a 09 20 20 20 20 to -step")..
7990: 20 20 28 65 78 69 74 20 36 29 29 29 29 29 29 0a (exit 6)))))).
79a0: 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
79b0: 72 67 20 22 2d 73 74 65 70 22 29 0a 20 20 20 20 rg "-step").
79c0: 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 6d 65 (begin. (me
79d0: 67 61 74 65 73 74 3a 73 74 65 70 20 0a 20 20 20 gatest:step .
79e0: 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
79f0: 67 20 22 2d 73 74 65 70 22 29 0a 20 20 20 20 20 g "-step").
7a00: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
7a10: 22 3a 73 74 61 74 65 22 29 0a 20 20 20 20 20 20 ":state").
7a20: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
7a30: 3a 73 74 61 74 75 73 22 29 0a 20 20 20 20 20 20 :status").
7a40: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
7a50: 2d 73 65 74 6c 6f 67 22 29 0a 20 20 20 20 20 20 -setlog").
7a60: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
7a70: 2d 6d 22 29 29 0a 20 20 20 20 20 20 3b 3b 20 28 -m")). ;; (
7a80: 69 66 20 64 62 20 28 73 71 6c 69 74 65 33 3a 66 if db (sqlite3:f
7a90: 69 6e 61 6c 69 7a 65 21 20 64 62 29 29 0a 20 20 inalize! db)).
7aa0: 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
7ab0: 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 20 mething* #t))).
7ac0: 20 20 20 0a 28 69 66 20 28 6f 72 20 28 61 6e 64 .(if (or (and
7ad0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
7ae0: 2d 73 65 74 6c 6f 67 22 29 20 20 20 20 20 20 20 -setlog")
7af0: 3b 3b 20 73 69 6e 63 65 20 73 65 74 74 69 6e 67 ;; since setting
7b00: 20 75 70 20 69 73 20 73 6f 20 63 6f 73 74 6c 79 up is so costly
7b10: 20 6c 65 74 73 20 70 69 67 67 79 62 61 63 6b 20 lets piggyback
7b20: 6f 6e 20 2d 74 65 73 74 2d 73 74 61 74 75 73 0a on -test-status.
7b30: 09 20 20 20 20 20 28 6e 6f 74 20 28 61 72 67 73 . (not (args
7b40: 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 65 70 22 :get-arg "-step"
7b50: 29 29 29 20 20 3b 3b 20 2d 73 65 74 6c 6f 67 20 ))) ;; -setlog
7b60: 6d 61 79 20 68 61 76 65 20 62 65 65 6e 20 70 72 may have been pr
7b70: 6f 63 65 73 73 65 64 20 61 6c 72 65 61 64 79 20 ocessed already
7b80: 69 6e 20 74 68 65 20 22 2d 73 74 65 70 22 20 70 in the "-step" p
7b90: 72 65 76 69 6f 75 73 0a 09 28 61 72 67 73 3a 67 revious..(args:g
7ba0: 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 74 6f 70 et-arg "-set-top
7bb0: 6c 6f 67 22 29 0a 09 28 61 72 67 73 3a 67 65 74 log")..(args:get
7bc0: 2d 61 72 67 20 22 2d 74 65 73 74 2d 73 74 61 74 -arg "-test-stat
7bd0: 75 73 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d us")..(args:get-
7be0: 61 72 67 20 22 2d 73 65 74 2d 76 61 6c 75 65 73 arg "-set-values
7bf0: 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 ")..(args:get-ar
7c00: 67 20 22 2d 6c 6f 61 64 2d 74 65 73 74 2d 64 61 g "-load-test-da
7c10: 74 61 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d ta")..(args:get-
7c20: 61 72 67 20 22 2d 72 75 6e 73 74 65 70 22 29 0a arg "-runstep").
7c30: 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 .(args:get-arg "
7c40: 2d 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 -summarize-items
7c50: 22 29 29 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 ")). (if (not
7c60: 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 (getenv "MT_CMD
7c70: 49 4e 46 4f 22 29 29 0a 09 28 62 65 67 69 6e 0a INFO"))..(begin.
7c80: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 . (debug:print
7c90: 30 20 22 45 52 52 4f 52 3a 20 4d 54 5f 43 4d 44 0 "ERROR: MT_CMD
7ca0: 49 4e 46 4f 20 65 6e 76 20 76 61 72 20 6e 6f 74 INFO env var not
7cb0: 20 73 65 74 2c 20 63 6f 6d 6d 61 6e 64 73 20 2d set, commands -
7cc0: 74 65 73 74 2d 73 74 61 74 75 73 2c 20 2d 72 75 test-status, -ru
7cd0: 6e 73 74 65 70 20 61 6e 64 20 2d 73 65 74 6c 6f nstep and -setlo
7ce0: 67 20 6d 75 73 74 20 62 65 20 63 61 6c 6c 65 64 g must be called
7cf0: 20 2a 69 6e 73 69 64 65 2a 20 61 20 6d 65 67 61 *inside* a mega
7d00: 74 65 73 74 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 test environment
7d10: 21 22 29 0a 09 20 20 28 65 78 69 74 20 35 29 29 !").. (exit 5))
7d20: 0a 09 28 6c 65 74 2a 20 28 28 73 74 61 72 74 69 ..(let* ((starti
7d30: 6e 67 64 69 72 20 28 63 75 72 72 65 6e 74 2d 64 ngdir (current-d
7d40: 69 72 65 63 74 6f 72 79 29 29 0a 09 20 20 20 20 irectory))..
7d50: 20 20 20 28 63 6d 64 69 6e 66 6f 20 20 20 28 72 (cmdinfo (r
7d60: 65 61 64 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d ead (open-input-
7d70: 73 74 72 69 6e 67 20 28 62 61 73 65 36 34 3a 62 string (base64:b
7d80: 61 73 65 36 34 2d 64 65 63 6f 64 65 20 28 67 65 ase64-decode (ge
7d90: 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f tenv "MT_CMDINFO
7da0: 22 29 29 29 29 29 0a 09 20 20 20 20 20 20 20 3b "))))).. ;
7db0: 3b 20 28 72 75 6e 72 65 6d 6f 74 65 20 28 61 73 ; (runremote (as
7dc0: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e soc/default 'run
7dd0: 72 65 6d 6f 74 65 20 63 6d 64 69 6e 66 6f 29 29 remote cmdinfo))
7de0: 0a 09 20 20 20 20 20 20 20 28 74 72 61 6e 73 70 .. (transp
7df0: 6f 72 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 ort (assoc/defau
7e00: 6c 74 20 27 74 72 61 6e 73 70 6f 72 74 20 63 6d lt 'transport cm
7e10: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
7e20: 28 74 65 73 74 70 61 74 68 20 20 28 61 73 73 6f (testpath (asso
7e30: 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 70 c/default 'testp
7e40: 61 74 68 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 ath cmdinfo))..
7e50: 20 20 20 20 20 20 20 28 74 65 73 74 2d 6e 61 6d (test-nam
7e60: 65 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 e (assoc/default
7e70: 20 27 74 65 73 74 2d 6e 61 6d 65 20 63 6d 64 69 'test-name cmdi
7e80: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 72 nfo)).. (r
7e90: 75 6e 73 63 72 69 70 74 20 28 61 73 73 6f 63 2f unscript (assoc/
7ea0: 64 65 66 61 75 6c 74 20 27 72 75 6e 73 63 72 69 default 'runscri
7eb0: 70 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 pt cmdinfo))..
7ec0: 20 20 20 20 20 28 64 62 2d 68 6f 73 74 20 20 20 (db-host
7ed0: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
7ee0: 64 62 2d 68 6f 73 74 20 20 20 63 6d 64 69 6e 66 db-host cmdinf
7ef0: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e o)).. (run
7f00: 2d 69 64 20 20 20 20 28 61 73 73 6f 63 2f 64 65 -id (assoc/de
7f10: 66 61 75 6c 74 20 27 72 75 6e 2d 69 64 20 20 20 fault 'run-id
7f20: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
7f30: 20 20 20 28 74 65 73 74 2d 69 64 20 20 20 28 61 (test-id (a
7f40: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 ssoc/default 'te
7f50: 73 74 2d 69 64 20 20 20 63 6d 64 69 6e 66 6f 29 st-id cmdinfo)
7f60: 29 0a 09 20 20 20 20 20 20 20 28 69 74 65 6d 64 ).. (itemd
7f70: 61 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 at (assoc/defa
7f80: 75 6c 74 20 27 69 74 65 6d 64 61 74 20 20 20 63 ult 'itemdat c
7f90: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
7fa0: 20 28 64 62 20 20 20 20 20 20 20 20 23 66 29 20 (db #f)
7fb0: 3b 3b 20 28 6f 70 65 6e 2d 64 62 29 29 0a 09 20 ;; (open-db))..
7fc0: 20 20 20 20 20 20 28 73 74 61 74 65 20 20 20 20 (state
7fd0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
7fe0: 3a 73 74 61 74 65 22 29 29 0a 09 20 20 20 20 20 :state"))..
7ff0: 20 20 28 73 74 61 74 75 73 20 20 20 20 28 61 72 (status (ar
8000: 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 gs:get-arg ":sta
8010: 74 75 73 22 29 29 29 0a 09 20 20 28 63 68 61 6e tus"))).. (chan
8020: 67 65 2d 64 69 72 65 63 74 6f 72 79 20 74 65 73 ge-directory tes
8030: 74 70 61 74 68 29 0a 09 20 20 3b 3b 20 28 73 65 tpath).. ;; (se
8040: 74 21 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 72 t! *runremote* r
8050: 75 6e 72 65 6d 6f 74 65 29 0a 09 20 20 28 73 65 unremote).. (se
8060: 74 21 20 2a 74 72 61 6e 73 70 6f 72 74 2d 74 79 t! *transport-ty
8070: 70 65 2a 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d pe* (string->sym
8080: 62 6f 6c 20 74 72 61 6e 73 70 6f 72 74 29 29 0a bol transport)).
8090: 09 20 20 28 69 66 20 28 6e 6f 74 20 28 73 65 74 . (if (not (set
80a0: 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 20 20 up-for-run))..
80b0: 20 20 20 20 28 62 65 67 69 6e 0a 09 09 28 64 65 (begin...(de
80c0: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 46 61 69 bug:print 0 "Fai
80d0: 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 led to setup, ex
80e0: 69 74 69 6e 67 22 29 0a 09 09 28 65 78 69 74 20 iting")...(exit
80f0: 31 29 29 29 0a 0a 09 20 20 3b 3b 20 63 61 6e 20 1)))... ;; can
8100: 73 65 74 75 70 20 61 73 20 63 6c 69 65 6e 74 20 setup as client
8110: 66 6f 72 20 73 65 72 76 65 72 20 6d 6f 64 65 20 for server mode
8120: 6e 6f 77 0a 09 20 20 3b 3b 20 28 63 6c 69 65 6e now.. ;; (clien
8130: 74 3a 73 65 74 75 70 29 0a 0a 09 20 20 28 69 66 t:setup)... (if
8140: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
8150: 2d 6c 6f 61 64 2d 74 65 73 74 2d 64 61 74 61 22 -load-test-data"
8160: 29 0a 09 20 20 20 20 20 20 3b 3b 20 68 61 73 20 ).. ;; has
8170: 73 75 62 20 63 6f 6d 6d 61 6e 64 73 20 74 68 61 sub commands tha
8180: 74 20 61 72 65 20 72 64 62 3a 0a 09 20 20 20 20 t are rdb:..
8190: 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 70 75 74 20 ;; DO NOT put
81a0: 74 68 69 73 20 6f 6e 65 20 69 6e 74 6f 20 65 69 this one into ei
81b0: 74 68 65 72 20 63 64 62 3a 72 65 6d 6f 74 65 2d ther cdb:remote-
81c0: 72 75 6e 20 6f 72 20 6f 70 65 6e 2d 72 75 6e 2d run or open-run-
81d0: 63 6c 6f 73 65 0a 09 20 20 20 20 20 20 28 64 62 close.. (db
81e0: 3a 6c 6f 61 64 2d 74 65 73 74 2d 64 61 74 61 20 :load-test-data
81f0: 64 62 20 74 65 73 74 2d 69 64 20 74 65 73 74 70 db test-id testp
8200: 61 74 68 3a 20 74 65 73 74 70 61 74 68 29 29 0a ath: testpath)).
8210: 09 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 . (if (args:get
8220: 2d 61 72 67 20 22 2d 73 65 74 6c 6f 67 22 29 0a -arg "-setlog").
8230: 09 20 20 20 20 20 20 28 6c 65 74 20 28 28 6c 6f . (let ((lo
8240: 67 66 6e 61 6d 65 20 28 61 72 67 73 3a 67 65 74 gfname (args:get
8250: 2d 61 72 67 20 22 2d 73 65 74 6c 6f 67 22 29 29 -arg "-setlog"))
8260: 29 0a 09 09 28 63 64 62 3a 74 65 73 74 2d 73 65 )...(cdb:test-se
8270: 74 2d 6c 6f 67 21 20 2a 72 75 6e 72 65 6d 6f 74 t-log! *runremot
8280: 65 2a 20 74 65 73 74 2d 69 64 20 6c 6f 67 66 6e e* test-id logfn
8290: 61 6d 65 29 29 29 0a 09 20 20 28 69 66 20 28 61 ame))).. (if (a
82a0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 rgs:get-arg "-se
82b0: 74 2d 74 6f 70 6c 6f 67 22 29 0a 09 20 20 20 20 t-toplog")..
82c0: 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 72 75 6e 20 ;; DO NOT run
82d0: 72 65 6d 6f 74 65 0a 09 20 20 20 20 20 20 28 74 remote.. (t
82e0: 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 74 6f ests:test-set-to
82f0: 70 6c 6f 67 21 20 64 62 20 72 75 6e 2d 69 64 20 plog! db run-id
8300: 74 65 73 74 2d 6e 61 6d 65 20 28 61 72 67 73 3a test-name (args:
8310: 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 74 6f get-arg "-set-to
8320: 70 6c 6f 67 22 29 29 29 0a 09 20 20 28 69 66 20 plog"))).. (if
8330: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
8340: 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 22 summarize-items"
8350: 29 0a 09 20 20 20 20 20 20 3b 3b 20 44 4f 20 4e ).. ;; DO N
8360: 4f 54 20 72 75 6e 20 72 65 6d 6f 74 65 0a 09 20 OT run remote..
8370: 20 20 20 20 20 28 74 65 73 74 73 3a 73 75 6d 6d (tests:summ
8380: 61 72 69 7a 65 2d 69 74 65 6d 73 20 64 62 20 72 arize-items db r
8390: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 un-id test-name
83a0: 23 74 29 29 20 3b 3b 20 64 6f 20 66 6f 72 63 65 #t)) ;; do force
83b0: 20 68 65 72 65 0a 09 20 20 28 69 66 20 28 61 72 here.. (if (ar
83c0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
83d0: 73 74 65 70 22 29 0a 09 20 20 20 20 20 20 28 69 step").. (i
83e0: 66 20 28 6e 75 6c 6c 3f 20 72 65 6d 61 72 67 73 f (null? remargs
83f0: 29 0a 09 09 20 20 28 62 65 67 69 6e 0a 09 09 20 )... (begin...
8400: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
8410: 30 20 22 45 52 52 4f 52 3a 20 6e 6f 74 68 69 6e 0 "ERROR: nothin
8420: 67 20 73 70 65 63 69 66 69 65 64 20 74 6f 20 72 g specified to r
8430: 75 6e 21 22 29 0a 09 09 20 20 20 20 28 69 66 20 un!")... (if
8440: 64 62 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 db (sqlite3:fina
8450: 6c 69 7a 65 21 20 64 62 29 29 0a 09 09 20 20 20 lize! db))...
8460: 20 28 65 78 69 74 20 36 29 29 0a 09 09 20 20 28 (exit 6))... (
8470: 6c 65 74 2a 20 28 28 73 74 65 70 6e 61 6d 65 20 let* ((stepname
8480: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
8490: 22 2d 72 75 6e 73 74 65 70 22 29 29 0a 09 09 09 "-runstep"))....
84a0: 20 28 6c 6f 67 70 72 6f 66 69 6c 65 20 28 61 72 (logprofile (ar
84b0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 67 gs:get-arg "-log
84c0: 70 72 6f 22 29 29 0a 09 09 09 20 28 6c 6f 67 66 pro")).... (logf
84d0: 69 6c 65 20 20 20 20 28 63 6f 6e 63 20 73 74 65 ile (conc ste
84e0: 70 6e 61 6d 65 20 22 2e 6c 6f 67 22 29 29 0a 09 pname ".log"))..
84f0: 09 09 20 28 63 6d 64 20 20 20 20 20 20 20 20 28 .. (cmd (
8500: 69 66 20 28 6e 75 6c 6c 3f 20 72 65 6d 61 72 67 if (null? remarg
8510: 73 29 20 23 66 20 28 63 61 72 20 72 65 6d 61 72 s) #f (car remar
8520: 67 73 29 29 29 0a 09 09 09 20 28 70 61 72 61 6d gs))).... (param
8530: 73 20 20 20 20 20 28 69 66 20 63 6d 64 20 28 63 s (if cmd (c
8540: 64 72 20 72 65 6d 61 72 67 73 29 20 27 28 29 29 dr remargs) '())
8550: 29 0a 09 09 09 20 28 65 78 69 74 73 74 61 74 20 ).... (exitstat
8560: 20 20 23 66 29 0a 09 09 09 20 28 73 68 65 6c 6c #f).... (shell
8570: 20 20 20 20 20 20 28 6c 61 73 74 20 28 73 74 72 (last (str
8580: 69 6e 67 2d 73 70 6c 69 74 20 28 67 65 74 2d 65 ing-split (get-e
8590: 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 nvironment-varia
85a0: 62 6c 65 20 22 53 48 45 4c 4c 22 29 20 22 2f 22 ble "SHELL") "/"
85b0: 29 29 29 0a 09 09 09 20 28 72 65 64 69 72 20 20 ))).... (redir
85c0: 20 20 20 20 28 63 61 73 65 20 28 73 74 72 69 6e (case (strin
85d0: 67 2d 3e 73 79 6d 62 6f 6c 20 73 68 65 6c 6c 29 g->symbol shell)
85e0: 0a 09 09 09 09 20 20 20 20 20 20 20 28 28 74 63 ..... ((tc
85f0: 73 68 20 63 73 68 20 6b 73 68 29 20 20 20 20 22 sh csh ksh) "
8600: 3e 26 22 29 0a 09 09 09 09 20 20 20 20 20 20 20 >&").....
8610: 28 28 7a 73 68 20 62 61 73 68 20 73 68 20 61 73 ((zsh bash sh as
8620: 68 29 20 22 32 3e 26 31 20 3e 22 29 0a 09 09 09 h) "2>&1 >")....
8630: 09 20 20 20 20 20 20 20 28 65 6c 73 65 20 22 3e . (else ">
8640: 26 22 29 29 29 0a 09 09 09 20 28 66 75 6c 6c 63 &"))).... (fullc
8650: 6d 64 20 20 20 20 28 63 6f 6e 63 20 22 28 22 20 md (conc "("
8660: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
8670: 72 73 65 20 0a 09 09 09 09 09 09 28 63 6f 6e 73 rse .......(cons
8680: 20 63 6d 64 20 70 61 72 61 6d 73 29 20 22 20 22 cmd params) " "
8690: 29 0a 09 09 09 09 09 20 20 20 22 29 20 22 20 72 )...... ") " r
86a0: 65 64 69 72 20 22 20 22 20 6c 6f 67 66 69 6c 65 edir " " logfile
86b0: 29 29 29 0a 09 09 20 20 20 20 3b 3b 20 6d 61 72 )))... ;; mar
86c0: 6b 20 74 68 65 20 73 74 61 72 74 20 6f 66 20 74 k the start of t
86d0: 68 65 20 74 65 73 74 0a 09 09 20 20 20 20 3b 3b he test... ;;
86e0: 20 44 4f 20 4e 4f 54 20 72 75 6e 20 72 65 6d 6f DO NOT run remo
86f0: 74 65 0a 09 09 20 20 20 20 28 64 62 3a 74 65 73 te... (db:tes
8700: 74 73 74 65 70 2d 73 65 74 2d 73 74 61 74 75 73 tstep-set-status
8710: 21 20 64 62 20 74 65 73 74 2d 69 64 20 73 74 65 ! db test-id ste
8720: 70 6e 61 6d 65 20 22 73 74 61 72 74 22 20 22 6e pname "start" "n
8730: 2f 61 22 20 28 61 72 67 73 3a 67 65 74 2d 61 72 /a" (args:get-ar
8740: 67 20 22 2d 6d 22 29 20 6c 6f 67 66 69 6c 65 20 g "-m") logfile
8750: 74 65 73 74 70 61 74 68 3a 20 74 65 73 74 70 61 testpath: testpa
8760: 74 68 29 0a 09 09 20 20 20 20 3b 3b 20 72 75 6e th)... ;; run
8770: 20 74 68 65 20 74 65 73 74 20 73 74 65 70 0a 09 the test step..
8780: 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
8790: 74 2d 69 6e 66 6f 20 32 20 22 52 75 6e 6e 69 6e t-info 2 "Runnin
87a0: 67 20 5c 22 22 20 66 75 6c 6c 63 6d 64 20 22 5c g \"" fullcmd "\
87b0: 22 22 29 0a 09 09 20 20 20 20 28 63 68 61 6e 67 "")... (chang
87c0: 65 2d 64 69 72 65 63 74 6f 72 79 20 73 74 61 72 e-directory star
87d0: 74 69 6e 67 64 69 72 29 0a 09 09 20 20 20 20 28 tingdir)... (
87e0: 73 65 74 21 20 65 78 69 74 73 74 61 74 20 28 73 set! exitstat (s
87f0: 79 73 74 65 6d 20 66 75 6c 6c 63 6d 64 29 29 20 ystem fullcmd))
8800: 3b 3b 20 63 6d 64 20 70 61 72 61 6d 73 29 29 0a ;; cmd params)).
8810: 09 09 20 20 20 20 28 73 65 74 21 20 2a 67 6c 6f .. (set! *glo
8820: 62 61 6c 65 78 69 74 73 74 61 74 75 73 2a 20 65 balexitstatus* e
8830: 78 69 74 73 74 61 74 29 0a 09 09 20 20 20 20 28 xitstat)... (
8840: 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 change-directory
8850: 20 74 65 73 74 70 61 74 68 29 0a 09 09 20 20 20 testpath)...
8860: 20 3b 3b 20 72 75 6e 20 6c 6f 67 70 72 6f 20 69 ;; run logpro i
8870: 66 20 61 70 70 6c 69 63 61 62 6c 65 20 3b 3b 20 f applicable ;;
8880: 28 70 72 6f 63 65 73 73 2d 72 75 6e 20 22 6c 73 (process-run "ls
8890: 22 20 28 6c 69 73 74 20 22 2f 66 6f 6f 22 20 22 " (list "/foo" "
88a0: 32 3e 26 31 22 20 22 62 6c 61 68 2e 6c 6f 67 22 2>&1" "blah.log"
88b0: 29 29 0a 09 09 20 20 20 20 28 69 66 20 6c 6f 67 ))... (if log
88c0: 70 72 6f 66 69 6c 65 0a 09 09 09 28 6c 65 74 2a profile....(let*
88d0: 20 28 28 68 74 6d 6c 6c 6f 67 66 69 6c 65 20 28 ((htmllogfile (
88e0: 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 2e conc stepname ".
88f0: 68 74 6d 6c 22 29 29 0a 09 09 09 20 20 20 20 20 html"))....
8900: 20 20 28 6f 6c 64 65 78 69 74 73 74 61 74 20 65 (oldexitstat e
8910: 78 69 74 73 74 61 74 29 0a 09 09 09 20 20 20 20 xitstat)....
8920: 20 20 20 28 63 6d 64 20 20 20 20 20 20 20 20 20 (cmd
8930: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
8940: 72 73 65 20 28 6c 69 73 74 20 22 6c 6f 67 70 72 rse (list "logpr
8950: 6f 22 20 6c 6f 67 70 72 6f 66 69 6c 65 20 68 74 o" logprofile ht
8960: 6d 6c 6c 6f 67 66 69 6c 65 20 22 3c 22 20 6c 6f mllogfile "<" lo
8970: 67 66 69 6c 65 20 22 3e 22 20 28 63 6f 6e 63 20 gfile ">" (conc
8980: 73 74 65 70 6e 61 6d 65 20 22 5f 6c 6f 67 70 72 stepname "_logpr
8990: 6f 2e 6c 6f 67 22 29 29 20 22 20 22 29 29 29 0a o.log")) " "))).
89a0: 09 09 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e ... (debug:prin
89b0: 74 2d 69 6e 66 6f 20 32 20 22 72 75 6e 6e 69 6e t-info 2 "runnin
89c0: 67 20 5c 22 22 20 63 6d 64 20 22 5c 22 22 29 0a g \"" cmd "\"").
89d0: 09 09 09 20 20 28 63 68 61 6e 67 65 2d 64 69 72 ... (change-dir
89e0: 65 63 74 6f 72 79 20 73 74 61 72 74 69 6e 67 64 ectory startingd
89f0: 69 72 29 0a 09 09 09 20 20 28 73 65 74 21 20 65 ir).... (set! e
8a00: 78 69 74 73 74 61 74 20 28 73 79 73 74 65 6d 20 xitstat (system
8a10: 63 6d 64 29 29 0a 09 09 09 20 20 28 73 65 74 21 cmd)).... (set!
8a20: 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 61 74 *globalexitstat
8a30: 75 73 2a 20 65 78 69 74 73 74 61 74 29 20 3b 3b us* exitstat) ;;
8a40: 20 6e 6f 20 6e 65 63 65 73 73 61 72 79 0a 09 09 no necessary...
8a50: 09 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 . (change-direc
8a60: 74 6f 72 79 20 74 65 73 74 70 61 74 68 29 0a 09 tory testpath)..
8a70: 09 09 20 20 28 63 64 62 3a 74 65 73 74 2d 73 65 .. (cdb:test-se
8a80: 74 2d 6c 6f 67 21 20 2a 72 75 6e 72 65 6d 6f 74 t-log! *runremot
8a90: 65 2a 20 74 65 73 74 2d 69 64 20 68 74 6d 6c 6c e* test-id htmll
8aa0: 6f 67 66 69 6c 65 29 29 29 0a 09 09 20 20 20 20 ogfile)))...
8ab0: 28 6c 65 74 20 28 28 6d 73 67 20 28 61 72 67 73 (let ((msg (args
8ac0: 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 29 29 :get-arg "-m")))
8ad0: 0a 09 09 20 20 20 20 20 20 3b 3b 20 44 4f 20 4e ... ;; DO N
8ae0: 4f 54 20 72 75 6e 20 72 65 6d 6f 74 65 0a 09 09 OT run remote...
8af0: 20 20 20 20 20 20 28 64 62 3a 74 65 73 74 73 74 (db:testst
8b00: 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 20 64 ep-set-status! d
8b10: 62 20 74 65 73 74 2d 69 64 20 73 74 65 70 6e 61 b test-id stepna
8b20: 6d 65 20 22 65 6e 64 22 20 65 78 69 74 73 74 61 me "end" exitsta
8b30: 74 20 6d 73 67 20 6c 6f 67 66 69 6c 65 20 74 65 t msg logfile te
8b40: 73 74 70 61 74 68 3a 20 74 65 73 74 70 61 74 68 stpath: testpath
8b50: 29 29 0a 09 09 20 20 20 20 29 29 29 0a 09 20 20 ))... )))..
8b60: 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 (if (or (args:ge
8b70: 74 2d 61 72 67 20 22 2d 74 65 73 74 2d 73 74 61 t-arg "-test-sta
8b80: 74 75 73 22 29 0a 09 09 20 20 28 61 72 67 73 3a tus")... (args:
8b90: 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 76 61 get-arg "-set-va
8ba0: 6c 75 65 73 22 29 29 0a 09 20 20 20 20 20 20 28 lues")).. (
8bb0: 6c 65 74 20 28 28 6e 65 77 73 74 61 74 75 73 20 let ((newstatus
8bc0: 28 63 6f 6e 64 0a 09 09 09 09 28 28 6e 75 6d 62 (cond.....((numb
8bd0: 65 72 3f 20 73 74 61 74 75 73 29 20 20 20 20 20 er? status)
8be0: 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 73 74 (if (equal? st
8bf0: 61 74 75 73 20 30 29 20 22 50 41 53 53 22 20 22 atus 0) "PASS" "
8c00: 46 41 49 4c 22 29 29 0a 09 09 09 09 28 28 61 6e FAIL")).....((an
8c10: 64 20 28 73 74 72 69 6e 67 3f 20 73 74 61 74 75 d (string? statu
8c20: 73 29 0a 09 09 09 09 20 20 20 20 20 20 28 73 74 s)..... (st
8c30: 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 73 74 61 ring->number sta
8c40: 74 75 73 29 29 28 69 66 20 28 65 71 75 61 6c 3f tus))(if (equal?
8c50: 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 (string->number
8c60: 20 73 74 61 74 75 73 29 20 30 29 20 22 50 41 53 status) 0) "PAS
8c70: 53 22 20 22 46 41 49 4c 22 29 29 0a 09 09 09 09 S" "FAIL")).....
8c80: 28 65 6c 73 65 20 73 74 61 74 75 73 29 29 29 0a (else status))).
8c90: 09 09 20 20 20 20 3b 3b 20 74 72 61 6e 73 66 65 .. ;; transfe
8ca0: 72 20 72 65 6c 65 76 61 6e 74 20 6b 65 79 73 20 r relevant keys
8cb0: 69 6e 74 6f 20 61 20 68 61 73 68 20 74 6f 20 62 into a hash to b
8cc0: 65 20 70 61 73 73 65 64 20 74 6f 20 74 65 73 74 e passed to test
8cd0: 2d 73 65 74 2d 73 74 61 74 75 73 21 0a 09 09 20 -set-status!...
8ce0: 20 20 20 3b 3b 20 63 6f 75 6c 64 20 75 73 65 20 ;; could use
8cf0: 61 6e 20 61 73 73 6f 63 20 6c 69 73 74 20 49 20 an assoc list I
8d00: 67 75 65 73 73 2e 20 0a 09 09 20 20 20 20 28 6f guess. ... (o
8d10: 74 68 65 72 64 61 74 61 20 28 6c 65 74 20 28 28 therdata (let ((
8d20: 72 65 73 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 res (make-hash-t
8d30: 61 62 6c 65 29 29 29 0a 09 09 09 09 20 28 66 6f able)))..... (fo
8d40: 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 r-each (lambda (
8d50: 6b 65 79 29 0a 09 09 09 09 09 20 20 20 20 20 28 key)...... (
8d60: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
8d70: 20 6b 65 79 29 0a 09 09 09 09 09 09 20 28 68 61 key)....... (ha
8d80: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 65 sh-table-set! re
8d90: 73 20 6b 65 79 20 28 61 72 67 73 3a 67 65 74 2d s key (args:get-
8da0: 61 72 67 20 6b 65 79 29 29 29 29 0a 09 09 09 09 arg key)))).....
8db0: 09 20 20 20 28 6c 69 73 74 20 22 3a 76 61 6c 75 . (list ":valu
8dc0: 65 22 20 22 3a 74 6f 6c 22 20 22 3a 65 78 70 65 e" ":tol" ":expe
8dd0: 63 74 65 64 22 20 22 3a 66 69 72 73 74 5f 65 72 cted" ":first_er
8de0: 72 22 20 22 3a 66 69 72 73 74 5f 77 61 72 6e 22 r" ":first_warn"
8df0: 20 22 3a 75 6e 69 74 73 22 20 22 3a 63 61 74 65 ":units" ":cate
8e00: 67 6f 72 79 22 20 22 3a 76 61 72 69 61 62 6c 65 gory" ":variable
8e10: 22 29 29 0a 09 09 09 09 20 72 65 73 29 29 29 0a "))..... res))).
8e20: 09 09 28 69 66 20 28 61 6e 64 20 28 61 72 67 73 ..(if (and (args
8e30: 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 2d :get-arg "-test-
8e40: 73 74 61 74 75 73 22 29 0a 09 09 09 20 28 6f 72 status").... (or
8e50: 20 28 6e 6f 74 20 73 74 61 74 65 29 0a 09 09 09 (not state)....
8e60: 20 20 20 20 20 28 6e 6f 74 20 73 74 61 74 75 73 (not status
8e70: 29 29 29 0a 09 09 20 20 20 20 28 62 65 67 69 6e )))... (begin
8e80: 0a 09 09 20 20 20 20 20 20 28 64 65 62 75 67 3a ... (debug:
8e90: 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 print 0 "ERROR:
8ea0: 59 6f 75 20 6d 75 73 74 20 73 70 65 63 69 66 79 You must specify
8eb0: 20 3a 73 74 61 74 65 20 61 6e 64 20 3a 73 74 61 :state and :sta
8ec0: 74 75 73 20 77 69 74 68 20 65 76 65 72 79 20 63 tus with every c
8ed0: 61 6c 6c 20 74 6f 20 2d 74 65 73 74 2d 73 74 61 all to -test-sta
8ee0: 74 75 73 5c 6e 22 20 68 65 6c 70 29 0a 09 09 20 tus\n" help)...
8ef0: 20 20 20 20 20 3b 3b 20 28 73 71 6c 69 74 65 33 ;; (sqlite3
8f00: 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 09 :finalize! db)..
8f10: 09 20 20 20 20 20 20 28 65 78 69 74 20 36 29 29 . (exit 6))
8f20: 29 0a 09 09 28 6c 65 74 2a 20 28 28 6d 73 67 20 )...(let* ((msg
8f30: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
8f40: 20 22 2d 6d 22 29 29 0a 09 09 20 20 20 20 20 20 "-m"))...
8f50: 20 28 6e 75 6d 6f 74 68 20 28 6c 65 6e 67 74 68 (numoth (length
8f60: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 (hash-table-key
8f70: 73 20 6f 74 68 65 72 64 61 74 61 29 29 29 29 0a s otherdata)))).
8f80: 09 09 20 20 3b 3b 20 43 6f 6e 76 65 72 74 20 74 .. ;; Convert t
8f90: 6f 20 72 70 63 20 69 6e 73 69 64 65 20 74 68 65 o rpc inside the
8fa0: 20 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d tests:test-set-
8fb0: 73 74 61 74 75 73 21 20 63 61 6c 6c 2c 20 6e 6f status! call, no
8fc0: 74 20 68 65 72 65 0a 09 09 20 20 28 74 65 73 74 t here... (test
8fd0: 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 s:test-set-statu
8fe0: 73 21 20 74 65 73 74 2d 69 64 20 73 74 61 74 65 s! test-id state
8ff0: 20 6e 65 77 73 74 61 74 75 73 20 6d 73 67 20 6f newstatus msg o
9000: 74 68 65 72 64 61 74 61 20 74 65 73 74 70 61 74 therdata testpat
9010: 68 3a 20 74 65 73 74 70 61 74 68 29 29 29 29 0a h: testpath)))).
9020: 09 20 20 28 69 66 20 64 62 20 28 73 71 6c 69 74 . (if db (sqlit
9030: 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 e3:finalize! db)
9040: 29 0a 09 20 20 28 73 65 74 21 20 2a 64 69 64 73 ).. (set! *dids
9050: 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 29 omething* #t))))
9060: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
9070: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9080: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9090: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
90a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 56 61 ==========.;; Va
90b0: 72 69 6f 75 73 20 68 65 6c 70 65 72 20 63 6f 6d rious helper com
90c0: 6d 61 6e 64 73 20 63 61 6e 20 67 6f 20 62 65 6c mands can go bel
90d0: 6f 77 20 68 65 72 65 0a 3b 3b 3d 3d 3d 3d 3d 3d ow here.;;======
90e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
90f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9100: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9110: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9120: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
9130: 61 72 67 20 22 2d 73 68 6f 77 6b 65 79 73 22 29 arg "-showkeys")
9140: 0a 20 20 20 20 28 6c 65 74 20 28 28 64 62 20 23 . (let ((db #
9150: 66 29 0a 09 20 20 28 6b 65 79 73 20 23 66 29 29 f).. (keys #f))
9160: 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 . (if (not
9170: 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 (setup-for-run))
9180: 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 .. (begin..
9190: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
91a0: 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c Failed to setup,
91b0: 20 65 78 69 74 69 6e 67 22 29 0a 09 20 20 20 20 exiting")..
91c0: 28 65 78 69 74 20 31 29 29 29 0a 20 20 20 20 20 (exit 1))).
91d0: 20 28 73 65 74 21 20 6b 65 79 73 20 28 63 62 64 (set! keys (cbd
91e0: 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 64 62 3a 67 :remote-run db:g
91f0: 65 74 2d 6b 65 79 73 20 64 62 29 29 0a 20 20 20 et-keys db)).
9200: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
9210: 31 20 22 4b 65 79 73 3a 20 22 20 28 73 74 72 69 1 "Keys: " (stri
9220: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 ng-intersperse (
9230: 6d 61 70 20 6b 65 79 3a 67 65 74 2d 66 69 65 6c map key:get-fiel
9240: 64 6e 61 6d 65 20 6b 65 79 73 29 20 22 2c 20 22 dname keys) ", "
9250: 29 29 0a 20 20 20 20 20 20 28 69 66 20 64 62 20 )). (if db
9260: 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a (sqlite3:finaliz
9270: 65 21 20 64 62 29 29 0a 20 20 20 20 20 20 28 73 e! db)). (s
9280: 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
9290: 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 g* #t)))..(if (a
92a0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 67 75 rgs:get-arg "-gu
92b0: 69 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 i"). (begin.
92c0: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
92d0: 74 20 30 20 22 4c 6f 6f 6b 20 61 74 20 74 68 65 t 0 "Look at the
92e0: 20 64 61 73 68 62 6f 61 72 64 20 66 6f 72 20 6e dashboard for n
92f0: 6f 77 22 29 0a 20 20 20 20 20 20 3b 3b 20 28 6d ow"). ;; (m
9300: 65 67 61 74 65 73 74 2d 67 75 69 29 0a 20 20 20 egatest-gui).
9310: 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d (set! *didsom
9320: 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 ething* #t)))..(
9330: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
9340: 20 22 2d 67 65 6e 2d 6d 65 67 61 74 65 73 74 2d "-gen-megatest-
9350: 61 72 65 61 22 29 0a 20 20 20 20 28 62 65 67 69 area"). (begi
9360: 6e 0a 20 20 20 20 20 20 28 67 65 6e 65 78 61 6d n. (genexam
9370: 70 6c 65 3a 6d 6b 2d 6d 65 67 61 74 65 73 74 2e ple:mk-megatest.
9380: 63 6f 6e 66 69 67 29 0a 20 20 20 20 20 20 28 73 config). (s
9390: 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
93a0: 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 g* #t)))..(if (a
93b0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 67 65 rgs:get-arg "-ge
93c0: 6e 2d 6d 65 67 61 74 65 73 74 2d 74 65 73 74 22 n-megatest-test"
93d0: 29 0a 20 20 20 20 28 6c 65 74 20 28 28 74 65 73 ). (let ((tes
93e0: 74 6e 61 6d 65 20 28 61 72 67 73 3a 67 65 74 2d tname (args:get-
93f0: 61 72 67 20 22 2d 67 65 6e 2d 6d 65 67 61 74 65 arg "-gen-megate
9400: 73 74 2d 74 65 73 74 22 29 29 29 0a 20 20 20 20 st-test"))).
9410: 20 20 28 67 65 6e 65 78 61 6d 70 6c 65 3a 6d 6b (genexample:mk
9420: 2d 6d 65 67 61 74 65 73 74 2d 74 65 73 74 20 74 -megatest-test t
9430: 65 73 74 6e 61 6d 65 29 0a 20 20 20 20 20 20 28 estname). (
9440: 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
9450: 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d ng* #t)))..;;===
9460: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9470: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9480: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9490: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
94a0: 3d 3d 3d 0a 3b 3b 20 55 70 64 61 74 65 20 74 68 ===.;; Update th
94b0: 65 20 64 61 74 61 62 61 73 65 20 73 63 68 65 6d e database schem
94c0: 61 20 6f 6e 20 72 65 71 75 65 73 74 0a 3b 3b 3d a on request.;;=
94d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
94e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
94f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9500: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9510: 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 =====..(if (args
9520: 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 62 75 69 :get-arg "-rebui
9530: 6c 64 2d 64 62 22 29 0a 20 20 20 20 28 62 65 67 ld-db"). (beg
9540: 69 6e 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f in. (if (no
9550: 74 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e t (setup-for-run
9560: 29 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 )).. (begin..
9570: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
9580: 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 "Failed to setu
9590: 70 2c 20 65 78 69 74 69 6e 67 22 29 20 0a 09 20 p, exiting") ..
95a0: 20 20 20 28 65 78 69 74 20 31 29 29 29 0a 20 20 (exit 1))).
95b0: 20 20 20 20 3b 3b 20 6b 65 65 70 20 74 68 69 73 ;; keep this
95c0: 20 6f 6e 65 20 6c 6f 63 61 6c 0a 20 20 20 20 20 one local.
95d0: 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 (open-run-close
95e0: 20 70 61 74 63 68 2d 64 62 20 23 66 29 0a 20 20 patch-db #f).
95f0: 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
9600: 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a mething* #t)))..
9610: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
9620: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9630: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9640: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9650: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 55 70 64 61 ========.;; Upda
9660: 74 65 20 74 68 65 20 74 65 73 74 73 20 6d 65 74 te the tests met
9670: 61 20 64 61 74 61 20 66 72 6f 6d 20 74 68 65 20 a data from the
9680: 74 65 73 74 63 6f 6e 66 69 67 20 66 69 6c 65 73 testconfig files
9690: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
96a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
96b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
96c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
96d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 =========..(if (
96e0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 75 args:get-arg "-u
96f0: 70 64 61 74 65 2d 6d 65 74 61 22 29 0a 20 20 20 pdate-meta").
9700: 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 69 (begin. (i
9710: 66 20 28 6e 6f 74 20 28 73 65 74 75 70 2d 66 6f f (not (setup-fo
9720: 72 2d 72 75 6e 29 29 0a 09 20 20 28 62 65 67 69 r-run)).. (begi
9730: 6e 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 n.. (debug:pr
9740: 69 6e 74 20 30 20 22 46 61 69 6c 65 64 20 74 6f int 0 "Failed to
9750: 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 setup, exiting"
9760: 29 20 0a 09 20 20 20 20 28 65 78 69 74 20 31 29 ) .. (exit 1)
9770: 29 29 0a 20 20 20 20 20 20 3b 3b 20 6e 6f 77 20 )). ;; now
9780: 63 61 6e 20 66 69 6e 64 20 6f 75 72 20 64 62 0a can find our db.
9790: 20 20 20 20 20 20 3b 3b 20 6b 65 65 70 20 74 68 ;; keep th
97a0: 69 73 20 6f 6e 65 20 6c 6f 63 61 6c 0a 20 20 20 is one local.
97b0: 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f (open-run-clo
97c0: 73 65 20 72 75 6e 73 3a 75 70 64 61 74 65 2d 61 se runs:update-a
97d0: 6c 6c 2d 74 65 73 74 5f 6d 65 74 61 20 64 62 29 ll-test_meta db)
97e0: 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 . (set! *di
97f0: 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 dsomething* #t))
9800: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
9810: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9820: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9830: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9840: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 53 ===========.;; S
9850: 74 61 72 74 20 61 20 72 65 70 6c 0a 3b 3b 3d 3d tart a repl.;;==
9860: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9870: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9880: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9890: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
98a0: 3d 3d 3d 3d 0a 0a 28 69 66 20 28 6f 72 20 28 61 ====..(if (or (a
98b0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 rgs:get-arg "-re
98c0: 70 6c 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d pl")..(args:get-
98d0: 61 72 67 20 22 2d 6c 6f 61 64 22 29 29 0a 20 20 arg "-load")).
98e0: 20 20 28 6c 65 74 2a 20 28 28 74 6f 70 70 61 74 (let* ((toppat
98f0: 68 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e h (setup-for-run
9900: 29 29 0a 09 20 20 20 28 64 62 20 20 20 20 20 20 )).. (db
9910: 28 69 66 20 74 6f 70 70 61 74 68 20 28 6f 70 65 (if toppath (ope
9920: 6e 2d 64 62 29 20 23 66 29 29 29 0a 20 20 20 20 n-db) #f))).
9930: 20 20 28 69 66 20 64 62 0a 09 20 20 28 62 65 67 (if db.. (beg
9940: 69 6e 0a 09 20 20 20 20 28 73 65 74 21 20 2a 64 in.. (set! *d
9950: 62 2a 20 64 62 29 0a 09 20 20 20 20 28 73 65 74 b* db).. (set
9960: 21 20 2a 63 6c 69 65 6e 74 2d 6e 6f 6e 2d 62 6c ! *client-non-bl
9970: 6f 63 6b 69 6e 67 2d 6d 6f 64 65 2a 20 23 74 29 ocking-mode* #t)
9980: 0a 09 20 20 20 20 3b 3b 20 28 63 6c 69 65 6e 74 .. ;; (client
9990: 3a 73 65 74 75 70 29 0a 09 20 20 20 20 3b 3b 20 :setup).. ;;
99a0: 28 63 6c 69 65 6e 74 3a 6c 61 75 6e 63 68 29 0a (client:launch).
99b0: 09 20 20 20 20 28 69 6d 70 6f 72 74 20 72 65 61 . (import rea
99c0: 64 6c 69 6e 65 29 0a 09 20 20 20 20 28 69 6d 70 dline).. (imp
99d0: 6f 72 74 20 61 70 72 6f 70 6f 73 29 0a 09 20 20 ort apropos)..
99e0: 20 20 28 67 6e 75 2d 68 69 73 74 6f 72 79 2d 69 (gnu-history-i
99f0: 6e 73 74 61 6c 6c 2d 66 69 6c 65 2d 6d 61 6e 61 nstall-file-mana
9a00: 67 65 72 0a 09 20 20 20 20 20 28 73 74 72 69 6e ger.. (strin
9a10: 67 2d 61 70 70 65 6e 64 0a 09 20 20 20 20 20 20 g-append..
9a20: 28 6f 72 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e (or (get-environ
9a30: 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 48 ment-variable "H
9a40: 4f 4d 45 22 29 20 22 2e 22 29 20 22 2f 2e 6d 65 OME") ".") "/.me
9a50: 67 61 74 65 73 74 5f 68 69 73 74 6f 72 79 22 29 gatest_history")
9a60: 29 0a 09 20 20 20 20 28 63 75 72 72 65 6e 74 2d ).. (current-
9a70: 69 6e 70 75 74 2d 70 6f 72 74 20 28 6d 61 6b 65 input-port (make
9a80: 2d 67 6e 75 2d 72 65 61 64 6c 69 6e 65 2d 70 6f -gnu-readline-po
9a90: 72 74 20 22 6d 65 67 61 74 65 73 74 3e 20 22 29 rt "megatest> ")
9aa0: 29 0a 09 20 20 20 20 28 69 66 20 28 61 72 67 73 ).. (if (args
9ab0: 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 70 6c 22 :get-arg "-repl"
9ac0: 29 0a 09 09 28 72 65 70 6c 29 0a 09 09 28 6c 6f )...(repl)...(lo
9ad0: 61 64 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 ad (args:get-arg
9ae0: 20 22 2d 6c 6f 61 64 22 29 29 29 29 0a 09 20 20 "-load"))))..
9af0: 28 65 78 69 74 29 29 0a 20 20 20 20 20 20 28 73 (exit)). (s
9b00: 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
9b10: 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d g* #t)))..;;====
9b20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9b30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9b40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9b50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9b60: 3d 3d 0a 3b 3b 20 45 78 69 74 20 61 6e 64 20 63 ==.;; Exit and c
9b70: 6c 65 61 6e 20 75 70 0a 3b 3b 3d 3d 3d 3d 3d 3d lean up.;;======
9b80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9b90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9ba0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9bb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9bc0: 0a 0a 3b 3b 20 74 68 69 73 20 69 73 20 74 68 65 ..;; this is the
9bd0: 20 73 6f 63 6b 65 74 20 69 66 20 77 65 20 61 72 socket if we ar
9be0: 65 20 61 20 63 6c 69 65 6e 74 0a 3b 3b 20 28 69 e a client.;; (i
9bf0: 66 20 28 61 6e 64 20 2a 72 75 6e 72 65 6d 6f 74 f (and *runremot
9c00: 65 2a 0a 3b 3b 20 09 20 28 73 6f 63 6b 65 74 3f e*.;; . (socket?
9c10: 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 29 29 0a 3b *runremote*)).;
9c20: 3b 20 20 20 20 20 28 63 6c 6f 73 65 2d 73 6f 63 ; (close-soc
9c30: 6b 65 74 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 29 ket *runremote*)
9c40: 29 0a 0a 28 69 66 20 28 6e 6f 74 20 2a 64 69 64 )..(if (not *did
9c50: 73 6f 6d 65 74 68 69 6e 67 2a 29 0a 20 20 20 20 something*).
9c60: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 68 (debug:print 0 h
9c70: 65 6c 70 29 29 0a 0a 3b 3b 20 28 69 66 20 2a 72 elp))..;; (if *r
9c80: 75 6e 72 65 6d 6f 74 65 2a 20 28 72 70 63 3a 63 unremote* (rpc:c
9c90: 6c 6f 73 65 2d 61 6c 6c 2d 63 6f 6e 6e 65 63 74 lose-all-connect
9ca0: 69 6f 6e 73 21 29 29 0a 20 20 20 20 0a 28 69 66 ions!)). .(if
9cb0: 20 28 6e 6f 74 20 28 65 71 3f 20 2a 67 6c 6f 62 (not (eq? *glob
9cc0: 61 6c 65 78 69 74 73 74 61 74 75 73 2a 20 30 29 alexitstatus* 0)
9cd0: 29 0a 20 20 20 20 28 69 66 20 28 6f 72 20 28 61 ). (if (or (a
9ce0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
9cf0: 6e 74 65 73 74 73 22 29 28 61 72 67 73 3a 67 65 ntests")(args:ge
9d00: 74 2d 61 72 67 20 22 2d 72 75 6e 61 6c 6c 22 29 t-arg "-runall")
9d10: 29 0a 20 20 20 20 20 20 20 20 28 62 65 67 69 6e ). (begin
9d20: 0a 20 20 20 20 20 20 20 20 20 20 20 28 64 65 62 . (deb
9d30: 75 67 3a 70 72 69 6e 74 20 30 20 22 4e 4f 54 45 ug:print 0 "NOTE
9d40: 3a 20 53 75 62 70 72 6f 63 65 73 73 65 73 20 77 : Subprocesses w
9d50: 69 74 68 20 6e 6f 6e 2d 7a 65 72 6f 20 65 78 69 ith non-zero exi
9d60: 74 20 63 6f 64 65 20 64 65 74 65 63 74 65 64 3a t code detected:
9d70: 20 22 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 " *globalexitst
9d80: 61 74 75 73 2a 29 0a 20 20 20 20 20 20 20 20 20 atus*).
9d90: 20 20 28 65 78 69 74 20 30 29 29 0a 20 20 20 20 (exit 0)).
9da0: 20 20 20 20 28 63 61 73 65 20 2a 67 6c 6f 62 61 (case *globa
9db0: 6c 65 78 69 74 73 74 61 74 75 73 2a 0a 20 20 20 lexitstatus*.
9dc0: 20 20 20 20 20 20 28 28 30 29 28 65 78 69 74 20 ((0)(exit
9dd0: 30 29 29 0a 20 20 20 20 20 20 20 20 20 28 28 31 0)). ((1
9de0: 29 28 65 78 69 74 20 31 29 29 0a 20 20 20 20 20 )(exit 1)).
9df0: 20 20 20 20 28 28 32 29 28 65 78 69 74 20 32 29 ((2)(exit 2)
9e00: 29 0a 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 ). (else
9e10: 20 28 65 78 69 74 20 33 29 29 29 29 29 0a (exit 3))))).