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 63 64 62 3a 63 6c 69 65 6e 74 2d 63 61 ; cdb:client-ca
0440: 6c 6c 0a 3b 3b 20 20 63 64 62 3a 72 65 6d 6f 74 ll.;; cdb:remot
0450: 65 2d 72 75 6e 0a 3b 3b 20 20 63 64 62 3a 74 65 e-run.;; cdb:te
0460: 73 74 2d 73 65 74 2d 73 74 61 74 75 73 2d 73 74 st-set-status-st
0470: 61 74 65 0a 3b 3b 20 20 63 68 61 6e 67 65 2d 64 ate.;; change-d
0480: 69 72 65 63 74 6f 72 79 0a 3b 3b 20 20 64 62 3a irectory.;; db:
0490: 70 72 6f 63 65 73 73 2d 71 75 65 75 65 2d 69 74 process-queue-it
04a0: 65 6d 0a 3b 3b 20 20 64 62 3a 74 65 73 74 2d 67 em.;; db:test-g
04b0: 65 74 2d 6c 6f 67 66 69 6c 65 2d 69 6e 66 6f 0a et-logfile-info.
04c0: 3b 3b 20 20 64 62 3a 74 65 73 74 73 74 65 70 2d ;; db:teststep-
04d0: 73 65 74 2d 73 74 61 74 75 73 21 0a 3b 3b 20 20 set-status!.;;
04e0: 6e 69 63 65 2d 70 61 74 68 0a 3b 3b 20 20 6f 62 nice-path.;; ob
04f0: 74 61 69 6e 2d 64 6f 74 2d 6c 6f 63 6b 0a 3b 3b tain-dot-lock.;;
0500: 20 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 open-run-close
0510: 0a 3b 3b 20 20 72 65 61 64 2d 63 6f 6e 66 69 67 .;; read-config
0520: 0a 3b 3b 20 20 72 75 6e 73 3a 63 61 6e 2d 72 75 .;; runs:can-ru
0530: 6e 2d 6d 6f 72 65 2d 74 65 73 74 73 0a 3b 3b 20 n-more-tests.;;
0540: 20 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 sqlite3:execute
0550: 0a 3b 3b 20 20 73 71 6c 69 74 65 33 3a 66 6f 72 .;; sqlite3:for
0560: 2d 65 61 63 68 2d 72 6f 77 0a 3b 3b 20 20 74 65 -each-row.;; te
0570: 73 74 73 3a 63 68 65 63 6b 2d 77 61 69 76 65 72 sts:check-waiver
0580: 2d 65 6c 69 67 69 62 69 6c 69 74 79 0a 3b 3b 20 -eligibility.;;
0590: 20 74 65 73 74 73 3a 73 75 6d 6d 61 72 69 7a 65 tests:summarize
05a0: 2d 69 74 65 6d 73 0a 3b 3b 20 20 74 65 73 74 73 -items.;; tests
05b0: 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 :test-set-status
05c0: 21 0a 3b 3b 20 20 74 68 72 65 61 64 2d 73 6c 65 !.;; thread-sle
05d0: 65 70 21 0a 3b 3b 29 0a 20 20 20 20 20 20 20 0a ep!.;;). .
05e0: 0a 28 64 65 66 69 6e 65 20 68 65 6c 70 20 28 63 .(define help (c
05f0: 6f 6e 63 20 22 0a 4d 65 67 61 74 65 73 74 2c 20 onc ".Megatest,
0600: 64 6f 63 75 6d 65 6e 74 61 74 69 6f 6e 20 61 74 documentation at
0610: 20 68 74 74 70 3a 2f 2f 77 77 77 2e 6b 69 61 74 http://www.kiat
0620: 6f 61 2e 63 6f 6d 2f 66 6f 73 73 69 6c 73 2f 6d oa.com/fossils/m
0630: 65 67 61 74 65 73 74 0a 20 20 76 65 72 73 69 6f egatest. versio
0640: 6e 20 22 20 6d 65 67 61 74 65 73 74 2d 76 65 72 n " megatest-ver
0650: 73 69 6f 6e 20 22 0a 20 20 6c 69 63 65 6e 73 65 sion ". license
0660: 20 47 50 4c 2c 20 43 6f 70 79 72 69 67 68 74 20 GPL, Copyright
0670: 4d 61 74 74 20 57 65 6c 6c 61 6e 64 20 32 30 30 Matt Welland 200
0680: 36 2d 32 30 31 32 0a 0a 55 73 61 67 65 3a 20 6d 6-2012..Usage: m
0690: 65 67 61 74 65 73 74 20 5b 6f 70 74 69 6f 6e 73 egatest [options
06a0: 5d 0a 20 20 2d 68 20 20 20 20 20 20 20 20 20 20 ]. -h
06b0: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 74 68 : th
06c0: 69 73 20 68 65 6c 70 0a 20 20 2d 76 65 72 73 69 is help. -versi
06d0: 6f 6e 20 20 20 20 20 20 20 20 20 20 20 20 20 20 on
06e0: 20 20 3a 20 70 72 69 6e 74 20 6d 65 67 61 74 65 : print megate
06f0: 73 74 20 76 65 72 73 69 6f 6e 20 28 63 75 72 72 st version (curr
0700: 65 6e 74 6c 79 20 22 20 6d 65 67 61 74 65 73 74 ently " megatest
0710: 2d 76 65 72 73 69 6f 6e 20 22 29 0a 0a 4c 61 75 -version ")..Lau
0720: 6e 63 68 69 6e 67 20 61 6e 64 20 6d 61 6e 61 67 nching and manag
0730: 69 6e 67 20 72 75 6e 73 0a 20 20 2d 72 75 6e 61 ing runs. -runa
0740: 6c 6c 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ll
0750: 20 20 20 3a 20 72 75 6e 20 61 6c 6c 20 74 65 73 : run all tes
0760: 74 73 20 74 68 61 74 20 61 72 65 20 6e 6f 74 20 ts that are not
0770: 73 74 61 74 65 20 43 4f 4d 50 4c 45 54 45 44 20 state COMPLETED
0780: 61 6e 64 20 73 74 61 74 75 73 20 50 41 53 53 2c and status PASS,
0790: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
07a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 43 48 CH
07b0: 45 43 4b 20 6f 72 20 4b 49 4c 4c 45 44 0a 20 20 ECK or KILLED.
07c0: 2d 72 75 6e 74 65 73 74 73 20 74 73 74 31 2c 74 -runtests tst1,t
07d0: 73 74 32 20 2e 2e 2e 20 3a 20 72 75 6e 20 74 65 st2 ... : run te
07e0: 73 74 73 0a 20 20 2d 72 65 6d 6f 76 65 2d 72 75 sts. -remove-ru
07f0: 6e 73 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 ns :
0800: 72 65 6d 6f 76 65 20 74 68 65 20 64 61 74 61 20 remove the data
0810: 66 6f 72 20 61 20 72 75 6e 2c 20 72 65 71 75 69 for a run, requi
0820: 72 65 73 20 3a 72 75 6e 6e 61 6d 65 20 61 6e 64 res :runname and
0830: 20 2d 74 65 73 74 70 61 74 74 0a 20 20 20 20 20 -testpatt.
0840: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0850: 20 20 20 20 20 20 20 4f 70 74 69 6f 6e 61 6c 6c Optionall
0860: 79 20 75 73 65 20 3a 73 74 61 74 65 20 61 6e 64 y use :state and
0870: 20 3a 73 74 61 74 75 73 0a 20 20 2d 73 65 74 2d :status. -set-
0880: 73 74 61 74 65 2d 73 74 61 74 75 73 20 58 2c 59 state-status X,Y
0890: 20 20 20 3a 20 73 65 74 20 73 74 61 74 65 20 74 : set state t
08a0: 6f 20 58 20 61 6e 64 20 73 74 61 74 75 73 20 74 o X and status t
08b0: 6f 20 59 2c 20 72 65 71 75 69 72 65 73 20 63 6f o Y, requires co
08c0: 6e 74 72 6f 6c 73 20 70 65 72 20 2d 72 65 6d 6f ntrols per -remo
08d0: 76 65 2d 72 75 6e 73 0a 20 20 2d 72 65 72 75 6e ve-runs. -rerun
08e0: 20 46 41 49 4c 2c 57 41 52 4e 2e 2e 2e 20 20 20 FAIL,WARN...
08f0: 20 20 3a 20 66 6f 72 63 65 20 72 65 2d 72 75 6e : force re-run
0900: 20 66 6f 72 20 74 65 73 74 73 20 77 69 74 68 20 for tests with
0910: 73 70 65 63 69 66 69 63 65 64 20 73 74 61 74 75 specificed statu
0920: 73 28 73 29 0a 20 20 2d 72 6f 6c 6c 75 70 20 20 s(s). -rollup
0930: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a :
0940: 20 28 63 75 72 72 65 6e 74 6c 79 20 64 69 73 61 (currently disa
0950: 62 6c 65 64 29 20 66 69 6c 6c 20 72 75 6e 20 28 bled) fill run (
0960: 73 65 74 20 62 79 20 3a 72 75 6e 6e 61 6d 65 29 set by :runname)
0970: 20 20 77 69 74 68 20 6c 61 74 65 73 74 20 74 65 with latest te
0980: 73 74 28 73 29 0a 20 20 20 20 20 20 20 20 20 20 st(s).
0990: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
09a0: 20 20 66 72 6f 6d 20 70 72 69 6f 72 20 72 75 6e from prior run
09b0: 73 20 77 69 74 68 20 73 61 6d 65 20 6b 65 79 73 s with same keys
09c0: 0a 20 20 2d 6c 6f 63 6b 20 20 20 20 20 20 20 20 . -lock
09d0: 20 20 20 20 20 20 20 20 20 20 20 3a 20 6c 6f 63 : loc
09e0: 6b 20 72 75 6e 20 73 70 65 63 69 66 69 65 64 20 k run specified
09f0: 62 79 20 74 61 72 67 65 74 20 61 6e 64 20 72 75 by target and ru
0a00: 6e 6e 61 6d 65 0a 20 20 2d 75 6e 6c 6f 63 6b 20 nname. -unlock
0a10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0a20: 3a 20 75 6e 6c 6f 63 6b 20 72 75 6e 20 73 70 65 : unlock run spe
0a30: 63 69 66 69 65 64 20 62 79 20 74 61 72 67 65 74 cified by target
0a40: 20 61 6e 64 20 72 75 6e 6e 61 6d 65 0a 0a 53 65 and runname..Se
0a50: 6c 65 63 74 6f 72 73 20 28 65 2e 67 2e 20 75 73 lectors (e.g. us
0a60: 65 20 66 6f 72 20 2d 72 75 6e 74 65 73 74 73 2c e for -runtests,
0a70: 20 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 2c 20 2d -remove-runs, -
0a80: 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 set-state-status
0a90: 2c 20 2d 6c 69 73 74 2d 72 75 6e 73 20 65 74 63 , -list-runs etc
0aa0: 2e 29 0a 20 20 2d 74 61 72 67 65 74 20 6b 65 79 .). -target key
0ab0: 31 2f 6b 65 79 32 2f 2e 2e 2e 20 20 20 3a 20 72 1/key2/... : r
0ac0: 75 6e 20 66 6f 72 20 6b 65 79 31 2c 20 6b 65 79 un for key1, key
0ad0: 32 2c 20 65 74 63 2e 0a 20 20 2d 72 65 71 74 61 2, etc.. -reqta
0ae0: 72 67 20 6b 65 79 31 2f 6b 65 79 32 2f 2e 2e 2e rg key1/key2/...
0af0: 20 20 3a 20 72 75 6e 20 66 6f 72 20 6b 65 79 31 : run for key1
0b00: 2c 20 6b 65 79 32 2c 20 65 74 63 2e 20 62 75 74 , key2, etc. but
0b10: 20 6b 65 79 31 2f 6b 65 79 32 20 6d 75 73 74 20 key1/key2 must
0b20: 62 65 20 69 6e 20 72 75 6e 63 6f 6e 66 69 67 0a be in runconfig.
0b30: 20 20 2d 74 65 73 74 70 61 74 74 20 70 61 74 74 -testpatt patt
0b40: 31 2f 70 61 74 74 32 2c 70 61 74 74 33 2f 2e 2e 1/patt2,patt3/..
0b50: 2e 20 20 3a 20 25 20 69 73 20 77 69 6c 64 63 61 . : % is wildca
0b60: 72 64 0a 20 20 3a 72 75 6e 6e 61 6d 65 20 20 20 rd. :runname
0b70: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 72 : r
0b80: 65 71 75 69 72 65 64 2c 20 6e 61 6d 65 20 66 6f equired, name fo
0b90: 72 20 74 68 69 73 20 70 61 72 74 69 63 75 6c 61 r this particula
0ba0: 72 20 74 65 73 74 20 72 75 6e 0a 20 20 3a 73 74 r test run. :st
0bb0: 61 74 65 20 20 20 20 20 20 20 20 20 20 20 20 20 ate
0bc0: 20 20 20 20 20 3a 20 41 70 70 6c 69 65 73 20 74 : Applies t
0bd0: 6f 20 72 75 6e 73 2c 20 74 65 73 74 73 20 6f 72 o runs, tests or
0be0: 20 73 74 65 70 73 20 64 65 70 65 6e 64 69 6e 67 steps depending
0bf0: 20 6f 6e 20 63 6f 6e 74 65 78 74 0a 20 20 3a 73 on context. :s
0c00: 74 61 74 75 73 20 20 20 20 20 20 20 20 20 20 20 tatus
0c10: 20 20 20 20 20 20 3a 20 41 70 70 6c 69 65 73 20 : Applies
0c20: 74 6f 20 72 75 6e 73 2c 20 74 65 73 74 73 20 6f to runs, tests o
0c30: 72 20 73 74 65 70 73 20 64 65 70 65 6e 64 69 6e r steps dependin
0c40: 67 20 6f 6e 20 63 6f 6e 74 65 78 74 0a 0a 54 65 g on context..Te
0c50: 73 74 20 68 65 6c 70 65 72 73 20 28 66 6f 72 20 st helpers (for
0c60: 75 73 65 20 69 6e 73 69 64 65 20 74 65 73 74 73 use inside tests
0c70: 29 0a 20 20 2d 73 74 65 70 20 73 74 65 70 6e 61 ). -step stepna
0c80: 6d 65 0a 20 20 2d 74 65 73 74 2d 73 74 61 74 75 me. -test-statu
0c90: 73 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 s : s
0ca0: 65 74 20 74 68 65 20 73 74 61 74 65 20 61 6e 64 et the state and
0cb0: 20 73 74 61 74 75 73 20 6f 66 20 61 20 74 65 73 status of a tes
0cc0: 74 20 28 75 73 65 20 3a 73 74 61 74 65 20 61 6e t (use :state an
0cd0: 64 20 3a 73 74 61 74 75 73 29 0a 20 20 2d 73 65 d :status). -se
0ce0: 74 6c 6f 67 20 6c 6f 67 66 6e 61 6d 65 20 20 20 tlog logfname
0cf0: 20 20 20 20 20 3a 20 73 65 74 20 74 68 65 20 70 : set the p
0d00: 61 74 68 2f 66 69 6c 65 6e 61 6d 65 20 74 6f 20 ath/filename to
0d10: 74 68 65 20 66 69 6e 61 6c 20 6c 6f 67 20 72 65 the final log re
0d20: 6c 61 74 69 76 65 20 74 6f 20 74 68 65 20 74 65 lative to the te
0d30: 73 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 st.
0d40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 64 d
0d50: 69 72 65 63 74 6f 72 79 2e 20 6d 61 79 20 62 65 irectory. may be
0d60: 20 75 73 65 64 20 77 69 74 68 20 2d 74 65 73 74 used with -test
0d70: 2d 73 74 61 74 75 73 0a 20 20 2d 73 65 74 2d 74 -status. -set-t
0d80: 6f 70 6c 6f 67 20 6c 6f 67 66 6e 61 6d 65 20 20 oplog logfname
0d90: 20 20 3a 20 73 65 74 20 74 68 65 20 6f 76 65 72 : set the over
0da0: 61 6c 6c 20 6c 6f 67 20 66 6f 72 20 61 20 73 75 all log for a su
0db0: 69 74 65 20 6f 66 20 73 75 62 2d 74 65 73 74 73 ite of sub-tests
0dc0: 0a 20 20 2d 73 75 6d 6d 61 72 69 7a 65 2d 69 74 . -summarize-it
0dd0: 65 6d 73 20 20 20 20 20 20 20 20 3a 20 66 6f 72 ems : for
0de0: 20 61 6e 20 69 74 65 6d 69 7a 65 64 20 74 65 73 an itemized tes
0df0: 74 20 63 72 65 61 74 65 20 61 20 73 75 6d 6d 61 t create a summa
0e00: 72 79 20 68 74 6d 6c 20 0a 20 20 2d 6d 20 63 6f ry html . -m co
0e10: 6d 6d 65 6e 74 20 20 20 20 20 20 20 20 20 20 20 mment
0e20: 20 20 20 3a 20 69 6e 73 65 72 74 20 61 20 63 6f : insert a co
0e30: 6d 6d 65 6e 74 20 66 6f 72 20 74 68 69 73 20 74 mment for this t
0e40: 65 73 74 0a 0a 54 65 73 74 20 64 61 74 61 20 63 est..Test data c
0e50: 61 70 74 75 72 65 0a 20 20 2d 73 65 74 2d 76 61 apture. -set-va
0e60: 6c 75 65 73 20 20 20 20 20 20 20 20 20 20 20 20 lues
0e70: 20 3a 20 75 70 64 61 74 65 20 6f 72 20 73 65 74 : update or set
0e80: 20 76 61 6c 75 65 73 20 69 6e 20 74 68 65 20 74 values in the t
0e90: 65 73 74 64 61 74 61 20 74 61 62 6c 65 0a 20 20 estdata table.
0ea0: 3a 63 61 74 65 67 6f 72 79 20 20 20 20 20 20 20 :category
0eb0: 20 20 20 20 20 20 20 20 3a 20 73 65 74 20 74 68 : set th
0ec0: 65 20 63 61 74 65 67 6f 72 79 20 66 69 65 6c 64 e category field
0ed0: 20 28 6f 70 74 69 6f 6e 61 6c 29 0a 20 20 3a 76 (optional). :v
0ee0: 61 72 69 61 62 6c 65 20 20 20 20 20 20 20 20 20 ariable
0ef0: 20 20 20 20 20 20 3a 20 73 65 74 20 74 68 65 20 : set the
0f00: 76 61 72 69 61 62 6c 65 20 6e 61 6d 65 20 28 6f variable name (o
0f10: 70 74 69 6f 6e 61 6c 29 0a 20 20 3a 76 61 6c 75 ptional). :valu
0f20: 65 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 e
0f30: 20 20 20 3a 20 76 61 6c 75 65 20 6d 65 61 73 75 : value measu
0f40: 72 65 64 20 28 72 65 71 75 69 72 65 64 29 0a 20 red (required).
0f50: 20 3a 65 78 70 65 63 74 65 64 20 20 20 20 20 20 :expected
0f60: 20 20 20 20 20 20 20 20 20 3a 20 76 61 6c 75 65 : value
0f70: 20 65 78 70 65 63 74 65 64 20 28 72 65 71 75 69 expected (requi
0f80: 72 65 64 29 0a 20 20 3a 74 6f 6c 20 20 20 20 20 red). :tol
0f90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a :
0fa0: 20 7c 76 61 6c 75 65 2d 65 78 70 65 63 74 7c 20 |value-expect|
0fb0: 3c 3d 20 74 6f 6c 20 28 72 65 71 75 69 72 65 64 <= tol (required
0fc0: 2c 20 63 61 6e 20 62 65 20 3c 2c 20 3e 2c 20 3e , can be <, >, >
0fd0: 3d 2c 20 3c 3d 20 6f 72 20 6e 75 6d 62 65 72 29 =, <= or number)
0fe0: 0a 20 20 3a 75 6e 69 74 73 20 20 20 20 20 20 20 . :units
0ff0: 20 20 20 20 20 20 20 20 20 20 20 3a 20 6e 61 6d : nam
1000: 65 20 6f 66 20 74 68 65 20 75 6e 69 74 73 20 66 e of the units f
1010: 6f 72 20 76 61 6c 75 65 2c 20 65 78 70 65 63 74 or value, expect
1020: 65 64 5f 76 61 6c 75 65 20 65 74 63 2e 20 28 6f ed_value etc. (o
1030: 70 74 69 6f 6e 61 6c 29 0a 20 20 2d 6c 6f 61 64 ptional). -load
1040: 2d 74 65 73 74 2d 64 61 74 61 20 20 20 20 20 20 -test-data
1050: 20 20 20 3a 20 72 65 61 64 20 74 65 73 74 20 73 : read test s
1060: 70 65 63 69 66 69 63 20 64 61 74 61 20 66 6f 72 pecific data for
1070: 20 73 74 6f 72 61 67 65 20 69 6e 20 74 68 65 20 storage in the
1080: 74 65 73 74 5f 64 61 74 61 20 74 61 62 6c 65 0a test_data table.
1090: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
10a0: 20 20 20 20 20 20 20 20 20 20 20 20 66 72 6f 6d from
10b0: 20 73 74 61 6e 64 61 72 64 20 69 6e 2e 20 45 61 standard in. Ea
10c0: 63 68 20 6c 69 6e 65 20 69 73 20 63 6f 6d 6d 61 ch line is comma
10d0: 20 64 65 6c 69 6d 69 74 65 64 20 77 69 74 68 20 delimited with
10e0: 66 6f 75 72 0a 20 20 20 20 20 20 20 20 20 20 20 four.
10f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1100: 20 66 69 65 6c 64 73 20 63 61 74 65 67 6f 72 79 fields category
1110: 2c 76 61 72 69 61 62 6c 65 2c 76 61 6c 75 65 2c ,variable,value,
1120: 63 6f 6d 6d 65 6e 74 0a 0a 51 75 65 72 69 65 73 comment..Queries
1130: 0a 20 20 2d 6c 69 73 74 2d 72 75 6e 73 20 70 61 . -list-runs pa
1140: 74 74 20 20 20 20 20 20 20 20 20 3a 20 6c 69 73 tt : lis
1150: 74 20 72 75 6e 73 20 6d 61 74 63 68 69 6e 67 20 t runs matching
1160: 70 61 74 74 65 72 6e 20 5c 22 70 61 74 74 5c 22 pattern \"patt\"
1170: 2c 20 25 20 69 73 20 74 68 65 20 77 69 6c 64 63 , % is the wildc
1180: 61 72 64 0a 20 20 2d 73 68 6f 77 6b 65 79 73 20 ard. -showkeys
1190: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 :
11a0: 73 68 6f 77 20 74 68 65 20 6b 65 79 73 20 75 73 show the keys us
11b0: 65 64 20 69 6e 20 74 68 69 73 20 6d 65 67 61 74 ed in this megat
11c0: 65 73 74 20 73 65 74 75 70 0a 20 20 2d 74 65 73 est setup. -tes
11d0: 74 2d 66 69 6c 65 73 20 74 61 72 67 70 61 74 74 t-files targpatt
11e0: 20 20 20 20 20 3a 20 67 65 74 20 74 68 65 20 6d : get the m
11f0: 6f 73 74 20 72 65 63 65 6e 74 20 74 65 73 74 20 ost recent test
1200: 70 61 74 68 2f 66 69 6c 65 20 6d 61 74 63 68 69 path/file matchi
1210: 6e 67 20 74 61 72 67 70 61 74 74 20 65 2e 67 2e ng targpatt e.g.
1220: 20 25 2f 25 2e 2e 2e 20 0a 20 20 20 20 20 20 20 %/%... .
1230: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1240: 20 20 20 20 20 72 65 74 75 72 6e 73 20 6c 69 73 returns lis
1250: 74 20 73 6f 72 74 65 64 20 62 79 20 61 67 65 20 t sorted by age
1260: 61 73 63 65 6e 64 69 6e 67 2c 20 73 65 65 20 65 ascending, see e
1270: 78 61 6d 70 6c 65 73 20 62 65 6c 6f 77 0a 20 20 xamples below.
1280: 2d 74 65 73 74 2d 70 61 74 68 73 20 20 20 20 20 -test-paths
1290: 20 20 20 20 20 20 20 20 3a 20 67 65 74 20 74 68 : get th
12a0: 65 20 74 65 73 74 20 70 61 74 68 73 20 6d 61 74 e test paths mat
12b0: 63 68 69 6e 67 20 74 61 72 67 65 74 2c 20 72 75 ching target, ru
12c0: 6e 6e 61 6d 65 2c 20 69 74 65 6d 20 61 6e 64 20 nname, item and
12d0: 74 65 73 74 0a 20 20 20 20 20 20 20 20 20 20 20 test.
12e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12f0: 20 70 61 74 74 65 72 6e 73 2e 0a 20 20 2d 6c 69 patterns.. -li
1300: 73 74 2d 64 69 73 6b 73 20 20 20 20 20 20 20 20 st-disks
1310: 20 20 20 20 20 3a 20 6c 69 73 74 20 74 68 65 20 : list the
1320: 64 69 73 6b 73 20 61 76 61 69 6c 61 62 6c 65 20 disks available
1330: 66 6f 72 20 73 74 6f 72 69 6e 67 20 72 75 6e 73 for storing runs
1340: 0a 20 20 2d 6c 69 73 74 2d 74 61 72 67 65 74 73 . -list-targets
1350: 20 20 20 20 20 20 20 20 20 20 20 3a 20 6c 69 73 : lis
1360: 74 20 74 68 65 20 74 61 72 67 65 74 73 20 69 6e t the targets in
1370: 20 72 75 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 runconfigs.conf
1380: 69 67 0a 20 20 2d 6c 69 73 74 2d 64 62 2d 74 61 ig. -list-db-ta
1390: 72 67 65 74 73 20 20 20 20 20 20 20 20 3a 20 6c rgets : l
13a0: 69 73 74 20 74 68 65 20 74 61 72 67 65 74 20 63 ist the target c
13b0: 6f 6d 62 69 6e 61 74 69 6f 6e 73 20 75 73 65 64 ombinations used
13c0: 20 69 6e 20 74 68 65 20 64 62 0a 20 20 2d 73 68 in the db. -sh
13d0: 6f 77 2d 63 6f 6e 66 69 67 20 20 20 20 20 20 20 ow-config
13e0: 20 20 20 20 20 3a 20 64 75 6d 70 20 74 68 65 20 : dump the
13f0: 69 6e 74 65 72 6e 61 6c 20 72 65 70 72 65 73 65 internal represe
1400: 6e 74 61 74 69 6f 6e 20 6f 66 20 74 68 65 20 6d ntation of the m
1410: 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 20 66 egatest.config f
1420: 69 6c 65 0a 20 20 2d 73 68 6f 77 2d 72 75 6e 63 ile. -show-runc
1430: 6f 6e 66 69 67 20 20 20 20 20 20 20 20 20 3a 20 onfig :
1440: 64 75 6d 70 20 74 68 65 20 69 6e 74 65 72 6e 61 dump the interna
1450: 6c 20 72 65 70 72 65 73 65 6e 74 61 74 69 6f 6e l representation
1460: 20 6f 66 20 74 68 65 20 72 75 6e 63 6f 6e 66 69 of the runconfi
1470: 67 73 2e 63 6f 6e 66 69 67 20 66 69 6c 65 0a 20 gs.config file.
1480: 20 2d 64 75 6d 70 6d 6f 64 65 20 6a 73 6f 6e 20 -dumpmode json
1490: 20 20 20 20 20 20 20 20 20 3a 20 64 75 6d 70 20 : dump
14a0: 69 6e 20 6a 73 6f 6e 20 66 6f 72 6d 61 74 20 69 in json format i
14b0: 6e 73 74 65 61 64 20 6f 66 20 73 65 78 70 72 0a nstead of sexpr.
14c0: 0a 4d 69 73 63 20 0a 20 20 2d 72 65 62 75 69 6c .Misc . -rebuil
14d0: 64 2d 64 62 20 20 20 20 20 20 20 20 20 20 20 20 d-db
14e0: 20 3a 20 62 72 69 6e 67 20 74 68 65 20 64 61 74 : bring the dat
14f0: 61 62 61 73 65 20 73 63 68 65 6d 61 20 75 70 20 abase schema up
1500: 74 6f 20 64 61 74 65 0a 20 20 2d 75 70 64 61 74 to date. -updat
1510: 65 2d 6d 65 74 61 20 20 20 20 20 20 20 20 20 20 e-meta
1520: 20 20 3a 20 75 70 64 61 74 65 20 74 68 65 20 74 : update the t
1530: 65 73 74 73 20 6d 65 74 61 64 61 74 61 20 66 6f ests metadata fo
1540: 72 20 61 6c 6c 20 74 65 73 74 73 0a 20 20 2d 65 r all tests. -e
1550: 6e 76 32 66 69 6c 65 20 66 6e 61 6d 65 20 20 20 nv2file fname
1560: 20 20 20 20 20 20 3a 20 77 72 69 74 65 20 74 68 : write th
1570: 65 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 74 6f e environment to
1580: 20 66 6e 61 6d 65 2e 63 73 68 20 61 6e 64 20 66 fname.csh and f
1590: 6e 61 6d 65 2e 73 68 0a 20 20 2d 73 65 74 76 61 name.sh. -setva
15a0: 72 73 20 56 41 52 31 3d 76 61 6c 31 2c 56 41 52 rs VAR1=val1,VAR
15b0: 32 3d 76 61 6c 32 20 3a 20 41 64 64 20 65 6e 76 2=val2 : Add env
15c0: 69 72 6f 6e 6d 65 6e 74 20 76 61 72 69 61 62 6c ironment variabl
15d0: 65 73 20 74 6f 20 61 20 72 75 6e 20 4e 42 2f 2f es to a run NB//
15e0: 20 74 68 65 73 65 20 61 72 65 0a 20 20 20 20 20 these are.
15f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1600: 20 20 20 20 20 20 20 20 20 20 20 20 6f 76 65 72 over
1610: 77 72 69 74 74 65 6e 20 62 79 20 76 61 6c 75 65 written by value
1620: 73 20 73 65 74 20 69 6e 20 63 6f 6e 66 69 67 20 s set in config
1630: 66 69 6c 65 73 2e 0a 20 20 2d 73 65 72 76 65 72 files.. -server
1640: 20 2d 7c 68 6f 73 74 6e 61 6d 65 20 20 20 20 20 -|hostname
1650: 20 3a 20 73 74 61 72 74 20 74 68 65 20 73 65 72 : start the ser
1660: 76 65 72 20 28 72 65 64 75 63 65 73 20 63 6f 6e ver (reduces con
1670: 74 65 6e 74 69 6f 6e 20 6f 6e 20 6d 65 67 61 74 tention on megat
1680: 65 73 74 2e 64 62 29 2c 20 75 73 65 0a 20 20 20 est.db), use.
1690: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16a0: 20 20 20 20 20 20 20 20 20 2d 20 74 6f 20 61 75 - to au
16b0: 74 6f 6d 61 74 69 63 61 6c 6c 79 20 66 69 67 75 tomatically figu
16c0: 72 65 20 6f 75 74 20 68 6f 73 74 6e 61 6d 65 0a re out hostname.
16d0: 20 20 2d 74 72 61 6e 73 70 6f 72 74 20 68 74 74 -transport htt
16e0: 70 7c 66 73 20 20 20 20 20 20 3a 20 75 73 65 20 p|fs : use
16f0: 68 74 74 70 20 6f 72 20 64 69 72 65 63 74 20 61 http or direct a
1700: 63 63 65 73 73 20 66 6f 72 20 74 72 61 6e 73 70 ccess for transp
1710: 6f 72 74 20 28 64 65 66 61 75 6c 74 20 69 73 20 ort (default is
1720: 68 74 74 70 29 20 0a 20 20 2d 64 61 65 6d 6f 6e http) . -daemon
1730: 69 7a 65 20 20 20 20 20 20 20 20 20 20 20 20 20 ize
1740: 20 3a 20 66 6f 72 6b 20 69 6e 74 6f 20 62 61 63 : fork into bac
1750: 6b 67 72 6f 75 6e 64 20 61 6e 64 20 64 69 73 63 kground and disc
1760: 6f 6e 6e 65 63 74 20 66 72 6f 6d 20 73 74 64 69 onnect from stdi
1770: 6e 2f 6f 75 74 0a 20 20 2d 6c 69 73 74 2d 73 65 n/out. -list-se
1780: 72 76 65 72 73 20 20 20 20 20 20 20 20 20 20 20 rvers
1790: 3a 20 6c 69 73 74 20 74 68 65 20 73 65 72 76 65 : list the serve
17a0: 72 73 20 0a 20 20 2d 73 74 6f 70 2d 73 65 72 76 rs . -stop-serv
17b0: 65 72 20 69 64 20 20 20 20 20 20 20 20 20 3a 20 er id :
17c0: 73 74 6f 70 20 73 65 72 76 65 72 20 73 70 65 63 stop server spec
17d0: 69 66 69 65 64 20 62 79 20 69 64 20 28 73 65 65 ified by id (see
17e0: 20 6f 75 74 70 75 74 20 6f 66 20 2d 6c 69 73 74 output of -list
17f0: 2d 73 65 72 76 65 72 73 29 0a 20 20 2d 72 65 70 -servers). -rep
1800: 6c 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 l
1810: 20 20 20 20 3a 20 73 74 61 72 74 20 61 20 72 65 : start a re
1820: 70 6c 20 28 75 73 65 66 75 6c 20 66 6f 72 20 65 pl (useful for e
1830: 78 74 65 6e 64 69 6e 67 20 6d 65 67 61 74 65 73 xtending megates
1840: 74 29 0a 20 20 2d 6c 6f 61 64 20 66 69 6c 65 2e t). -load file.
1850: 73 63 6d 20 20 20 20 20 20 20 20 20 20 3a 20 6c scm : l
1860: 6f 61 64 20 61 6e 64 20 72 75 6e 20 66 69 6c 65 oad and run file
1870: 2e 73 63 6d 0a 0a 53 70 72 65 61 64 73 68 65 65 .scm..Spreadshee
1880: 74 20 67 65 6e 65 72 61 74 69 6f 6e 0a 20 20 2d t generation. -
1890: 65 78 74 72 61 63 74 2d 6f 64 73 20 66 6e 61 6d extract-ods fnam
18a0: 65 2e 6f 64 73 20 20 3a 20 65 78 74 72 61 63 74 e.ods : extract
18b0: 20 61 6e 20 6f 70 65 6e 20 64 6f 63 75 6d 65 6e an open documen
18c0: 74 20 73 70 72 65 61 64 73 68 65 65 74 20 66 72 t spreadsheet fr
18d0: 6f 6d 20 74 68 65 20 64 61 74 61 62 61 73 65 0a om the database.
18e0: 20 20 2d 70 61 74 68 6d 6f 64 20 70 61 74 68 20 -pathmod path
18f0: 20 20 20 20 20 20 20 20 20 20 3a 20 69 6e 73 65 : inse
1900: 72 74 20 70 61 74 68 2c 20 69 2e 65 2e 20 70 61 rt path, i.e. pa
1910: 74 68 2f 72 75 6e 61 6d 65 2f 69 74 65 6d 70 61 th/runame/itempa
1920: 74 68 2f 6c 6f 67 66 69 6c 65 2e 68 74 6d 6c 0a th/logfile.html.
1930: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1940: 20 20 20 20 20 20 20 20 20 20 20 20 77 69 6c 6c will
1950: 20 63 6c 65 61 72 20 74 68 65 20 66 69 65 6c 64 clear the field
1960: 20 69 66 20 6e 6f 20 72 75 6e 64 69 72 2f 74 65 if no rundir/te
1970: 73 74 6e 61 6d 65 2f 69 74 65 6d 70 61 74 68 2f stname/itempath/
1980: 6c 6f 67 66 69 6c 65 0a 20 20 20 20 20 20 20 20 logfile.
1990: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19a0: 20 20 20 20 69 66 20 69 74 20 63 6f 6e 74 61 69 if it contai
19b0: 6e 73 20 66 6f 72 77 61 72 64 20 73 6c 61 73 68 ns forward slash
19c0: 65 73 20 74 68 65 20 70 61 74 68 20 77 69 6c 6c es the path will
19d0: 20 62 65 20 63 6f 6e 76 65 72 74 65 64 0a 20 20 be converted.
19e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19f0: 20 20 20 20 20 20 20 20 20 20 74 6f 20 77 69 6e to win
1a00: 64 6f 77 73 20 73 74 79 6c 65 0a 47 65 74 74 69 dows style.Getti
1a10: 6e 67 20 73 74 61 72 74 65 64 0a 20 20 2d 67 65 ng started. -ge
1a20: 6e 2d 6d 65 67 61 74 65 73 74 2d 61 72 65 61 20 n-megatest-area
1a30: 20 20 20 20 20 20 3a 20 63 72 65 61 74 65 20 61 : create a
1a40: 20 73 6b 65 6c 65 74 6f 6e 20 6d 65 67 61 74 65 skeleton megate
1a50: 73 74 20 61 72 65 61 2e 20 59 6f 75 20 77 69 6c st area. You wil
1a60: 6c 20 62 65 20 70 72 6f 6d 70 74 65 64 20 66 6f l be prompted fo
1a70: 72 20 70 61 74 68 73 0a 20 20 2d 67 65 6e 2d 6d r paths. -gen-m
1a80: 65 67 61 74 65 73 74 2d 74 65 73 74 20 74 6e 61 egatest-test tna
1a90: 6d 65 20 3a 20 63 72 65 61 74 65 20 61 20 73 6b me : create a sk
1aa0: 65 6c 65 74 6f 6e 20 6d 65 67 61 74 65 73 74 20 eleton megatest
1ab0: 74 65 73 74 2e 20 59 6f 75 20 77 69 6c 6c 20 62 test. You will b
1ac0: 65 20 70 72 6f 6d 70 74 65 64 20 66 6f 72 20 69 e prompted for i
1ad0: 6e 66 6f 0a 0a 45 78 61 6d 70 6c 65 73 0a 0a 23 nfo..Examples..#
1ae0: 20 47 65 74 20 74 65 73 74 20 70 61 74 68 2c 20 Get test path,
1af0: 75 73 65 20 27 2e 27 20 74 6f 20 67 65 74 20 61 use '.' to get a
1b00: 20 73 69 6e 67 6c 65 20 70 61 74 68 20 6f 72 20 single path or
1b10: 61 20 73 70 65 63 69 66 69 63 20 70 61 74 68 2f a specific path/
1b20: 66 69 6c 65 20 70 61 74 74 65 72 6e 0a 6d 65 67 file pattern.meg
1b30: 61 74 65 73 74 20 2d 74 65 73 74 2d 66 69 6c 65 atest -test-file
1b40: 73 20 27 6c 6f 67 73 2f 2a 2e 6c 6f 67 27 20 2d s 'logs/*.log' -
1b50: 74 61 72 67 65 74 20 75 62 75 6e 74 75 2f 6e 25 target ubuntu/n%
1b60: 2f 6e 6f 25 20 3a 72 75 6e 6e 61 6d 65 20 77 34 /no% :runname w4
1b70: 39 25 20 2d 74 65 73 74 70 61 74 74 20 74 65 73 9% -testpatt tes
1b80: 74 5f 6d 74 25 0a 0a 43 61 6c 6c 65 64 20 61 73 t_mt%..Called as
1b90: 20 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 " (string-inter
1ba0: 73 70 65 72 73 65 20 28 61 72 67 76 29 20 22 20 sperse (argv) "
1bb0: 22 29 20 22 0a 56 65 72 73 69 6f 6e 20 22 20 6d ") ".Version " m
1bc0: 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 20 egatest-version
1bd0: 22 2c 20 62 75 69 6c 74 20 66 72 6f 6d 20 22 20 ", built from "
1be0: 6d 65 67 61 74 65 73 74 2d 66 6f 73 73 69 6c 2d megatest-fossil-
1bf0: 68 61 73 68 20 29 29 0a 0a 3b 3b 20 20 2d 67 75 hash ))..;; -gu
1c00: 69 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 i
1c10: 20 20 20 20 20 3a 20 73 74 61 72 74 20 61 20 67 : start a g
1c20: 75 69 20 69 6e 74 65 72 66 61 63 65 0a 3b 3b 20 ui interface.;;
1c30: 20 2d 63 6f 6e 66 69 67 20 66 6e 61 6d 65 20 20 -config fname
1c40: 20 20 20 20 20 20 20 20 20 3a 20 6f 76 65 72 72 : overr
1c50: 69 64 65 20 74 68 65 20 72 75 6e 63 6f 6e 66 69 ide the runconfi
1c60: 67 20 66 69 6c 65 20 77 69 74 68 20 66 6e 61 6d g file with fnam
1c70: 65 0a 0a 3b 3b 20 70 72 6f 63 65 73 73 20 61 72 e..;; process ar
1c80: 67 73 0a 28 64 65 66 69 6e 65 20 72 65 6d 61 72 gs.(define remar
1c90: 67 73 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 gs (args:get-arg
1ca0: 73 20 0a 09 09 20 28 61 72 67 76 29 0a 09 09 20 s ... (argv)...
1cb0: 28 6c 69 73 74 20 20 22 2d 72 75 6e 74 65 73 74 (list "-runtest
1cc0: 73 22 20 20 3b 3b 20 72 75 6e 20 61 20 73 70 65 s" ;; run a spe
1cd0: 63 69 66 69 63 20 74 65 73 74 0a 09 09 09 22 2d cific test...."-
1ce0: 63 6f 6e 66 69 67 22 20 20 20 20 3b 3b 20 6f 76 config" ;; ov
1cf0: 65 72 72 69 64 65 20 74 68 65 20 63 6f 6e 66 69 erride the confi
1d00: 67 20 66 69 6c 65 20 6e 61 6d 65 0a 09 09 09 22 g file name...."
1d10: 2d 65 78 65 63 75 74 65 22 20 20 20 3b 3b 20 72 -execute" ;; r
1d20: 75 6e 20 74 68 65 20 63 6f 6d 6d 61 6e 64 20 65 un the command e
1d30: 6e 63 6f 64 65 64 20 69 6e 20 74 68 65 20 62 61 ncoded in the ba
1d40: 73 65 36 34 20 70 61 72 61 6d 65 74 65 72 0a 09 se64 parameter..
1d50: 09 09 22 2d 73 74 65 70 22 0a 09 09 09 22 3a 72 .."-step"....":r
1d60: 75 6e 6e 61 6d 65 22 20 20 20 0a 09 09 09 22 2d unname" ...."-
1d70: 74 61 72 67 65 74 22 0a 09 09 09 22 2d 72 65 71 target"...."-req
1d80: 74 61 72 67 22 0a 09 09 09 22 3a 72 75 6e 6e 61 targ"....":runna
1d90: 6d 65 22 0a 09 09 09 22 2d 72 75 6e 6e 61 6d 65 me"...."-runname
1da0: 22 0a 09 09 09 22 3a 73 74 61 74 65 22 20 20 0a "....":state" .
1db0: 09 09 09 22 2d 73 74 61 74 65 22 0a 09 09 09 22 ..."-state"...."
1dc0: 3a 73 74 61 74 75 73 22 0a 09 09 09 22 2d 73 74 :status"...."-st
1dd0: 61 74 75 73 22 0a 09 09 09 22 2d 6c 69 73 74 2d atus"...."-list-
1de0: 72 75 6e 73 22 0a 09 09 09 22 2d 74 65 73 74 70 runs"...."-testp
1df0: 61 74 74 22 20 0a 09 09 09 22 2d 69 74 65 6d 70 att" ...."-itemp
1e00: 61 74 74 22 0a 09 09 09 22 2d 73 65 74 6c 6f 67 att"...."-setlog
1e10: 22 0a 09 09 09 22 2d 73 65 74 2d 74 6f 70 6c 6f "...."-set-toplo
1e20: 67 22 0a 09 09 09 22 2d 72 75 6e 73 74 65 70 22 g"...."-runstep"
1e30: 0a 09 09 09 22 2d 6c 6f 67 70 72 6f 22 0a 09 09 ...."-logpro"...
1e40: 09 22 2d 6d 22 0a 09 09 09 22 2d 72 65 72 75 6e ."-m"...."-rerun
1e50: 22 0a 09 09 09 22 2d 64 61 79 73 22 0a 09 09 09 "...."-days"....
1e60: 22 2d 72 65 6e 61 6d 65 2d 72 75 6e 22 0a 09 09 "-rename-run"...
1e70: 09 22 2d 74 6f 22 0a 09 09 09 3b 3b 20 76 61 6c ."-to"....;; val
1e80: 75 65 73 20 61 6e 64 20 6d 65 73 73 61 67 65 73 ues and messages
1e90: 0a 09 09 09 22 3a 63 61 74 65 67 6f 72 79 22 0a ....":category".
1ea0: 09 09 09 22 3a 76 61 72 69 61 62 6c 65 22 0a 09 ...":variable"..
1eb0: 09 09 22 3a 76 61 6c 75 65 22 0a 09 09 09 22 3a ..":value"....":
1ec0: 65 78 70 65 63 74 65 64 22 0a 09 09 09 22 3a 74 expected"....":t
1ed0: 6f 6c 22 0a 09 09 09 22 3a 75 6e 69 74 73 22 0a ol"....":units".
1ee0: 09 09 09 3b 3b 20 6d 69 73 63 0a 09 09 09 22 2d ...;; misc...."-
1ef0: 73 65 72 76 65 72 22 0a 09 09 09 22 2d 74 72 61 server"...."-tra
1f00: 6e 73 70 6f 72 74 22 0a 09 09 09 22 2d 73 74 6f nsport"...."-sto
1f10: 70 2d 73 65 72 76 65 72 22 0a 09 09 09 22 2d 70 p-server"...."-p
1f20: 6f 72 74 22 0a 09 09 09 22 2d 65 78 74 72 61 63 ort"...."-extrac
1f30: 74 2d 6f 64 73 22 0a 09 09 09 22 2d 70 61 74 68 t-ods"...."-path
1f40: 6d 6f 64 22 0a 09 09 09 22 2d 65 6e 76 32 66 69 mod"...."-env2fi
1f50: 6c 65 22 0a 09 09 09 22 2d 73 65 74 76 61 72 73 le"...."-setvars
1f60: 22 0a 09 09 09 22 2d 73 65 74 2d 73 74 61 74 65 "...."-set-state
1f70: 2d 73 74 61 74 75 73 22 0a 09 09 09 22 2d 64 65 -status"...."-de
1f80: 62 75 67 22 20 3b 3b 20 66 6f 72 20 2a 76 65 72 bug" ;; for *ver
1f90: 62 6f 73 69 74 79 2a 20 3e 20 32 0a 09 09 09 22 bosity* > 2...."
1fa0: 2d 67 65 6e 2d 6d 65 67 61 74 65 73 74 2d 74 65 -gen-megatest-te
1fb0: 73 74 22 0a 09 09 09 22 2d 6f 76 65 72 72 69 64 st"...."-overrid
1fc0: 65 2d 74 69 6d 65 6f 75 74 22 0a 09 09 09 22 2d e-timeout"...."-
1fd0: 74 65 73 74 2d 66 69 6c 65 73 22 20 20 3b 3b 20 test-files" ;;
1fe0: 2d 74 65 73 74 2d 70 61 74 68 73 20 69 73 20 66 -test-paths is f
1ff0: 6f 72 20 6c 69 73 74 69 6e 67 20 61 6c 6c 0a 09 or listing all..
2000: 09 09 22 2d 6c 6f 61 64 22 20 20 20 20 20 20 20 .."-load"
2010: 20 3b 3b 20 6c 6f 61 64 20 61 6e 64 20 65 78 65 ;; load and exe
2020: 63 74 75 74 65 20 61 20 73 63 68 65 6d 65 20 66 ctute a scheme f
2030: 69 6c 65 0a 09 09 09 22 2d 64 75 6d 70 6d 6f 64 ile...."-dumpmod
2040: 65 22 0a 09 09 09 29 20 0a 09 09 20 28 6c 69 73 e"....) ... (lis
2050: 74 20 20 22 2d 68 22 0a 09 09 09 22 2d 76 65 72 t "-h"...."-ver
2060: 73 69 6f 6e 22 0a 09 09 20 20 20 20 20 20 20 20 sion"...
2070: 22 2d 66 6f 72 63 65 22 0a 09 09 20 20 20 20 20 "-force"...
2080: 20 20 20 22 2d 78 74 65 72 6d 22 0a 09 09 20 20 "-xterm"...
2090: 20 20 20 20 20 20 22 2d 73 68 6f 77 6b 65 79 73 "-showkeys
20a0: 22 0a 09 09 20 20 20 20 20 20 20 20 22 2d 74 65 "... "-te
20b0: 73 74 2d 73 74 61 74 75 73 22 0a 09 09 09 22 2d st-status"...."-
20c0: 73 65 74 2d 76 61 6c 75 65 73 22 0a 09 09 09 22 set-values"...."
20d0: 2d 6c 6f 61 64 2d 74 65 73 74 2d 64 61 74 61 22 -load-test-data"
20e0: 0a 09 09 09 22 2d 73 75 6d 6d 61 72 69 7a 65 2d ...."-summarize-
20f0: 69 74 65 6d 73 22 0a 09 09 20 20 20 20 20 20 20 items"...
2100: 20 22 2d 67 75 69 22 0a 09 09 09 22 2d 64 61 65 "-gui"...."-dae
2110: 6d 6f 6e 69 7a 65 22 0a 09 09 09 3b 3b 20 6d 69 monize"....;; mi
2120: 73 63 0a 09 09 09 22 2d 61 72 63 68 69 76 65 22 sc...."-archive"
2130: 0a 09 09 09 22 2d 72 65 70 6c 22 0a 09 09 09 22 ...."-repl"...."
2140: 2d 6c 6f 63 6b 22 0a 09 09 09 22 2d 75 6e 6c 6f -lock"...."-unlo
2150: 63 6b 22 0a 09 09 09 22 2d 6c 69 73 74 2d 73 65 ck"...."-list-se
2160: 72 76 65 72 73 22 0a 09 09 09 3b 3b 20 6d 69 73 rvers"....;; mis
2170: 74 20 71 75 65 72 69 65 73 0a 09 09 09 22 2d 6c t queries...."-l
2180: 69 73 74 2d 64 69 73 6b 73 22 0a 09 09 09 22 2d ist-disks"...."-
2190: 6c 69 73 74 2d 74 61 72 67 65 74 73 22 0a 09 09 list-targets"...
21a0: 09 22 2d 6c 69 73 74 2d 64 62 2d 74 61 72 67 65 ."-list-db-targe
21b0: 74 73 22 0a 09 09 09 22 2d 73 68 6f 77 2d 72 75 ts"...."-show-ru
21c0: 6e 63 6f 6e 66 69 67 22 0a 09 09 09 22 2d 73 68 nconfig"...."-sh
21d0: 6f 77 2d 63 6f 6e 66 69 67 22 0a 09 09 09 3b 3b ow-config"....;;
21e0: 20 71 75 65 72 69 65 73 0a 09 09 09 22 2d 74 65 queries...."-te
21f0: 73 74 2d 70 61 74 68 73 22 20 3b 3b 20 67 65 74 st-paths" ;; get
2200: 20 70 61 74 68 28 73 29 20 74 6f 20 61 20 74 65 path(s) to a te
2210: 73 74 2c 20 6f 72 64 65 72 65 64 20 62 79 20 79 st, ordered by y
2220: 6f 75 6e 67 65 73 74 20 66 69 72 73 74 0a 0a 09 oungest first...
2230: 09 09 22 2d 72 75 6e 61 6c 6c 22 20 20 20 20 3b .."-runall" ;
2240: 3b 20 72 75 6e 20 61 6c 6c 20 74 65 73 74 73 0a ; run all tests.
2250: 09 09 09 22 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 ..."-remove-runs
2260: 22 0a 09 09 09 22 2d 72 65 62 75 69 6c 64 2d 64 "...."-rebuild-d
2270: 62 22 0a 09 09 09 22 2d 72 6f 6c 6c 75 70 22 0a b"...."-rollup".
2280: 09 09 09 22 2d 75 70 64 61 74 65 2d 6d 65 74 61 ..."-update-meta
2290: 22 0a 09 09 09 22 2d 67 65 6e 2d 6d 65 67 61 74 "...."-gen-megat
22a0: 65 73 74 2d 61 72 65 61 22 0a 0a 09 09 09 22 2d est-area"....."-
22b0: 6c 6f 67 67 69 6e 67 22 0a 09 09 09 22 2d 76 22 logging"...."-v"
22c0: 20 3b 3b 20 76 65 72 62 6f 73 65 20 32 2c 20 6d ;; verbose 2, m
22d0: 6f 72 65 20 74 68 61 6e 20 6e 6f 72 6d 61 6c 20 ore than normal
22e0: 28 6e 6f 72 6d 61 6c 20 69 73 20 31 29 0a 09 09 (normal is 1)...
22f0: 09 22 2d 71 22 20 3b 3b 20 71 75 69 65 74 20 30 ."-q" ;; quiet 0
2300: 2c 20 65 72 72 6f 72 73 2f 77 61 72 6e 69 6e 67 , errors/warning
2310: 73 20 6f 6e 6c 79 0a 09 09 20 20 20 20 20 20 20 s only...
2320: 29 0a 09 09 20 61 72 67 73 3a 61 72 67 2d 68 61 )... args:arg-ha
2330: 73 68 0a 09 09 20 30 29 29 0a 0a 28 69 66 20 28 sh... 0))..(if (
2340: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 68 args:get-arg "-h
2350: 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 "). (begin.
2360: 20 20 20 20 28 70 72 69 6e 74 20 68 65 6c 70 29 (print help)
2370: 0a 20 20 20 20 20 20 28 65 78 69 74 29 29 29 0a . (exit))).
2380: 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
2390: 72 67 20 22 2d 76 65 72 73 69 6f 6e 22 29 0a 20 rg "-version").
23a0: 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 (begin.
23b0: 28 70 72 69 6e 74 20 6d 65 67 61 74 65 73 74 2d (print megatest-
23c0: 76 65 72 73 69 6f 6e 29 0a 20 20 20 20 20 20 28 version). (
23d0: 65 78 69 74 29 29 29 0a 0a 28 64 65 66 69 6e 65 exit)))..(define
23e0: 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 *didsomething*
23f0: 23 66 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d #f)..;;=========
2400: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2410: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2420: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2430: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
2440: 20 4d 69 73 63 20 73 65 74 75 70 20 73 74 75 66 Misc setup stuf
2450: 66 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d f.;;============
2460: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2470: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2480: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2490: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 62 ==========..(deb
24a0: 75 67 3a 73 65 74 75 70 29 0a 0a 28 69 66 20 28 ug:setup)..(if (
24b0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c args:get-arg "-l
24c0: 6f 67 67 69 6e 67 22 29 28 73 65 74 21 20 2a 6c ogging")(set! *l
24d0: 6f 67 67 69 6e 67 2a 20 23 74 29 29 0a 0a 28 69 ogging* #t))..(i
24e0: 66 20 28 64 65 62 75 67 3a 64 65 62 75 67 2d 6d f (debug:debug-m
24f0: 6f 64 65 20 33 29 20 3b 3b 20 77 65 20 61 72 65 ode 3) ;; we are
2500: 20 6f 62 76 69 6f 75 73 6c 79 20 64 65 62 75 67 obviously debug
2510: 67 69 6e 67 0a 20 20 20 20 28 73 65 74 21 20 6f ging. (set! o
2520: 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 6f 70 pen-run-close op
2530: 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 2d 6e 6f 2d en-run-close-no-
2540: 65 78 63 65 70 74 69 6f 6e 2d 68 61 6e 64 6c 69 exception-handli
2550: 6e 67 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a ng))..(if (args:
2560: 67 65 74 2d 61 72 67 20 22 2d 69 74 65 6d 70 61 get-arg "-itempa
2570: 74 74 22 29 0a 20 20 20 20 28 6c 65 74 20 28 28 tt"). (let ((
2580: 6e 65 77 76 61 6c 20 28 63 6f 6e 63 20 28 61 72 newval (conc (ar
2590: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 gs:get-arg "-tes
25a0: 74 70 61 74 74 22 29 20 22 2f 22 20 28 61 72 67 tpatt") "/" (arg
25b0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 69 74 65 6d s:get-arg "-item
25c0: 70 61 74 74 22 29 29 29 29 0a 20 20 20 20 20 20 patt")))).
25d0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
25e0: 57 41 52 4e 49 4e 47 3a 20 2d 69 74 65 6d 70 61 WARNING: -itempa
25f0: 74 74 20 68 61 73 20 62 65 65 6e 20 64 65 70 72 tt has been depr
2600: 65 63 61 74 65 64 2c 20 70 6c 65 61 73 65 20 75 ecated, please u
2610: 73 65 20 2d 74 65 73 74 70 61 74 74 20 74 65 73 se -testpatt tes
2620: 74 70 61 74 74 2f 69 74 65 6d 70 61 74 74 20 6d tpatt/itempatt m
2630: 65 74 68 6f 64 2c 20 6e 65 77 20 74 65 73 74 70 ethod, new testp
2640: 61 74 74 20 69 73 20 22 6e 65 77 76 61 6c 29 0a att is "newval).
2650: 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c (hash-tabl
2660: 65 2d 73 65 74 21 20 61 72 67 73 3a 61 72 67 2d e-set! args:arg-
2670: 68 61 73 68 20 22 2d 74 65 73 74 70 61 74 74 22 hash "-testpatt"
2680: 20 6e 65 77 76 61 6c 29 0a 20 20 20 20 20 20 28 newval). (
2690: 68 61 73 68 2d 74 61 62 6c 65 2d 64 65 6c 65 74 hash-table-delet
26a0: 65 21 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 e! args:arg-hash
26b0: 20 22 2d 69 74 65 6d 70 61 74 74 22 29 29 29 0a "-itempatt"))).
26c0: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
26d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
26e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
26f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2700: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4d 69 73 =========.;; Mis
2710: 63 20 67 65 6e 65 72 61 6c 20 63 61 6c 6c 73 0a c general calls.
2720: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
2730: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2740: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2750: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2760: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 ========..(if (a
2770: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 6e rgs:get-arg "-en
2780: 76 32 66 69 6c 65 22 29 0a 20 20 20 20 28 62 65 v2file"). (be
2790: 67 69 6e 0a 20 20 20 20 20 20 28 73 61 76 65 2d gin. (save-
27a0: 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 61 73 2d 66 environment-as-f
27b0: 69 6c 65 73 20 28 61 72 67 73 3a 67 65 74 2d 61 iles (args:get-a
27c0: 72 67 20 22 2d 65 6e 76 32 66 69 6c 65 22 29 29 rg "-env2file"))
27d0: 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 . (set! *di
27e0: 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 dsomething* #t))
27f0: 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 )..(if (args:get
2800: 2d 61 72 67 20 22 2d 6c 69 73 74 2d 64 69 73 6b -arg "-list-disk
2810: 73 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 s"). (begin.
2820: 20 20 20 20 20 28 70 72 69 6e 74 20 0a 20 20 20 (print .
2830: 20 20 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 (string-inte
2840: 72 73 70 65 72 73 65 20 0a 09 28 6d 61 70 20 28 rsperse ..(map (
2850: 6c 61 6d 62 64 61 20 28 78 29 0a 09 20 20 20 20 lambda (x)..
2860: 20 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 (string-inter
2870: 73 70 65 72 73 65 20 0a 09 09 78 0a 09 09 22 20 sperse ...x..."
2880: 3d 3e 20 22 29 29 0a 09 20 20 20 20 20 28 63 6f => ")).. (co
2890: 6d 6d 6f 6e 3a 67 65 74 2d 64 69 73 6b 73 29 20 mmon:get-disks)
28a0: 29 0a 09 22 5c 6e 22 29 29 0a 20 20 20 20 20 20 ).."\n")).
28b0: 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
28c0: 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d ing* #t)))..;;==
28d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
28e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
28f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2900: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2910: 3d 3d 3d 3d 0a 3b 3b 20 53 74 61 72 74 20 74 68 ====.;; Start th
2920: 65 20 73 65 72 76 65 72 20 2d 20 63 61 6e 20 62 e server - can b
2930: 65 20 64 6f 6e 65 20 69 6e 20 63 6f 6e 6a 75 6e e done in conjun
2940: 63 74 69 6f 6e 20 77 69 74 68 20 2d 72 75 6e 61 ction with -runa
2950: 6c 6c 20 6f 72 20 2d 72 75 6e 74 65 73 74 73 20 ll or -runtests
2960: 28 6f 6e 65 20 64 61 79 2e 2e 2e 29 0a 3b 3b 20 (one day...).;;
2970: 20 20 77 65 20 73 74 61 72 74 20 74 68 65 20 73 we start the s
2980: 65 72 76 65 72 20 69 66 20 6e 6f 74 20 72 75 6e erver if not run
2990: 6e 69 6e 67 20 65 6c 73 65 20 73 74 61 72 74 20 ning else start
29a0: 74 68 65 20 63 6c 69 65 6e 74 20 74 68 72 65 61 the client threa
29b0: 64 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d d.;;============
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 3d 3d 3d ================
29e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
29f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 ==========..(if
2a00: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
2a10: 73 65 72 76 65 72 22 29 0a 20 20 20 20 28 6c 65 server"). (le
2a20: 74 20 28 28 74 72 61 6e 73 70 6f 72 74 20 28 61 t ((transport (a
2a30: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 72 rgs:get-arg "-tr
2a40: 61 6e 73 70 6f 72 74 22 20 22 68 74 74 70 22 29 ansport" "http")
2a50: 29 29 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a )). (debug:
2a60: 70 72 69 6e 74 20 32 20 22 4c 61 75 6e 63 68 69 print 2 "Launchi
2a70: 6e 67 20 73 65 72 76 65 72 20 75 73 69 6e 67 20 ng server using
2a80: 74 72 61 6e 73 70 6f 72 74 20 22 20 74 72 61 6e transport " tran
2a90: 73 70 6f 72 74 29 0a 20 20 20 20 20 20 28 73 65 sport). (se
2aa0: 72 76 65 72 3a 6c 61 75 6e 63 68 20 28 73 74 72 rver:launch (str
2ab0: 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 74 72 61 6e ing->symbol tran
2ac0: 73 70 6f 72 74 29 29 29 0a 20 20 20 20 28 69 66 sport))). (if
2ad0: 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 28 6c 73 (not (null? (ls
2ae0: 65 74 2d 69 6e 74 65 72 73 65 63 74 69 6f 6e 20 et-intersection
2af0: 0a 09 09 20 20 20 20 20 65 71 75 61 6c 3f 0a 09 ... equal?..
2b00: 09 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c . (hash-tabl
2b10: 65 2d 6b 65 79 73 20 61 72 67 73 3a 61 72 67 2d e-keys args:arg-
2b20: 68 61 73 68 29 0a 09 09 20 20 20 20 20 27 28 22 hash)... '("
2b30: 2d 72 75 6e 74 65 73 74 73 22 20 20 20 20 22 2d -runtests" "-
2b40: 6c 69 73 74 2d 72 75 6e 73 22 20 20 20 22 2d 72 list-runs" "-r
2b50: 6f 6c 6c 75 70 22 0a 09 09 20 20 20 20 20 20 20 ollup"...
2b60: 22 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 22 20 22 "-remove-runs" "
2b70: 2d 6c 6f 63 6b 22 20 20 20 20 20 20 20 20 22 2d -lock" "-
2b80: 75 6e 6c 6f 63 6b 22 0a 09 09 20 20 20 20 20 20 unlock"...
2b90: 20 22 2d 75 70 64 61 74 65 2d 6d 65 74 61 22 20 "-update-meta"
2ba0: 22 2d 65 78 74 72 61 63 74 2d 6f 64 73 22 29 29 "-extract-ods"))
2bb0: 29 29 0a 09 28 69 66 20 28 73 65 74 75 70 2d 66 ))..(if (setup-f
2bc0: 6f 72 2d 72 75 6e 29 0a 09 20 20 20 20 28 6c 65 or-run).. (le
2bd0: 74 20 6c 6f 6f 70 20 28 28 73 65 72 76 65 72 73 t loop ((servers
2be0: 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 (open-run-clos
2bf0: 65 20 74 61 73 6b 73 3a 67 65 74 2d 62 65 73 74 e tasks:get-best
2c00: 2d 73 65 72 76 65 72 20 74 61 73 6b 73 3a 6f 70 -server tasks:op
2c10: 65 6e 2d 64 62 29 29 0a 09 09 20 20 20 20 20 20 en-db))...
2c20: 20 28 74 72 79 63 6f 75 6e 74 20 30 29 29 0a 09 (trycount 0))..
2c30: 20 20 20 20 20 20 28 69 66 20 28 6f 72 20 28 6e (if (or (n
2c40: 6f 74 20 73 65 72 76 65 72 73 29 0a 09 09 20 20 ot servers)...
2c50: 20 20 20 20 28 6e 75 6c 6c 3f 20 73 65 72 76 65 (null? serve
2c60: 72 73 29 29 0a 09 09 20 20 28 62 65 67 69 6e 0a rs))... (begin.
2c70: 09 09 20 20 20 20 28 69 66 20 28 65 71 3f 20 74 .. (if (eq? t
2c80: 72 79 63 6f 75 6e 74 20 30 29 20 3b 3b 20 6a 75 rycount 0) ;; ju
2c90: 73 74 20 64 6f 20 74 68 65 20 73 65 72 76 65 72 st do the server
2ca0: 20 73 74 61 72 74 20 6f 6e 63 65 0a 09 09 09 28 start once....(
2cb0: 62 65 67 69 6e 0a 09 09 09 20 20 28 64 65 62 75 begin.... (debu
2cc0: 67 3a 70 72 69 6e 74 20 30 20 22 49 4e 46 4f 3a g:print 0 "INFO:
2cd0: 20 53 74 61 72 74 69 6e 67 20 73 65 72 76 65 72 Starting server
2ce0: 20 61 73 20 6e 6f 6e 65 20 72 75 6e 6e 69 6e 67 as none running
2cf0: 20 2e 2e 2e 22 29 0a 09 09 09 20 20 3b 3b 20 28 ...").... ;; (
2d00: 73 65 72 76 65 72 3a 6c 61 75 6e 63 68 20 28 73 server:launch (s
2d10: 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 28 61 tring->symbol (a
2d20: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 72 rgs:get-arg "-tr
2d30: 61 6e 73 70 6f 72 74 22 20 22 68 74 74 70 22 29 ansport" "http")
2d40: 29 29 29 0a 09 09 09 20 20 3b 3b 20 28 70 72 6f ))).... ;; (pro
2d50: 63 65 73 73 2d 72 75 6e 20 28 63 61 72 20 28 61 cess-run (car (a
2d60: 72 67 76 29 29 20 28 6c 69 73 74 20 22 2d 73 65 rgv)) (list "-se
2d70: 72 76 65 72 22 20 22 2d 22 20 22 2d 64 61 65 6d rver" "-" "-daem
2d80: 6f 6e 69 7a 65 22 20 22 2d 74 72 61 6e 73 70 6f onize" "-transpo
2d90: 72 74 22 20 28 61 72 67 73 3a 67 65 74 2d 61 72 rt" (args:get-ar
2da0: 67 20 22 2d 74 72 61 6e 73 70 6f 72 74 22 20 22 g "-transport" "
2db0: 68 74 74 70 22 29 29 29 0a 09 09 09 20 20 28 70 http"))).... (p
2dc0: 72 6f 63 65 73 73 2d 66 6f 72 6b 20 28 6c 61 6d rocess-fork (lam
2dd0: 62 64 61 20 28 29 0a 09 09 09 09 09 20 20 28 64 bda ()...... (d
2de0: 61 65 6d 6f 6e 3a 69 7a 65 29 0a 09 09 09 09 09 aemon:ize)......
2df0: 20 20 28 73 65 72 76 65 72 3a 6c 61 75 6e 63 68 (server:launch
2e00: 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c (string->symbol
2e10: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
2e20: 2d 74 72 61 6e 73 70 6f 72 74 22 20 22 68 74 74 -transport" "htt
2e30: 70 22 29 29 29 29 29 0a 09 09 09 20 20 28 74 68 p"))))).... (th
2e40: 72 65 61 64 2d 73 6c 65 65 70 21 20 33 29 29 0a read-sleep! 3)).
2e50: 09 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d ...(debug:print-
2e60: 69 6e 66 6f 20 30 20 22 57 61 69 74 69 6e 67 20 info 0 "Waiting
2e70: 66 6f 72 20 73 65 72 76 65 72 20 74 6f 20 73 74 for server to st
2e80: 61 72 74 22 29 29 0a 09 09 20 20 20 20 28 6c 6f art"))... (lo
2e90: 6f 70 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f op (open-run-clo
2ea0: 73 65 20 74 61 73 6b 73 3a 67 65 74 2d 62 65 73 se tasks:get-bes
2eb0: 74 2d 73 65 72 76 65 72 20 74 61 73 6b 73 3a 6f t-server tasks:o
2ec0: 70 65 6e 2d 64 62 29 20 0a 09 09 09 20 20 28 2b pen-db) .... (+
2ed0: 20 74 72 79 63 6f 75 6e 74 20 31 29 29 29 0a 09 trycount 1)))..
2ee0: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 . (debug:print
2ef0: 30 20 22 49 4e 46 4f 3a 20 53 65 72 76 65 72 28 0 "INFO: Server(
2f00: 73 29 20 72 75 6e 6e 69 6e 67 20 22 20 73 65 72 s) running " ser
2f10: 76 65 72 73 29 0a 09 09 20 20 29 29 29 29 29 0a vers)... ))))).
2f20: 0a 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 .(if (or (args:g
2f30: 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d 73 65 et-arg "-list-se
2f40: 72 76 65 72 73 22 29 0a 09 28 61 72 67 73 3a 67 rvers")..(args:g
2f50: 65 74 2d 61 72 67 20 22 2d 73 74 6f 70 2d 73 65 et-arg "-stop-se
2f60: 72 76 65 72 22 29 29 0a 20 20 20 20 28 6c 65 74 rver")). (let
2f70: 20 28 28 74 6c 20 28 73 65 74 75 70 2d 66 6f 72 ((tl (setup-for
2f80: 2d 72 75 6e 29 29 29 0a 20 20 20 20 20 20 28 69 -run))). (i
2f90: 66 20 74 6c 20 0a 09 20 20 28 6c 65 74 2a 20 28 f tl .. (let* (
2fa0: 28 73 65 72 76 65 72 73 20 28 6f 70 65 6e 2d 72 (servers (open-r
2fb0: 75 6e 2d 63 6c 6f 73 65 20 74 61 73 6b 73 3a 67 un-close tasks:g
2fc0: 65 74 2d 61 6c 6c 2d 73 65 72 76 65 72 73 20 74 et-all-servers t
2fd0: 61 73 6b 73 3a 6f 70 65 6e 2d 64 62 29 29 0a 09 asks:open-db))..
2fe0: 09 20 28 66 6d 74 73 74 72 20 20 22 7e 35 61 7e . (fmtstr "~5a~
2ff0: 38 61 7e 38 61 7e 32 30 61 7e 32 30 61 7e 31 30 8a~8a~20a~20a~10
3000: 61 7e 31 30 61 7e 31 30 61 7e 31 30 61 7e 31 30 a~10a~10a~10a~10
3010: 61 5c 6e 22 29 0a 09 09 20 28 73 65 72 76 65 72 a\n")... (server
3020: 73 2d 74 6f 2d 6b 69 6c 6c 20 27 28 29 29 0a 09 s-to-kill '())..
3030: 09 20 28 6b 69 6c 6c 69 6e 66 6f 20 20 20 28 61 . (killinfo (a
3040: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 rgs:get-arg "-st
3050: 6f 70 2d 73 65 72 76 65 72 22 29 29 0a 09 09 20 op-server"))...
3060: 28 6b 68 6f 73 74 2d 70 6f 72 74 20 28 69 66 20 (khost-port (if
3070: 6b 69 6c 6c 69 6e 66 6f 20 28 69 66 20 28 73 75 killinfo (if (su
3080: 62 73 74 72 69 6e 67 2d 69 6e 64 65 78 20 22 3a bstring-index ":
3090: 22 20 6b 69 6c 6c 69 6e 66 6f 29 28 73 74 72 69 " killinfo)(stri
30a0: 6e 67 2d 73 70 6c 69 74 20 22 3a 22 29 20 23 66 ng-split ":") #f
30b0: 29 20 23 66 29 29 0a 09 09 20 28 73 69 64 20 20 ) #f))... (sid
30c0: 20 20 20 20 20 20 28 69 66 20 6b 69 6c 6c 69 6e (if killin
30d0: 66 6f 20 28 69 66 20 28 73 75 62 73 74 72 69 6e fo (if (substrin
30e0: 67 2d 69 6e 64 65 78 20 22 3a 22 20 6b 69 6c 6c g-index ":" kill
30f0: 69 6e 66 6f 29 20 23 66 20 28 73 74 72 69 6e 67 info) #f (string
3100: 2d 3e 6e 75 6d 62 65 72 20 6b 69 6c 6c 69 6e 66 ->number killinf
3110: 6f 29 29 20 23 66 29 29 29 0a 09 20 20 20 20 28 o)) #f))).. (
3120: 66 6f 72 6d 61 74 20 23 74 20 66 6d 74 73 74 72 format #t fmtstr
3130: 20 22 49 64 22 20 22 4d 54 76 65 72 22 20 22 50 "Id" "MTver" "P
3140: 69 64 22 20 22 48 6f 73 74 22 20 22 49 6e 74 65 id" "Host" "Inte
3150: 72 66 61 63 65 22 20 22 4f 75 74 50 6f 72 74 22 rface" "OutPort"
3160: 20 22 49 6e 50 6f 72 74 22 20 22 4c 61 73 74 42 "InPort" "LastB
3170: 65 61 74 22 20 22 53 74 61 74 65 22 20 22 54 72 eat" "State" "Tr
3180: 61 6e 73 70 6f 72 74 22 29 0a 09 20 20 20 20 28 ansport").. (
3190: 66 6f 72 6d 61 74 20 23 74 20 66 6d 74 73 74 72 format #t fmtstr
31a0: 20 22 3d 3d 22 20 22 3d 3d 3d 3d 3d 22 20 22 3d "==" "=====" "=
31b0: 3d 3d 22 20 22 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d ==" "====" "====
31c0: 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 3d 3d 22 =====" "======="
31d0: 20 22 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d "======" "=====
31e0: 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 22 20 22 3d 3d ===" "=====" "==
31f0: 3d 3d 3d 3d 3d 3d 3d 22 29 0a 09 20 20 20 20 28 =======").. (
3200: 66 6f 72 2d 65 61 63 68 20 0a 09 20 20 20 20 20 for-each ..
3210: 28 6c 61 6d 62 64 61 20 28 73 65 72 76 65 72 29 (lambda (server)
3220: 0a 09 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 .. (let* (
3230: 28 69 64 20 20 20 20 20 20 20 20 20 28 76 65 63 (id (vec
3240: 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 30 tor-ref server 0
3250: 29 29 0a 09 09 20 20 20 20 20 20 28 70 69 64 20 ))... (pid
3260: 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 (vector-r
3270: 65 66 20 73 65 72 76 65 72 20 31 29 29 0a 09 09 ef server 1))...
3280: 20 20 20 20 20 20 28 68 6f 73 74 6e 61 6d 65 20 (hostname
3290: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 (vector-ref se
32a0: 72 76 65 72 20 32 29 29 0a 09 09 20 20 20 20 20 rver 2))...
32b0: 20 28 69 6e 74 65 72 66 61 63 65 20 20 28 76 65 (interface (ve
32c0: 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 ctor-ref server
32d0: 33 29 29 0a 09 09 20 20 20 20 20 20 28 70 75 6c 3))... (pul
32e0: 6c 70 6f 72 74 20 20 20 28 76 65 63 74 6f 72 2d lport (vector-
32f0: 72 65 66 20 73 65 72 76 65 72 20 34 29 29 0a 09 ref server 4))..
3300: 09 20 20 20 20 20 20 28 70 75 62 70 6f 72 74 20 . (pubport
3310: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 (vector-ref s
3320: 65 72 76 65 72 20 35 29 29 0a 09 09 20 20 20 20 erver 5))...
3330: 20 20 28 73 74 61 72 74 2d 74 69 6d 65 20 28 76 (start-time (v
3340: 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 ector-ref server
3350: 20 36 29 29 0a 09 09 20 20 20 20 20 20 28 70 72 6))... (pr
3360: 69 6f 72 69 74 79 20 20 20 28 76 65 63 74 6f 72 iority (vector
3370: 2d 72 65 66 20 73 65 72 76 65 72 20 37 29 29 0a -ref server 7)).
3380: 09 09 20 20 20 20 20 20 28 73 74 61 74 65 20 20 .. (state
3390: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (vector-ref
33a0: 73 65 72 76 65 72 20 38 29 29 0a 09 09 20 20 20 server 8))...
33b0: 20 20 20 28 6d 74 2d 76 65 72 20 20 20 20 20 28 (mt-ver (
33c0: 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 vector-ref serve
33d0: 72 20 39 29 29 0a 09 09 20 20 20 20 20 20 28 6c r 9))... (l
33e0: 61 73 74 2d 75 70 64 61 74 65 20 28 76 65 63 74 ast-update (vect
33f0: 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 31 30 or-ref server 10
3400: 29 29 20 3b 3b 20 20 20 28 6f 70 65 6e 2d 72 75 )) ;; (open-ru
3410: 6e 2d 63 6c 6f 73 65 20 74 61 73 6b 73 3a 73 65 n-close tasks:se
3420: 72 76 65 72 2d 61 6c 69 76 65 3f 20 74 61 73 6b rver-alive? task
3430: 73 3a 6f 70 65 6e 2d 64 62 20 23 66 20 68 6f 73 s:open-db #f hos
3440: 74 6e 61 6d 65 3a 20 68 6f 73 74 6e 61 6d 65 20 tname: hostname
3450: 70 6f 72 74 3a 20 70 6f 72 74 29 29 0a 09 09 20 port: port))...
3460: 20 20 20 20 20 28 74 72 61 6e 73 70 6f 72 74 20 (transport
3470: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 (vector-ref ser
3480: 76 65 72 20 31 31 29 29 0a 09 09 20 20 20 20 20 ver 11))...
3490: 20 28 6b 69 6c 6c 65 64 20 20 20 20 20 23 66 29 (killed #f)
34a0: 0a 09 09 20 20 20 20 20 20 28 73 74 61 74 75 73 ... (status
34b0: 20 20 20 20 20 28 3c 20 6c 61 73 74 2d 75 70 64 (< last-upd
34c0: 61 74 65 20 32 30 29 29 29 0a 09 09 20 3b 3b 20 ate 20)))... ;;
34d0: 20 20 28 7a 6d 71 2d 73 6f 63 6b 65 74 73 20 28 (zmq-sockets (
34e0: 69 66 20 73 74 61 74 75 73 20 28 73 65 72 76 65 if status (serve
34f0: 72 3a 63 6c 69 65 6e 74 2d 63 6f 6e 6e 65 63 74 r:client-connect
3500: 20 68 6f 73 74 6e 61 6d 65 20 70 6f 72 74 29 20 hostname port)
3510: 23 66 29 29 29 0a 09 09 20 3b 3b 20 6e 6f 20 6e #f)))... ;; no n
3520: 65 65 64 20 74 6f 20 6c 6f 67 69 6e 20 61 73 20 eed to login as
3530: 73 74 61 74 75 73 20 6f 66 20 23 74 20 69 6e 64 status of #t ind
3540: 69 63 61 74 65 73 20 77 65 20 61 72 65 20 63 6f icates we are co
3550: 6e 6e 65 63 74 69 6e 67 20 74 6f 20 63 6f 72 72 nnecting to corr
3560: 65 63 74 20 0a 09 09 20 3b 3b 20 73 65 72 76 65 ect ... ;; serve
3570: 72 0a 09 09 20 28 69 66 20 28 65 71 75 61 6c 3f r... (if (equal?
3580: 20 73 74 61 74 65 20 22 64 65 61 64 22 29 0a 09 state "dead")..
3590: 09 20 20 20 20 20 28 69 66 20 28 3e 20 6c 61 73 . (if (> las
35a0: 74 2d 75 70 64 61 74 65 20 28 2a 20 32 35 20 36 t-update (* 25 6
35b0: 30 20 36 30 29 29 20 3b 3b 20 6b 65 65 70 20 72 0 60)) ;; keep r
35c0: 65 63 6f 72 64 73 20 61 72 6f 75 6e 64 20 66 6f ecords around fo
35d0: 72 20 73 6c 69 67 68 6c 79 20 6f 76 65 72 20 61 r slighly over a
35e0: 20 64 61 79 2e 0a 09 09 09 20 28 6f 70 65 6e 2d day..... (open-
35f0: 72 75 6e 2d 63 6c 6f 73 65 20 74 61 73 6b 73 3a run-close tasks:
3600: 73 65 72 76 65 72 2d 64 65 72 65 67 69 73 74 65 server-deregiste
3610: 72 20 74 61 73 6b 73 3a 6f 70 65 6e 2d 64 62 20 r tasks:open-db
3620: 68 6f 73 74 6e 61 6d 65 20 70 75 6c 6c 70 6f 72 hostname pullpor
3630: 74 3a 20 70 75 6c 6c 70 6f 72 74 20 70 69 64 3a t: pullport pid:
3640: 20 70 69 64 20 61 63 74 69 6f 6e 3a 20 27 64 65 pid action: 'de
3650: 6c 65 74 65 29 29 0a 09 09 20 20 20 20 20 28 69 lete))... (i
3660: 66 20 28 3e 20 6c 61 73 74 2d 75 70 64 61 74 65 f (> last-update
3670: 20 32 30 29 20 20 20 20 20 20 20 20 3b 3b 20 4d 20) ;; M
3680: 61 72 6b 20 61 73 20 64 65 61 64 20 69 66 20 6e ark as dead if n
3690: 6f 74 20 75 70 64 61 74 65 64 20 69 6e 20 6c 61 ot updated in la
36a0: 73 74 20 32 30 20 73 65 63 6f 6e 64 73 0a 09 09 st 20 seconds...
36b0: 09 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 . (open-run-clos
36c0: 65 20 74 61 73 6b 73 3a 73 65 72 76 65 72 2d 64 e tasks:server-d
36d0: 65 72 65 67 69 73 74 65 72 20 74 61 73 6b 73 3a eregister tasks:
36e0: 6f 70 65 6e 2d 64 62 20 68 6f 73 74 6e 61 6d 65 open-db hostname
36f0: 20 70 75 6c 6c 70 6f 72 74 3a 20 70 75 6c 6c 70 pullport: pullp
3700: 6f 72 74 20 70 69 64 3a 20 70 69 64 29 29 29 0a ort pid: pid))).
3710: 09 09 20 28 66 6f 72 6d 61 74 20 23 74 20 66 6d .. (format #t fm
3720: 74 73 74 72 20 69 64 20 6d 74 2d 76 65 72 20 70 tstr id mt-ver p
3730: 69 64 20 68 6f 73 74 6e 61 6d 65 20 69 6e 74 65 id hostname inte
3740: 72 66 61 63 65 20 70 75 6c 6c 70 6f 72 74 20 70 rface pullport p
3750: 75 62 70 6f 72 74 20 6c 61 73 74 2d 75 70 64 61 ubport last-upda
3760: 74 65 0a 09 09 09 20 28 69 66 20 73 74 61 74 75 te.... (if statu
3770: 73 20 22 61 6c 69 76 65 22 20 22 64 65 61 64 22 s "alive" "dead"
3780: 29 20 74 72 61 6e 73 70 6f 72 74 29 0a 09 09 20 ) transport)...
3790: 28 69 66 20 28 65 71 75 61 6c 3f 20 69 64 20 73 (if (equal? id s
37a0: 69 64 29 0a 09 09 20 20 20 20 20 28 62 65 67 69 id)... (begi
37b0: 6e 0a 09 09 20 20 20 20 20 20 20 28 64 65 62 75 n... (debu
37c0: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 22 g:print-info 0 "
37d0: 41 74 74 65 6d 70 74 69 6e 67 20 74 6f 20 73 74 Attempting to st
37e0: 6f 70 20 73 65 72 76 65 72 20 77 69 74 68 20 70 op server with p
37f0: 69 64 20 22 20 70 69 64 29 0a 09 09 20 20 20 20 id " pid)...
3800: 20 20 20 28 74 61 73 6b 73 3a 6b 69 6c 6c 2d 73 (tasks:kill-s
3810: 65 72 76 65 72 20 73 74 61 74 75 73 20 68 6f 73 erver status hos
3820: 74 6e 61 6d 65 20 70 75 6c 6c 70 6f 72 74 20 70 tname pullport p
3830: 69 64 20 74 72 61 6e 73 70 6f 72 74 29 29 29 29 id transport))))
3840: 29 0a 09 20 20 20 20 20 73 65 72 76 65 72 73 29 ).. servers)
3850: 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 .. (debug:pri
3860: 6e 74 2d 69 6e 66 6f 20 31 20 22 44 6f 6e 65 20 nt-info 1 "Done
3870: 77 69 74 68 20 6c 69 73 74 73 65 72 76 65 72 73 with listservers
3880: 22 29 0a 09 20 20 20 20 28 73 65 74 21 20 2a 64 ").. (set! *d
3890: 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
38a0: 0a 09 20 20 20 20 28 65 78 69 74 29 29 20 3b 3b .. (exit)) ;;
38b0: 20 6d 75 73 74 20 64 6f 2c 20 77 6f 75 6c 64 20 must do, would
38c0: 68 61 76 65 20 74 6f 20 61 64 64 20 63 68 65 63 have to add chec
38d0: 6b 73 20 74 6f 20 6d 61 6e 79 2f 61 6c 6c 20 63 ks to many/all c
38e0: 61 6c 6c 73 20 62 65 6c 6f 77 0a 09 20 20 28 65 alls below.. (e
38f0: 78 69 74 29 29 29 0a 20 20 20 20 3b 3b 20 69 66 xit))). ;; if
3900: 20 6e 6f 74 20 6c 69 73 74 20 6f 72 20 6b 69 6c not list or kil
3910: 6c 20 74 68 65 6e 20 73 74 61 72 74 20 61 20 63 l then start a c
3920: 6c 69 65 6e 74 20 28 69 66 20 61 70 70 72 6f 70 lient (if approp
3930: 72 69 61 74 65 29 0a 20 20 20 20 28 69 66 20 28 riate). (if (
3940: 6f 72 20 28 61 72 67 73 2d 64 65 66 69 6e 65 64 or (args-defined
3950: 3f 20 22 2d 68 22 20 22 2d 76 65 72 73 69 6f 6e ? "-h" "-version
3960: 22 20 22 2d 67 65 6e 2d 6d 65 67 61 74 65 73 74 " "-gen-megatest
3970: 2d 61 72 65 61 22 20 22 2d 67 65 6e 2d 6d 65 67 -area" "-gen-meg
3980: 61 74 65 73 74 2d 74 65 73 74 22 29 0a 09 20 20 atest-test")..
3990: 20 20 28 65 71 3f 20 28 6c 65 6e 67 74 68 20 28 (eq? (length (
39a0: 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 hash-table-keys
39b0: 61 72 67 73 3a 61 72 67 2d 68 61 73 68 29 29 20 args:arg-hash))
39c0: 30 29 29 0a 09 28 64 65 62 75 67 3a 70 72 69 6e 0))..(debug:prin
39d0: 74 2d 69 6e 66 6f 20 31 20 22 53 65 72 76 65 72 t-info 1 "Server
39e0: 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 6e 6f 74 20 connection not
39f0: 6e 65 65 64 65 64 22 29 0a 09 3b 3b 20 6f 6b 2c needed")..;; ok,
3a00: 20 73 6f 20 6c 65 74 73 20 63 6f 6e 6e 65 63 74 so lets connect
3a10: 20 74 6f 20 74 68 65 20 73 65 72 76 65 72 0a 09 to the server..
3a20: 28 63 6c 69 65 6e 74 3a 6c 61 75 6e 63 68 29 29 (client:launch))
3a30: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
3a40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3a50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3a60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3a70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 57 ===========.;; W
3a80: 65 69 72 64 20 73 70 65 63 69 61 6c 20 63 61 6c eird special cal
3a90: 6c 73 20 74 68 61 74 20 6e 65 65 64 20 74 6f 20 ls that need to
3aa0: 72 75 6e 20 2a 61 66 74 65 72 2a 20 74 68 65 20 run *after* the
3ab0: 73 65 72 76 65 72 20 68 61 73 20 73 74 61 72 74 server has start
3ac0: 65 64 3f 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ed?.;;==========
3ad0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3ae0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3af0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3b00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 ============..(i
3b10: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
3b20: 22 2d 6c 69 73 74 2d 74 61 72 67 65 74 73 22 29 "-list-targets")
3b30: 0a 20 20 20 20 28 6c 65 74 20 28 28 74 61 72 67 . (let ((targ
3b40: 65 74 73 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d ets (common:get-
3b50: 72 75 6e 63 6f 6e 66 69 67 2d 74 61 72 67 65 74 runconfig-target
3b60: 73 29 29 29 0a 20 20 20 20 20 20 28 70 72 69 6e s))). (prin
3b70: 74 20 22 46 6f 75 6e 64 20 22 28 6c 65 6e 67 74 t "Found "(lengt
3b80: 68 20 74 61 72 67 65 74 73 29 20 22 20 74 61 72 h targets) " tar
3b90: 67 65 74 73 22 29 0a 20 20 20 20 20 20 28 66 6f gets"). (fo
3ba0: 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 r-each (lambda (
3bb0: 78 29 0a 09 09 20 20 3b 3b 20 28 70 72 69 6e 74 x)... ;; (print
3bc0: 20 22 5b 22 20 78 20 22 5d 22 29 29 0a 09 09 20 "[" x "]"))...
3bd0: 20 28 70 72 69 6e 74 20 78 29 29 0a 09 09 74 61 (print x))...ta
3be0: 72 67 65 74 73 29 0a 20 20 20 20 20 20 28 73 65 rgets). (se
3bf0: 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
3c00: 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 72 * #t)))..(if (ar
3c10: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 68 6f gs:get-arg "-sho
3c20: 77 2d 72 75 6e 63 6f 6e 66 69 67 22 29 0a 20 20 w-runconfig").
3c30: 20 20 28 6c 65 74 2a 20 28 28 74 61 72 67 65 74 (let* ((target
3c40: 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
3c50: 72 67 20 22 2d 72 65 71 74 61 72 67 22 29 0a 09 rg "-reqtarg")..
3c60: 09 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 . (args:ge
3c70: 74 2d 61 72 67 20 22 2d 72 65 71 74 61 72 67 22 t-arg "-reqtarg"
3c80: 29 0a 09 09 20 20 20 20 20 20 20 28 69 66 20 28 )... (if (
3c90: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 args:get-arg "-t
3ca0: 61 72 67 65 74 22 29 0a 09 09 09 20 20 20 28 61 arget").... (a
3cb0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 61 rgs:get-arg "-ta
3cc0: 72 67 65 74 22 29 0a 09 09 09 20 20 20 23 66 29 rget").... #f)
3cd0: 29 29 0a 09 20 20 20 28 73 65 63 74 69 6f 6e 73 )).. (sections
3ce0: 20 28 69 66 20 74 61 72 67 65 74 20 28 6c 69 73 (if target (lis
3cf0: 74 20 22 64 65 66 61 75 6c 74 22 20 74 61 72 67 t "default" targ
3d00: 65 74 29 20 23 66 29 29 0a 09 20 20 20 28 64 61 et) #f)).. (da
3d10: 74 61 20 20 20 20 20 28 72 65 61 64 2d 63 6f 6e ta (read-con
3d20: 66 69 67 20 22 72 75 6e 63 6f 6e 66 69 67 73 2e fig "runconfigs.
3d30: 63 6f 6e 66 69 67 22 20 23 66 20 23 74 20 73 65 config" #f #t se
3d40: 63 74 69 6f 6e 73 3a 20 73 65 63 74 69 6f 6e 73 ctions: sections
3d50: 29 29 29 0a 0a 20 20 20 20 20 20 3b 3b 20 6b 65 ))).. ;; ke
3d60: 65 70 20 74 68 69 73 20 6f 6e 65 20 6c 6f 63 61 ep this one loca
3d70: 6c 0a 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 l. (cond.
3d80: 20 20 20 20 20 28 28 6e 6f 74 20 28 61 72 67 73 ((not (args
3d90: 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d :get-arg "-dumpm
3da0: 6f 64 65 22 29 29 0a 09 28 70 70 20 28 68 61 73 ode"))..(pp (has
3db0: 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 20 64 h-table->alist d
3dc0: 61 74 61 29 29 29 0a 20 20 20 20 20 20 20 28 28 ata))). ((
3dd0: 73 74 72 69 6e 67 3d 3f 20 28 61 72 67 73 3a 67 string=? (args:g
3de0: 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 et-arg "-dumpmod
3df0: 65 22 29 20 22 6a 73 6f 6e 22 29 0a 09 28 6a 73 e") "json")..(js
3e00: 6f 6e 2d 77 72 69 74 65 20 64 61 74 61 29 29 0a on-write data)).
3e10: 20 20 20 20 20 20 20 28 65 6c 73 65 0a 09 28 64 (else..(d
3e20: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 ebug:print 0 "ER
3e30: 52 4f 52 3a 20 2d 64 75 6d 70 6d 6f 64 65 20 6f ROR: -dumpmode o
3e40: 66 20 22 20 28 61 72 67 73 3a 67 65 74 2d 61 72 f " (args:get-ar
3e50: 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 g "-dumpmode") "
3e60: 20 6e 6f 74 20 72 65 63 6f 67 6e 69 73 65 64 22 not recognised"
3e70: 29 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 ))). (set!
3e80: 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
3e90: 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a t)))..(if (args:
3ea0: 67 65 74 2d 61 72 67 20 22 2d 73 68 6f 77 2d 63 get-arg "-show-c
3eb0: 6f 6e 66 69 67 22 29 0a 20 20 20 20 28 6c 65 74 onfig"). (let
3ec0: 20 28 28 64 61 74 61 20 2a 63 6f 6e 66 69 67 64 ((data *configd
3ed0: 61 74 2a 29 29 20 3b 3b 20 28 72 65 61 64 2d 63 at*)) ;; (read-c
3ee0: 6f 6e 66 69 67 20 22 6d 65 67 61 74 65 73 74 2e onfig "megatest.
3ef0: 63 6f 6e 66 69 67 22 20 23 66 20 23 74 29 29 29 config" #f #t)))
3f00: 0a 20 20 20 20 20 20 3b 3b 20 6b 65 65 70 20 74 . ;; keep t
3f10: 68 69 73 20 6f 6e 65 20 6c 6f 63 61 6c 0a 20 20 his one local.
3f20: 20 20 20 20 28 63 6f 6e 64 20 0a 20 20 20 20 20 (cond .
3f30: 20 20 28 28 6e 6f 74 20 28 61 72 67 73 3a 67 65 ((not (args:ge
3f40: 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 t-arg "-dumpmode
3f50: 22 29 29 0a 09 28 70 70 20 28 68 61 73 68 2d 74 "))..(pp (hash-t
3f60: 61 62 6c 65 2d 3e 61 6c 69 73 74 20 64 61 74 61 able->alist data
3f70: 29 29 29 0a 20 20 20 20 20 20 20 28 28 73 74 72 ))). ((str
3f80: 69 6e 67 3d 3f 20 28 61 72 67 73 3a 67 65 74 2d ing=? (args:get-
3f90: 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 arg "-dumpmode")
3fa0: 20 22 6a 73 6f 6e 22 29 0a 09 28 6a 73 6f 6e 2d "json")..(json-
3fb0: 77 72 69 74 65 20 64 61 74 61 29 29 0a 20 20 20 write data)).
3fc0: 20 20 20 20 28 65 6c 73 65 0a 09 28 64 65 62 75 (else..(debu
3fd0: 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 g:print 0 "ERROR
3fe0: 3a 20 2d 64 75 6d 70 6d 6f 64 65 20 6f 66 20 22 : -dumpmode of "
3ff0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
4000: 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 20 6e 6f -dumpmode") " no
4010: 74 20 72 65 63 6f 67 6e 69 73 65 64 22 29 29 29 t recognised")))
4020: 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 . (set! *di
4030: 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 dsomething* #t))
4040: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
4050: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4060: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4070: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4080: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 52 ===========.;; R
4090: 65 6d 6f 76 65 20 6f 6c 64 20 72 75 6e 28 73 29 emove old run(s)
40a0: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
40b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
40c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
40d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
40e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 73 69 =========..;; si
40f0: 6e 63 65 20 73 65 76 65 72 61 6c 20 61 63 74 69 nce several acti
4100: 6f 6e 73 20 63 61 6e 20 62 65 20 73 70 65 63 69 ons can be speci
4110: 66 69 65 64 20 6f 6e 20 74 68 65 20 63 6f 6d 6d fied on the comm
4120: 61 6e 64 20 6c 69 6e 65 20 74 68 65 20 72 65 6d and line the rem
4130: 6f 76 61 6c 0a 3b 3b 20 69 73 20 64 6f 6e 65 20 oval.;; is done
4140: 66 69 72 73 74 0a 28 64 65 66 69 6e 65 20 28 6f first.(define (o
4150: 70 65 72 61 74 65 2d 6f 6e 20 61 63 74 69 6f 6e perate-on action
4160: 29 0a 20 20 28 63 6f 6e 64 0a 20 20 20 28 28 6e ). (cond. ((n
4170: 6f 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 ot (args:get-arg
4180: 20 22 3a 72 75 6e 6e 61 6d 65 22 29 29 0a 20 20 ":runname")).
4190: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
41a0: 20 22 45 52 52 4f 52 3a 20 4d 69 73 73 69 6e 67 "ERROR: Missing
41b0: 20 72 65 71 75 69 72 65 64 20 70 61 72 61 6d 65 required parame
41c0: 74 65 72 20 66 6f 72 20 22 20 61 63 74 69 6f 6e ter for " action
41d0: 20 22 2c 20 79 6f 75 20 6d 75 73 74 20 73 70 65 ", you must spe
41e0: 63 69 66 79 20 74 68 65 20 72 75 6e 20 6e 61 6d cify the run nam
41f0: 65 20 70 61 74 74 65 72 6e 20 77 69 74 68 20 3a e pattern with :
4200: 72 75 6e 6e 61 6d 65 20 70 61 74 74 22 29 0a 20 runname patt").
4210: 20 20 20 28 65 78 69 74 20 32 29 29 0a 20 20 20 (exit 2)).
4220: 28 28 6e 6f 74 20 28 61 72 67 73 3a 67 65 74 2d ((not (args:get-
4230: 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 arg "-testpatt")
4240: 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 ). (debug:pri
4250: 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 4d 69 73 nt 0 "ERROR: Mis
4260: 73 69 6e 67 20 72 65 71 75 69 72 65 64 20 70 61 sing required pa
4270: 72 61 6d 65 74 65 72 20 66 6f 72 20 22 20 61 63 rameter for " ac
4280: 74 69 6f 6e 20 22 2c 20 79 6f 75 20 6d 75 73 74 tion ", you must
4290: 20 73 70 65 63 69 66 79 20 74 68 65 20 74 65 73 specify the tes
42a0: 74 20 70 61 74 74 65 72 6e 20 77 69 74 68 20 2d t pattern with -
42b0: 74 65 73 74 70 61 74 74 22 29 0a 20 20 20 20 28 testpatt"). (
42c0: 65 78 69 74 20 33 29 29 0a 20 20 20 28 65 6c 73 exit 3)). (els
42d0: 65 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 e. (if (not (
42e0: 63 61 72 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a car *configinfo*
42f0: 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 ))..(begin.. (d
4300: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 ebug:print 0 "ER
4310: 52 4f 52 3a 20 41 74 74 65 6d 70 74 65 64 20 22 ROR: Attempted "
4320: 20 61 63 74 69 6f 6e 20 22 6f 6e 20 74 65 73 74 action "on test
4330: 28 73 29 20 62 75 74 20 72 75 6e 20 61 72 65 61 (s) but run area
4340: 20 63 6f 6e 66 69 67 20 66 69 6c 65 20 6e 6f 74 config file not
4350: 20 66 6f 75 6e 64 22 29 0a 09 20 20 28 65 78 69 found").. (exi
4360: 74 20 31 29 29 0a 09 3b 3b 20 70 75 74 20 74 65 t 1))..;; put te
4370: 73 74 20 70 61 72 61 6d 65 74 65 72 73 20 69 6e st parameters in
4380: 74 6f 20 63 6f 6e 76 65 6e 69 65 6e 74 20 76 61 to convenient va
4390: 72 69 61 62 6c 65 73 0a 09 28 72 75 6e 73 3a 6f riables..(runs:o
43a0: 70 65 72 61 74 65 2d 6f 6e 20 20 61 63 74 69 6f perate-on actio
43b0: 6e 0a 09 09 09 20 20 28 61 72 67 73 3a 67 65 74 n.... (args:get
43c0: 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 -arg ":runname")
43d0: 0a 09 09 09 20 20 28 61 72 67 73 3a 67 65 74 2d .... (args:get-
43e0: 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 arg "-testpatt")
43f0: 0a 09 09 09 20 20 73 74 61 74 65 3a 20 28 61 72 .... state: (ar
4400: 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 gs:get-arg ":sta
4410: 74 65 22 29 20 0a 09 09 09 20 20 73 74 61 74 75 te") .... statu
4420: 73 3a 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 s: (args:get-arg
4430: 20 22 3a 73 74 61 74 75 73 22 29 0a 09 09 09 20 ":status")....
4440: 20 6e 65 77 2d 73 74 61 74 65 2d 73 74 61 74 75 new-state-statu
4450: 73 3a 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 s: (args:get-arg
4460: 20 22 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 "-set-state-sta
4470: 74 75 73 22 29 29 29 0a 20 20 20 20 28 73 65 74 tus"))). (set
4480: 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
4490: 20 23 74 29 29 29 29 0a 09 20 20 0a 28 69 66 20 #t)))).. .(if
44a0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
44b0: 72 65 6d 6f 76 65 2d 72 75 6e 73 22 29 0a 20 20 remove-runs").
44c0: 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 (general-run-c
44d0: 61 6c 6c 20 0a 20 20 20 20 20 22 2d 72 65 6d 6f all . "-remo
44e0: 76 65 2d 72 75 6e 73 22 0a 20 20 20 20 20 22 72 ve-runs". "r
44f0: 65 6d 6f 76 65 20 72 75 6e 73 22 0a 20 20 20 20 emove runs".
4500: 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 (lambda (target
4510: 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 runname keys ke
4520: 79 6e 61 6d 65 73 20 6b 65 79 76 61 6c 6c 73 74 ynames keyvallst
4530: 29 0a 20 20 20 20 20 20 20 28 6f 70 65 72 61 74 ). (operat
4540: 65 2d 6f 6e 20 27 72 65 6d 6f 76 65 2d 72 75 6e e-on 'remove-run
4550: 73 29 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 s))))..(if (args
4560: 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 73 :get-arg "-set-s
4570: 74 61 74 65 2d 73 74 61 74 75 73 22 29 0a 20 20 tate-status").
4580: 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 (general-run-c
4590: 61 6c 6c 20 0a 20 20 20 20 20 22 2d 73 65 74 2d all . "-set-
45a0: 73 74 61 74 65 2d 73 74 61 74 75 73 22 0a 20 20 state-status".
45b0: 20 20 20 22 73 65 74 20 73 74 61 74 65 20 61 6e "set state an
45c0: 64 20 73 74 61 74 75 73 22 0a 20 20 20 20 20 28 d status". (
45d0: 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 lambda (target r
45e0: 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 6e unname keys keyn
45f0: 61 6d 65 73 20 6b 65 79 76 61 6c 6c 73 74 29 0a ames keyvallst).
4600: 20 20 20 20 20 20 20 28 6f 70 65 72 61 74 65 2d (operate-
4610: 6f 6e 20 27 73 65 74 2d 73 74 61 74 65 2d 73 74 on 'set-state-st
4620: 61 74 75 73 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d atus))))..;;====
4630: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4640: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4650: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4660: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4670: 3d 3d 0a 3b 3b 20 51 75 65 72 79 20 72 75 6e 73 ==.;; Query runs
4680: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
4690: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
46a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
46b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
46c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 =========..(if (
46d0: 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 or (args:get-arg
46e0: 20 22 2d 6c 69 73 74 2d 72 75 6e 73 22 29 0a 09 "-list-runs")..
46f0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
4700: 6c 69 73 74 2d 64 62 2d 74 61 72 67 65 74 73 22 list-db-targets"
4710: 29 29 0a 20 20 20 20 28 69 66 20 28 73 65 74 75 )). (if (setu
4720: 70 2d 66 6f 72 2d 72 75 6e 29 0a 09 28 6c 65 74 p-for-run)..(let
4730: 2a 20 28 28 64 62 20 20 20 20 20 20 20 23 66 29 * ((db #f)
4740: 0a 09 20 20 20 20 20 20 20 28 72 75 6e 70 61 74 .. (runpat
4750: 74 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 t (args:get-arg
4760: 20 22 2d 6c 69 73 74 2d 72 75 6e 73 22 29 29 0a "-list-runs")).
4770: 09 20 20 20 20 20 20 20 28 74 65 73 74 70 61 74 . (testpat
4780: 74 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d t (if (args:get-
4790: 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 arg "-testpatt")
47a0: 20 0a 09 09 09 20 20 20 20 20 28 61 72 67 73 3a .... (args:
47b0: 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 get-arg "-testpa
47c0: 74 74 22 29 20 0a 09 09 09 20 20 20 20 20 22 25 tt") .... "%
47d0: 22 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e ")).. (run
47e0: 73 64 61 74 20 20 28 63 64 62 3a 72 65 6d 6f 74 sdat (cdb:remot
47f0: 65 2d 72 75 6e 20 64 62 3a 67 65 74 2d 72 75 6e e-run db:get-run
4800: 73 20 23 66 20 72 75 6e 70 61 74 74 20 23 66 20 s #f runpatt #f
4810: 23 66 20 27 28 29 29 29 0a 09 20 20 20 20 20 20 #f '()))..
4820: 20 28 72 75 6e 73 20 20 20 20 20 28 64 62 3a 67 (runs (db:g
4830: 65 74 2d 72 6f 77 73 20 72 75 6e 73 64 61 74 29 et-rows runsdat)
4840: 29 0a 09 20 20 20 20 20 20 20 28 68 65 61 64 65 ).. (heade
4850: 72 20 20 20 28 64 62 3a 67 65 74 2d 68 65 61 64 r (db:get-head
4860: 65 72 20 72 75 6e 73 64 61 74 29 29 0a 09 20 20 er runsdat))..
4870: 20 20 20 20 20 28 6b 65 79 73 20 20 20 20 20 28 (keys (
4880: 63 64 62 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 64 cdb:remote-run d
4890: 62 3a 67 65 74 2d 6b 65 79 73 20 23 66 29 29 0a b:get-keys #f)).
48a0: 09 20 20 20 20 20 20 20 28 6b 65 79 6e 61 6d 65 . (keyname
48b0: 73 20 28 6d 61 70 20 6b 65 79 3a 67 65 74 2d 66 s (map key:get-f
48c0: 69 65 6c 64 6e 61 6d 65 20 6b 65 79 73 29 29 0a ieldname keys)).
48d0: 09 20 20 20 20 20 20 20 28 64 62 2d 74 61 72 67 . (db-targ
48e0: 65 74 73 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ets (args:get-ar
48f0: 67 20 22 2d 6c 69 73 74 2d 64 62 2d 74 61 72 67 g "-list-db-targ
4900: 65 74 73 22 29 29 0a 09 20 20 20 20 20 20 20 28 ets")).. (
4910: 73 65 65 6e 20 20 20 20 20 28 6d 61 6b 65 2d 68 seen (make-h
4920: 61 73 68 2d 74 61 62 6c 65 29 29 29 0a 09 20 20 ash-table)))..
4930: 3b 3b 20 45 61 63 68 20 72 75 6e 0a 09 20 20 28 ;; Each run.. (
4940: 66 6f 72 2d 65 61 63 68 20 0a 09 20 20 20 28 6c for-each .. (l
4950: 61 6d 62 64 61 20 28 72 75 6e 29 0a 09 20 20 20 ambda (run)..
4960: 20 20 28 6c 65 74 20 28 28 74 61 72 67 65 74 73 (let ((targets
4970: 74 72 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 tr (string-inter
4980: 73 70 65 72 73 65 20 28 6d 61 70 20 28 6c 61 6d sperse (map (lam
4990: 62 64 61 20 28 78 29 0a 09 09 09 09 09 09 09 20 bda (x)........
49a0: 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 (db:get-value-by
49b0: 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 -header run head
49c0: 65 72 20 78 29 29 0a 09 09 09 09 09 09 20 20 20 er x)).......
49d0: 20 20 20 20 6b 65 79 6e 61 6d 65 73 29 20 22 2f keynames) "/
49e0: 22 29 29 29 0a 09 20 20 20 20 20 20 20 28 69 66 "))).. (if
49f0: 20 64 62 2d 74 61 72 67 65 74 73 0a 09 09 20 20 db-targets...
4a00: 20 28 69 66 20 28 6e 6f 74 20 28 68 61 73 68 2d (if (not (hash-
4a10: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
4a20: 74 20 73 65 65 6e 20 74 61 72 67 65 74 73 74 72 t seen targetstr
4a30: 20 23 66 29 29 0a 09 09 20 20 20 20 20 20 20 28 #f))... (
4a40: 62 65 67 69 6e 0a 09 09 09 20 28 68 61 73 68 2d begin.... (hash-
4a50: 74 61 62 6c 65 2d 73 65 74 21 20 73 65 65 6e 20 table-set! seen
4a60: 74 61 72 67 65 74 73 74 72 20 23 74 29 0a 09 09 targetstr #t)...
4a70: 09 20 3b 3b 20 28 70 72 69 6e 74 20 22 5b 22 20 . ;; (print "["
4a80: 74 61 72 67 65 74 73 74 72 20 22 5d 22 29 29 29 targetstr "]")))
4a90: 29 0a 09 09 09 20 28 70 72 69 6e 74 20 74 61 72 ).... (print tar
4aa0: 67 65 74 73 74 72 29 29 29 29 0a 09 20 20 20 20 getstr))))..
4ab0: 20 20 20 28 69 66 20 28 6e 6f 74 20 64 62 2d 74 (if (not db-t
4ac0: 61 72 67 65 74 73 29 0a 09 09 20 20 20 28 6c 65 argets)... (le
4ad0: 74 2a 20 28 28 72 75 6e 2d 69 64 20 28 64 62 3a t* ((run-id (db:
4ae0: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 get-value-by-hea
4af0: 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 22 der run header "
4b00: 69 64 22 29 29 0a 09 09 09 20 20 28 74 65 73 74 id")).... (test
4b10: 73 20 20 28 63 64 62 3a 72 65 6d 6f 74 65 2d 72 s (cdb:remote-r
4b20: 75 6e 20 64 62 3a 67 65 74 2d 74 65 73 74 73 2d un db:get-tests-
4b30: 66 6f 72 2d 72 75 6e 20 23 66 20 72 75 6e 2d 69 for-run #f run-i
4b40: 64 20 74 65 73 74 70 61 74 74 20 27 28 29 20 27 d testpatt '() '
4b50: 28 29 29 29 29 0a 09 09 20 20 20 20 20 28 70 72 ())))... (pr
4b60: 69 6e 74 20 22 52 75 6e 3a 20 22 20 74 61 72 67 int "Run: " targ
4b70: 65 74 73 74 72 20 22 2f 22 20 28 64 62 3a 67 65 etstr "/" (db:ge
4b80: 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 t-value-by-heade
4b90: 72 20 72 75 6e 20 68 65 61 64 65 72 20 22 72 75 r run header "ru
4ba0: 6e 6e 61 6d 65 22 29 20 0a 09 09 09 20 20 20 20 nname") ....
4bb0: 22 20 73 74 61 74 75 73 3a 20 22 20 28 64 62 3a " status: " (db:
4bc0: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 get-value-by-hea
4bd0: 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 22 der run header "
4be0: 73 74 61 74 65 22 29 0a 09 09 09 20 20 20 20 22 state").... "
4bf0: 20 72 75 6e 2d 69 64 3a 20 22 20 72 75 6e 2d 69 run-id: " run-i
4c00: 64 20 22 2c 20 6e 75 6d 62 65 72 20 74 65 73 74 d ", number test
4c10: 73 3a 20 22 20 28 6c 65 6e 67 74 68 20 74 65 73 s: " (length tes
4c20: 74 73 29 29 0a 09 09 20 20 20 20 20 28 66 6f 72 ts))... (for
4c30: 2d 65 61 63 68 20 0a 09 09 20 20 20 20 20 20 28 -each ... (
4c40: 6c 61 6d 62 64 61 20 28 74 65 73 74 29 0a 09 09 lambda (test)...
4c50: 09 28 66 6f 72 6d 61 74 20 23 74 0a 09 09 09 09 .(format #t.....
4c60: 22 20 20 54 65 73 74 3a 20 7e 32 35 61 20 53 74 " Test: ~25a St
4c70: 61 74 65 3a 20 7e 31 35 61 20 53 74 61 74 75 73 ate: ~15a Status
4c80: 3a 20 7e 31 35 61 20 52 75 6e 74 69 6d 65 3a 20 : ~15a Runtime:
4c90: 7e 35 40 61 73 20 54 69 6d 65 3a 20 7e 32 32 61 ~5@as Time: ~22a
4ca0: 20 48 6f 73 74 3a 20 7e 31 30 61 5c 6e 22 0a 09 Host: ~10a\n"..
4cb0: 09 09 09 28 63 6f 6e 63 20 28 64 62 3a 74 65 73 ...(conc (db:tes
4cc0: 74 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 74 t-get-testname t
4cd0: 65 73 74 29 0a 09 09 09 09 20 20 20 20 20 20 28 est)..... (
4ce0: 69 66 20 28 65 71 75 61 6c 3f 20 28 64 62 3a 74 if (equal? (db:t
4cf0: 65 73 74 2d 67 65 74 2d 69 74 65 6d 2d 70 61 74 est-get-item-pat
4d00: 68 20 74 65 73 74 29 20 22 22 29 0a 09 09 09 09 h test) "").....
4d10: 09 20 20 22 22 20 0a 09 09 09 09 09 20 20 28 63 . "" ...... (c
4d20: 6f 6e 63 20 22 28 22 20 28 64 62 3a 74 65 73 74 onc "(" (db:test
4d30: 2d 67 65 74 2d 69 74 65 6d 2d 70 61 74 68 20 74 -get-item-path t
4d40: 65 73 74 29 20 22 29 22 29 29 29 0a 09 09 09 09 est) ")"))).....
4d50: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 (db:test-get-sta
4d60: 74 65 20 74 65 73 74 29 0a 09 09 09 09 28 64 62 te test).....(db
4d70: 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 75 73 :test-get-status
4d80: 20 74 65 73 74 29 0a 09 09 09 09 28 64 62 3a 74 test).....(db:t
4d90: 65 73 74 2d 67 65 74 2d 72 75 6e 5f 64 75 72 61 est-get-run_dura
4da0: 74 69 6f 6e 20 74 65 73 74 29 0a 09 09 09 09 28 tion test).....(
4db0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 65 76 65 6e db:test-get-even
4dc0: 74 5f 74 69 6d 65 20 74 65 73 74 29 0a 09 09 09 t_time test)....
4dd0: 09 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 68 6f .(db:test-get-ho
4de0: 73 74 20 74 65 73 74 29 29 0a 09 09 09 28 69 66 st test))....(if
4df0: 20 28 6e 6f 74 20 28 6f 72 20 28 65 71 75 61 6c (not (or (equal
4e00: 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 ? (db:test-get-s
4e10: 74 61 74 75 73 20 74 65 73 74 29 20 22 50 41 53 tatus test) "PAS
4e20: 53 22 29 0a 09 09 09 09 20 20 20 20 20 28 65 71 S")..... (eq
4e30: 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 ual? (db:test-ge
4e40: 74 2d 73 74 61 74 75 73 20 74 65 73 74 29 20 22 t-status test) "
4e50: 57 41 52 4e 22 29 0a 09 09 09 09 20 20 20 20 20 WARN").....
4e60: 28 65 71 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 (equal? (db:test
4e70: 2d 67 65 74 2d 73 74 61 74 65 20 74 65 73 74 29 -get-state test)
4e80: 20 20 22 4e 4f 54 5f 53 54 41 52 54 45 44 22 29 "NOT_STARTED")
4e90: 29 29 0a 09 09 09 20 20 20 20 28 62 65 67 69 6e )).... (begin
4ea0: 0a 09 09 09 20 20 20 20 20 20 28 70 72 69 6e 74 .... (print
4eb0: 20 22 20 20 20 20 20 20 20 20 20 63 70 75 6c 6f " cpulo
4ec0: 61 64 3a 20 20 22 20 28 64 62 3a 74 65 73 74 2d ad: " (db:test-
4ed0: 67 65 74 2d 63 70 75 6c 6f 61 64 20 74 65 73 74 get-cpuload test
4ee0: 29 0a 09 09 09 09 20 20 20 20 20 22 5c 6e 20 20 )..... "\n
4ef0: 20 20 20 20 20 20 20 64 69 73 6b 66 72 65 65 3a diskfree:
4f00: 20 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d " (db:test-get-
4f10: 64 69 73 6b 66 72 65 65 20 74 65 73 74 29 0a 09 diskfree test)..
4f20: 09 09 09 20 20 20 20 20 22 5c 6e 20 20 20 20 20 ... "\n
4f30: 20 20 20 20 75 6e 61 6d 65 3a 20 20 20 20 22 20 uname: "
4f40: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 75 6e 61 (db:test-get-una
4f50: 6d 65 20 74 65 73 74 29 0a 09 09 09 09 20 20 20 me test).....
4f60: 20 20 22 5c 6e 20 20 20 20 20 20 20 20 20 72 75 "\n ru
4f70: 6e 64 69 72 3a 20 20 20 22 20 28 64 62 3a 74 65 ndir: " (db:te
4f80: 73 74 2d 67 65 74 2d 72 75 6e 64 69 72 20 74 65 st-get-rundir te
4f90: 73 74 29 0a 09 09 09 09 20 20 20 20 20 29 0a 09 st)..... )..
4fa0: 09 09 20 20 20 20 20 20 3b 3b 20 45 61 63 68 20 .. ;; Each
4fb0: 74 65 73 74 0a 09 09 09 20 20 20 20 20 20 3b 3b test.... ;;
4fc0: 20 44 4f 20 4e 4f 54 20 72 65 6d 6f 74 65 20 72 DO NOT remote r
4fd0: 75 6e 0a 09 09 09 20 20 20 20 20 20 28 6c 65 74 un.... (let
4fe0: 20 28 28 73 74 65 70 73 20 28 64 62 3a 67 65 74 ((steps (db:get
4ff0: 2d 73 74 65 70 73 2d 66 6f 72 2d 74 65 73 74 20 -steps-for-test
5000: 23 66 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d #f (db:test-get-
5010: 69 64 20 74 65 73 74 29 29 29 29 0a 09 09 09 09 id test)))).....
5020: 28 66 6f 72 2d 65 61 63 68 20 0a 09 09 09 09 20 (for-each .....
5030: 28 6c 61 6d 62 64 61 20 28 73 74 65 70 29 0a 09 (lambda (step)..
5040: 09 09 09 20 20 20 28 66 6f 72 6d 61 74 20 23 74 ... (format #t
5050: 20 0a 09 09 09 09 09 20 20 20 22 20 20 20 20 53 ...... " S
5060: 74 65 70 3a 20 7e 32 30 61 20 53 74 61 74 65 3a tep: ~20a State:
5070: 20 7e 31 30 61 20 53 74 61 74 75 73 3a 20 7e 31 ~10a Status: ~1
5080: 30 61 20 54 69 6d 65 20 7e 32 32 61 5c 6e 22 0a 0a Time ~22a\n".
5090: 09 09 09 09 09 20 20 20 28 64 62 3a 73 74 65 70 ..... (db:step
50a0: 2d 67 65 74 2d 73 74 65 70 6e 61 6d 65 20 73 74 -get-stepname st
50b0: 65 70 29 0a 09 09 09 09 09 20 20 20 28 64 62 3a ep)...... (db:
50c0: 73 74 65 70 2d 67 65 74 2d 73 74 61 74 65 20 73 step-get-state s
50d0: 74 65 70 29 0a 09 09 09 09 09 20 20 20 28 64 62 tep)...... (db
50e0: 3a 73 74 65 70 2d 67 65 74 2d 73 74 61 74 75 73 :step-get-status
50f0: 20 73 74 65 70 29 0a 09 09 09 09 09 20 20 20 28 step)...... (
5100: 64 62 3a 73 74 65 70 2d 67 65 74 2d 65 76 65 6e db:step-get-even
5110: 74 5f 74 69 6d 65 20 73 74 65 70 29 29 29 0a 09 t_time step)))..
5120: 09 09 09 20 73 74 65 70 73 29 29 29 29 29 0a 09 ... steps)))))..
5130: 09 20 20 20 20 20 20 74 65 73 74 73 29 29 29 29 . tests))))
5140: 29 0a 09 20 20 20 20 20 72 75 6e 73 29 0a 09 20 ).. runs)..
5150: 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
5160: 74 68 69 6e 67 2a 20 23 74 29 29 29 29 0a 0a 3b thing* #t))))..;
5170: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
5180: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5190: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
51a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
51b0: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 66 75 6c 6c 20 =======.;; full
51c0: 72 75 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d run.;;==========
51d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
51e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
51f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b ============..;;
5210: 20 67 65 74 20 6c 6f 63 6b 20 69 6e 20 64 62 20 get lock in db
5220: 66 6f 72 20 66 75 6c 6c 20 72 75 6e 20 66 6f 72 for full run for
5230: 20 74 68 69 73 20 64 69 72 65 63 74 6f 72 79 0a this directory.
5240: 3b 3b 20 66 6f 72 20 61 6c 6c 20 74 65 73 74 73 ;; for all tests
5250: 20 77 69 74 68 20 64 65 70 73 0a 3b 3b 20 20 20 with deps.;;
5260: 77 61 6c 6b 20 74 72 65 65 20 6f 66 20 74 65 73 walk tree of tes
5270: 74 73 20 74 6f 20 66 69 6e 64 20 68 65 61 64 20 ts to find head
5280: 74 61 73 6b 73 0a 3b 3b 20 20 20 61 64 64 20 68 tasks.;; add h
5290: 65 61 64 20 74 61 73 6b 73 20 74 6f 20 74 61 73 ead tasks to tas
52a0: 6b 20 71 75 65 75 65 0a 3b 3b 20 20 20 61 64 64 k queue.;; add
52b0: 20 64 65 70 65 6e 64 61 6e 74 20 74 61 73 6b 73 dependant tasks
52c0: 20 74 6f 20 74 61 73 6b 20 71 75 65 75 65 20 0a to task queue .
52d0: 3b 3b 20 20 20 61 64 64 20 72 65 6d 61 69 6e 69 ;; add remaini
52e0: 6e 67 20 74 61 73 6b 73 20 74 6f 20 74 61 73 6b ng tasks to task
52f0: 20 71 75 65 75 65 0a 3b 3b 20 66 6f 72 20 65 61 queue.;; for ea
5300: 63 68 20 74 61 73 6b 20 69 6e 20 74 61 73 6b 20 ch task in task
5310: 71 75 65 75 65 0a 3b 3b 20 20 20 69 66 20 68 61 queue.;; if ha
5320: 76 65 20 61 64 65 71 75 61 74 65 20 72 65 73 6f ve adequate reso
5330: 75 72 63 65 73 0a 3b 3b 20 20 20 20 20 6c 61 75 urces.;; lau
5340: 6e 63 68 20 74 61 73 6b 0a 3b 3b 20 20 20 65 6c nch task.;; el
5350: 73 65 0a 3b 3b 20 20 20 20 20 70 75 74 20 74 61 se.;; put ta
5360: 73 6b 20 69 6e 20 64 65 66 65 72 72 65 64 20 71 sk in deferred q
5370: 75 65 75 65 0a 3b 3b 20 69 66 20 73 74 69 6c 6c ueue.;; if still
5380: 20 6f 6b 20 74 6f 20 72 75 6e 20 74 61 73 6b 73 ok to run tasks
5390: 0a 3b 3b 20 20 20 70 72 6f 63 65 73 73 20 64 65 .;; process de
53a0: 66 65 72 72 65 64 20 74 61 73 6b 73 20 70 65 72 ferred tasks per
53b0: 20 61 62 6f 76 65 20 73 74 65 70 73 0a 0a 3b 3b above steps..;;
53c0: 20 72 75 6e 20 61 6c 6c 20 74 65 73 74 73 20 61 run all tests a
53d0: 72 65 20 61 72 65 20 4e 6f 74 20 43 4f 4d 50 4c re are Not COMPL
53e0: 45 54 45 44 20 61 6e 64 20 50 41 53 53 20 6f 72 ETED and PASS or
53f0: 20 43 48 45 43 4b 0a 28 69 66 20 28 61 72 67 73 CHECK.(if (args
5400: 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 61 6c :get-arg "-runal
5410: 6c 22 29 0a 20 20 20 20 28 67 65 6e 65 72 61 6c l"). (general
5420: 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 20 -run-call .
5430: 22 2d 72 75 6e 61 6c 6c 22 0a 20 20 20 20 20 22 "-runall". "
5440: 72 75 6e 20 61 6c 6c 20 74 65 73 74 73 22 0a 20 run all tests".
5450: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 72 (lambda (tar
5460: 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 get runname keys
5470: 20 6b 65 79 6e 61 6d 65 73 20 6b 65 79 76 61 6c keynames keyval
5480: 6c 73 74 29 0a 20 20 20 20 20 20 20 28 72 75 6e lst). (run
5490: 73 3a 72 75 6e 2d 74 65 73 74 73 20 74 61 72 67 s:run-tests targ
54a0: 65 74 0a 09 09 20 20 20 20 20 20 20 72 75 6e 6e et... runn
54b0: 61 6d 65 0a 09 09 20 20 20 20 20 20 20 22 25 22 ame... "%"
54c0: 0a 09 09 20 20 20 20 20 20 20 28 61 72 67 73 3a ... (args:
54d0: 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 get-arg "-testpa
54e0: 74 74 22 29 0a 09 09 20 20 20 20 20 20 20 75 73 tt")... us
54f0: 65 72 0a 09 09 20 20 20 20 20 20 20 61 72 67 73 er... args
5500: 3a 61 72 67 2d 68 61 73 68 29 29 29 29 0a 0a 3b :arg-hash))))..;
5510: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
5520: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5530: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5540: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5550: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 72 75 6e 20 6f =======.;; run o
5560: 6e 65 20 74 65 73 74 0a 3b 3b 3d 3d 3d 3d 3d 3d ne test.;;======
5570: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5580: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5590: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
55a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
55b0: 0a 0a 3b 3b 20 31 2e 20 66 69 6e 64 20 74 68 65 ..;; 1. find the
55c0: 20 63 6f 6e 66 69 67 20 66 69 6c 65 0a 3b 3b 20 config file.;;
55d0: 32 2e 20 63 68 61 6e 67 65 20 74 6f 20 74 68 65 2. change to the
55e0: 20 74 65 73 74 20 64 69 72 65 63 74 6f 72 79 0a test directory.
55f0: 3b 3b 20 33 2e 20 75 70 64 61 74 65 20 74 68 65 ;; 3. update the
5600: 20 64 62 20 77 69 74 68 20 22 74 65 73 74 20 73 db with "test s
5610: 74 61 72 74 65 64 22 20 73 74 61 74 75 73 2c 20 tarted" status,
5620: 73 65 74 20 72 75 6e 6e 69 6e 67 20 68 6f 73 74 set running host
5630: 0a 3b 3b 20 34 2e 20 70 72 6f 63 65 73 73 20 6c .;; 4. process l
5640: 61 75 6e 63 68 20 74 68 65 20 74 65 73 74 0a 3b aunch the test.;
5650: 3b 20 20 20 20 2d 20 6d 6f 6e 69 74 6f 72 20 74 ; - monitor t
5660: 68 65 20 70 72 6f 63 65 73 73 2c 20 75 70 64 61 he process, upda
5670: 74 65 20 73 74 61 74 73 20 69 6e 20 74 68 65 20 te stats in the
5680: 64 62 20 65 76 65 72 79 20 32 5e 6e 20 6d 69 6e db every 2^n min
5690: 75 74 65 73 0a 3b 3b 20 35 2e 20 61 73 20 74 68 utes.;; 5. as th
56a0: 65 20 74 65 73 74 20 70 72 6f 63 65 65 64 73 20 e test proceeds
56b0: 69 6e 74 65 72 6e 61 6c 6c 79 20 69 74 20 63 61 internally it ca
56c0: 6c 6c 73 20 6d 65 67 61 74 65 73 74 20 61 73 20 lls megatest as
56d0: 65 61 63 68 20 73 74 65 70 20 69 73 0a 3b 3b 20 each step is.;;
56e0: 20 20 20 73 74 61 72 74 65 64 20 61 6e 64 20 63 started and c
56f0: 6f 6d 70 6c 65 74 65 64 0a 3b 3b 20 20 20 20 2d ompleted.;; -
5700: 20 73 74 65 70 20 73 74 61 72 74 65 64 2c 20 74 step started, t
5710: 69 6d 65 73 74 61 6d 70 0a 3b 3b 20 20 20 20 2d imestamp.;; -
5720: 20 73 74 65 70 20 63 6f 6d 70 6c 65 74 65 64 2c step completed,
5730: 20 65 78 69 74 20 73 74 61 74 75 73 2c 20 74 69 exit status, ti
5740: 6d 65 73 74 61 6d 70 0a 3b 3b 20 36 2e 20 74 65 mestamp.;; 6. te
5750: 73 74 20 70 68 6f 6e 65 20 68 6f 6d 65 0a 3b 3b st phone home.;;
5760: 20 20 20 20 2d 20 69 66 20 74 65 73 74 20 72 75 - if test ru
5770: 6e 20 74 69 6d 65 20 3e 20 61 6c 6c 6f 77 65 64 n time > allowed
5780: 20 72 75 6e 20 74 69 6d 65 20 74 68 65 6e 20 6b run time then k
5790: 69 6c 6c 20 6a 6f 62 0a 3b 3b 20 20 20 20 2d 20 ill job.;; -
57a0: 69 66 20 63 61 6e 6e 6f 74 20 61 63 63 65 73 73 if cannot access
57b0: 20 64 62 20 3e 20 61 6c 6c 6f 77 65 64 20 64 69 db > allowed di
57c0: 73 63 6f 6e 6e 65 63 74 20 74 69 6d 65 20 74 68 sconnect time th
57d0: 65 6e 20 6b 69 6c 6c 20 6a 6f 62 0a 0a 28 69 66 en kill job..(if
57e0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
57f0: 2d 72 75 6e 74 65 73 74 73 22 29 0a 20 20 28 67 -runtests"). (g
5800: 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 eneral-run-call
5810: 0a 20 20 20 22 2d 72 75 6e 74 65 73 74 73 22 20 . "-runtests"
5820: 0a 20 20 20 22 72 75 6e 20 61 20 74 65 73 74 22 . "run a test"
5830: 20 0a 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 . (lambda (ta
5840: 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 rget runname key
5850: 73 20 6b 65 79 6e 61 6d 65 73 20 6b 65 79 76 61 s keynames keyva
5860: 6c 6c 73 74 29 0a 20 20 20 20 20 28 72 75 6e 73 llst). (runs
5870: 3a 72 75 6e 2d 74 65 73 74 73 20 74 61 72 67 65 :run-tests targe
5880: 74 0a 09 09 20 20 20 20 20 72 75 6e 6e 61 6d 65 t... runname
5890: 0a 09 09 20 20 20 20 20 28 61 72 67 73 3a 67 65 ... (args:ge
58a0: 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 74 73 t-arg "-runtests
58b0: 22 29 0a 09 09 20 20 20 20 20 28 61 72 67 73 3a ")... (args:
58c0: 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 get-arg "-testpa
58d0: 74 74 22 29 0a 09 09 20 20 20 20 20 75 73 65 72 tt")... user
58e0: 0a 09 09 20 20 20 20 20 61 72 67 73 3a 61 72 67 ... args:arg
58f0: 2d 68 61 73 68 29 29 29 29 0a 0a 3b 3b 3d 3d 3d -hash))))..;;===
5900: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5910: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5920: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5930: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5940: 3d 3d 3d 0a 3b 3b 20 52 6f 6c 6c 75 70 20 69 6e ===.;; Rollup in
5950: 74 6f 20 61 20 72 75 6e 0a 3b 3b 3d 3d 3d 3d 3d to a run.;;=====
5960: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5970: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5980: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5990: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
59a0: 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 =..(if (args:get
59b0: 2d 61 72 67 20 22 2d 72 6f 6c 6c 75 70 22 29 0a -arg "-rollup").
59c0: 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 (begin.
59d0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
59e0: 22 45 52 52 4f 52 3a 20 52 6f 6c 6c 75 70 20 69 "ERROR: Rollup i
59f0: 73 20 63 75 72 72 65 6e 74 6c 79 20 6e 6f 74 20 s currently not
5a00: 77 6f 72 6b 69 6e 67 2e 20 49 66 20 79 6f 75 20 working. If you
5a10: 6e 65 65 64 20 69 74 20 70 6c 65 61 73 65 20 73 need it please s
5a20: 75 62 6d 69 74 20 61 20 74 69 63 6b 65 74 20 61 ubmit a ticket a
5a30: 74 20 68 74 74 70 3a 2f 2f 77 77 77 2e 6b 69 61 t http://www.kia
5a40: 74 6f 61 2e 63 6f 6d 2f 66 6f 73 73 69 6c 73 2f toa.com/fossils/
5a50: 6d 65 67 61 74 65 73 74 22 29 0a 20 20 20 20 20 megatest").
5a60: 20 28 65 78 69 74 20 34 29 29 29 0a 3b 3b 20 20 (exit 4))).;;
5a70: 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d (general-run-
5a80: 63 61 6c 6c 20 0a 3b 3b 20 20 20 20 20 20 22 2d call .;; "-
5a90: 72 6f 6c 6c 75 70 22 20 0a 3b 3b 20 20 20 20 20 rollup" .;;
5aa0: 20 22 72 6f 6c 6c 75 70 20 74 65 73 74 73 22 20 "rollup tests"
5ab0: 0a 3b 3b 20 20 20 20 20 20 28 6c 61 6d 62 64 61 .;; (lambda
5ac0: 20 28 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 (target runname
5ad0: 20 6b 65 79 73 20 6b 65 79 6e 61 6d 65 73 20 6b keys keynames k
5ae0: 65 79 76 61 6c 6c 73 74 29 0a 3b 3b 20 20 20 20 eyvallst).;;
5af0: 20 20 20 20 28 72 75 6e 73 3a 72 6f 6c 6c 75 70 (runs:rollup
5b00: 2d 72 75 6e 20 6b 65 79 73 0a 3b 3b 20 09 09 09 -run keys.;; ...
5b10: 28 6b 65 79 73 2d 3e 61 6c 69 73 74 20 6b 65 79 (keys->alist key
5b20: 73 20 22 6e 61 22 29 0a 3b 3b 20 09 09 09 28 61 s "na").;; ...(a
5b30: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 rgs:get-arg ":ru
5b40: 6e 6e 61 6d 65 22 29 20 0a 3b 3b 20 09 09 09 75 nname") .;; ...u
5b50: 73 65 72 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d ser))))..;;=====
5b60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5b70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5b80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5b90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5ba0: 3d 0a 3b 3b 20 4c 6f 63 6b 20 6f 72 20 75 6e 6c =.;; Lock or unl
5bb0: 6f 63 6b 20 61 20 72 75 6e 0a 3b 3b 3d 3d 3d 3d ock a run.;;====
5bc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5bd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5be0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5bf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5c00: 3d 3d 0a 0a 28 69 66 20 28 6f 72 20 28 61 72 67 ==..(if (or (arg
5c10: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 63 6b s:get-arg "-lock
5c20: 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ")(args:get-arg
5c30: 22 2d 75 6e 6c 6f 63 6b 22 29 29 0a 20 20 20 20 "-unlock")).
5c40: 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c (general-run-cal
5c50: 6c 20 0a 20 20 20 20 20 28 69 66 20 28 61 72 67 l . (if (arg
5c60: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 63 6b s:get-arg "-lock
5c70: 22 29 20 22 2d 6c 6f 63 6b 22 20 22 2d 75 6e 6c ") "-lock" "-unl
5c80: 6f 63 6b 22 29 0a 20 20 20 20 20 22 6c 6f 63 6b ock"). "lock
5c90: 2f 75 6e 6c 6f 63 6b 20 74 65 73 74 73 22 20 0a /unlock tests" .
5ca0: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 (lambda (ta
5cb0: 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 rget runname key
5cc0: 73 20 6b 65 79 6e 61 6d 65 73 20 6b 65 79 76 61 s keynames keyva
5cd0: 6c 6c 73 74 29 0a 20 20 20 20 20 20 20 28 72 75 llst). (ru
5ce0: 6e 73 3a 68 61 6e 64 6c 65 2d 6c 6f 63 6b 69 6e ns:handle-lockin
5cf0: 67 20 0a 09 09 20 20 74 61 72 67 65 74 0a 09 09 g ... target...
5d00: 20 20 6b 65 79 73 0a 09 09 20 20 28 61 72 67 73 keys... (args
5d10: 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 :get-arg ":runna
5d20: 6d 65 22 29 20 0a 09 09 20 20 28 61 72 67 73 3a me") ... (args:
5d30: 67 65 74 2d 61 72 67 20 22 2d 6c 6f 63 6b 22 29 get-arg "-lock")
5d40: 0a 09 09 20 20 28 61 72 67 73 3a 67 65 74 2d 61 ... (args:get-a
5d50: 72 67 20 22 2d 75 6e 6c 6f 63 6b 22 29 0a 09 09 rg "-unlock")...
5d60: 20 20 75 73 65 72 29 29 29 29 0a 0a 3b 3b 3d 3d user))))..;;==
5d70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5d80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5d90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5da0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5db0: 3d 3d 3d 3d 0a 3b 3b 20 47 65 74 20 70 61 74 68 ====.;; Get path
5dc0: 73 20 74 6f 20 74 65 73 74 73 0a 3b 3b 3d 3d 3d s to tests.;;===
5dd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5de0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5df0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5e00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5e10: 3d 3d 3d 0a 3b 3b 20 47 65 74 20 74 65 73 74 20 ===.;; Get test
5e20: 70 61 74 68 73 20 6d 61 74 63 68 69 6e 67 20 74 paths matching t
5e30: 61 72 67 65 74 2c 20 72 75 6e 6e 61 6d 65 2c 20 arget, runname,
5e40: 61 6e 64 20 74 65 73 74 70 61 74 74 0a 28 69 66 and testpatt.(if
5e50: 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 (or (args:get-a
5e60: 72 67 20 22 2d 74 65 73 74 2d 66 69 6c 65 73 22 rg "-test-files"
5e70: 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 )(args:get-arg "
5e80: 2d 74 65 73 74 2d 70 61 74 68 73 22 29 29 0a 20 -test-paths")).
5e90: 20 20 20 3b 3b 20 69 66 20 77 65 20 61 72 65 20 ;; if we are
5ea0: 69 6e 20 61 20 74 65 73 74 20 75 73 65 20 74 68 in a test use th
5eb0: 65 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 64 61 74 e MT_CMDINFO dat
5ec0: 61 0a 20 20 20 20 28 69 66 20 28 67 65 74 65 6e a. (if (geten
5ed0: 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 0a v "MT_CMDINFO").
5ee0: 09 28 6c 65 74 2a 20 28 28 73 74 61 72 74 69 6e .(let* ((startin
5ef0: 67 64 69 72 20 28 63 75 72 72 65 6e 74 2d 64 69 gdir (current-di
5f00: 72 65 63 74 6f 72 79 29 29 0a 09 20 20 20 20 20 rectory))..
5f10: 20 20 28 63 6d 64 69 6e 66 6f 20 20 20 28 72 65 (cmdinfo (re
5f20: 61 64 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 73 ad (open-input-s
5f30: 74 72 69 6e 67 20 28 62 61 73 65 36 34 3a 62 61 tring (base64:ba
5f40: 73 65 36 34 2d 64 65 63 6f 64 65 20 28 67 65 74 se64-decode (get
5f50: 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 env "MT_CMDINFO"
5f60: 29 29 29 29 29 0a 09 20 20 20 20 20 20 20 3b 3b ))))).. ;;
5f70: 20 28 72 75 6e 72 65 6d 6f 74 65 20 28 61 73 73 (runremote (ass
5f80: 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 72 oc/default 'runr
5f90: 65 6d 6f 74 65 20 63 6d 64 69 6e 66 6f 29 29 0a emote cmdinfo)).
5fa0: 09 20 20 20 20 20 20 20 28 74 72 61 6e 73 70 6f . (transpo
5fb0: 72 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c rt (assoc/defaul
5fc0: 74 20 27 74 72 61 6e 73 70 6f 72 74 20 63 6d 64 t 'transport cmd
5fd0: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
5fe0: 74 65 73 74 70 61 74 68 20 20 28 61 73 73 6f 63 testpath (assoc
5ff0: 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 70 61 /default 'testpa
6000: 74 68 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 th cmdinfo))..
6010: 20 20 20 20 20 20 28 74 65 73 74 2d 6e 61 6d 65 (test-name
6020: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
6030: 27 74 65 73 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 'test-name cmdin
6040: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 fo)).. (ru
6050: 6e 73 63 72 69 70 74 20 28 61 73 73 6f 63 2f 64 nscript (assoc/d
6060: 65 66 61 75 6c 74 20 27 72 75 6e 73 63 72 69 70 efault 'runscrip
6070: 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 t cmdinfo))..
6080: 20 20 20 20 28 64 62 2d 68 6f 73 74 20 20 20 28 (db-host (
6090: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 64 assoc/default 'd
60a0: 62 2d 68 6f 73 74 20 20 20 63 6d 64 69 6e 66 6f b-host cmdinfo
60b0: 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 2d )).. (run-
60c0: 69 64 20 20 20 20 28 61 73 73 6f 63 2f 64 65 66 id (assoc/def
60d0: 61 75 6c 74 20 27 72 75 6e 2d 69 64 20 20 20 20 ault 'run-id
60e0: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
60f0: 20 20 28 69 74 65 6d 64 61 74 20 20 20 28 61 73 (itemdat (as
6100: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 69 74 65 soc/default 'ite
6110: 6d 64 61 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 mdat cmdinfo))
6120: 0a 09 20 20 20 20 20 20 20 28 64 62 20 20 20 20 .. (db
6130: 20 20 20 20 23 66 29 0a 09 20 20 20 20 20 20 20 #f)..
6140: 28 73 74 61 74 65 20 20 20 20 20 28 61 72 67 73 (state (args
6150: 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 65 :get-arg ":state
6160: 22 29 29 0a 09 20 20 20 20 20 20 20 28 73 74 61 ")).. (sta
6170: 74 75 73 20 20 20 20 28 61 72 67 73 3a 67 65 74 tus (args:get
6180: 2d 61 72 67 20 22 3a 73 74 61 74 75 73 22 29 29 -arg ":status"))
6190: 0a 09 20 20 20 20 20 20 20 28 74 61 72 67 65 74 .. (target
61a0: 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
61b0: 67 20 22 2d 74 61 72 67 65 74 22 29 29 0a 09 20 g "-target"))..
61c0: 20 20 20 20 20 20 28 74 6f 70 70 61 74 68 20 20 (toppath
61d0: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
61e0: 27 74 6f 70 70 61 74 68 20 20 20 63 6d 64 69 6e 'toppath cmdin
61f0: 66 6f 29 29 29 0a 09 20 20 28 63 68 61 6e 67 65 fo))).. (change
6200: 2d 64 69 72 65 63 74 6f 72 79 20 74 6f 70 70 61 -directory toppa
6210: 74 68 29 0a 09 20 20 3b 3b 20 28 73 65 74 21 20 th).. ;; (set!
6220: 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 72 75 6e 72 *runremote* runr
6230: 65 6d 6f 74 65 29 0a 09 20 20 28 73 65 74 21 20 emote).. (set!
6240: 2a 74 72 61 6e 73 70 6f 72 74 2d 74 79 70 65 2a *transport-type*
6250: 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c (string->symbol
6260: 20 74 72 61 6e 73 70 6f 72 74 29 29 0a 09 20 20 transport))..
6270: 28 69 66 20 28 6e 6f 74 20 74 61 72 67 65 74 29 (if (not target)
6280: 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 .. (begin..
6290: 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 .(debug:print 0
62a0: 22 45 52 52 4f 52 3a 20 2d 74 61 72 67 65 74 20 "ERROR: -target
62b0: 69 73 20 72 65 71 75 69 72 65 64 2e 22 29 0a 09 is required.")..
62c0: 09 28 65 78 69 74 20 31 29 29 29 0a 09 20 20 28 .(exit 1))).. (
62d0: 69 66 20 28 6e 6f 74 20 28 73 65 74 75 70 2d 66 if (not (setup-f
62e0: 6f 72 2d 72 75 6e 29 29 0a 09 20 20 20 20 20 20 or-run))..
62f0: 28 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 3a (begin...(debug:
6300: 70 72 69 6e 74 20 30 20 22 46 61 69 6c 65 64 20 print 0 "Failed
6310: 74 6f 20 73 65 74 75 70 2c 20 67 69 76 69 6e 67 to setup, giving
6320: 20 75 70 20 6f 6e 20 2d 74 65 73 74 2d 70 61 74 up on -test-pat
6330: 68 73 20 6f 72 20 2d 74 65 73 74 2d 66 69 6c 65 hs or -test-file
6340: 73 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 09 28 s, exiting")...(
6350: 65 78 69 74 20 31 29 29 29 0a 09 20 20 28 6c 65 exit 1))).. (le
6360: 74 2a 20 28 28 6b 65 79 73 20 20 20 20 20 28 63 t* ((keys (c
6370: 64 62 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 64 62 db:remote-run db
6380: 3a 67 65 74 2d 6b 65 79 73 20 64 62 29 29 0a 09 :get-keys db))..
6390: 09 20 28 6b 65 79 6e 61 6d 65 73 20 28 6d 61 70 . (keynames (map
63a0: 20 6b 65 79 3a 67 65 74 2d 66 69 65 6c 64 6e 61 key:get-fieldna
63b0: 6d 65 20 6b 65 79 73 29 29 0a 09 09 20 3b 3b 20 me keys))... ;;
63c0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 70 61 74 68 db:test-get-path
63d0: 73 20 6d 75 73 74 20 6e 6f 74 20 62 65 20 72 75 s must not be ru
63e0: 6e 20 72 65 6d 6f 74 65 0a 09 09 20 28 70 61 74 n remote... (pat
63f0: 68 73 20 20 20 20 28 64 62 3a 74 65 73 74 2d 67 hs (db:test-g
6400: 65 74 2d 70 61 74 68 73 2d 6d 61 74 63 68 69 6e et-paths-matchin
6410: 67 20 64 62 20 6b 65 79 6e 61 6d 65 73 20 74 61 g db keynames ta
6420: 72 67 65 74 20 28 61 72 67 73 3a 67 65 74 2d 61 rget (args:get-a
6430: 72 67 20 22 2d 74 65 73 74 2d 66 69 6c 65 73 22 rg "-test-files"
6440: 29 29 29 29 0a 09 20 20 20 20 28 73 65 74 21 20 )))).. (set!
6450: 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
6460: 74 29 0a 09 20 20 20 20 28 66 6f 72 2d 65 61 63 t).. (for-eac
6470: 68 20 28 6c 61 6d 62 64 61 20 28 70 61 74 68 29 h (lambda (path)
6480: 0a 09 09 09 28 70 72 69 6e 74 20 70 61 74 68 29 ....(print path)
6490: 29 0a 09 09 20 20 20 20 20 20 70 61 74 68 73 29 )... paths)
64a0: 29 29 0a 09 3b 3b 20 65 6c 73 65 20 64 6f 20 61 ))..;; else do a
64b0: 20 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c general-run-cal
64c0: 6c 0a 09 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d l..(general-run-
64d0: 63 61 6c 6c 20 0a 09 20 22 2d 74 65 73 74 2d 66 call .. "-test-f
64e0: 69 6c 65 73 22 0a 09 20 22 47 65 74 20 70 61 74 iles".. "Get pat
64f0: 68 73 20 74 6f 20 74 65 73 74 22 0a 09 20 28 6c hs to test".. (l
6500: 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 75 ambda (target ru
6510: 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 6e 61 nname keys keyna
6520: 6d 65 73 20 6b 65 79 76 61 6c 6c 73 74 29 0a 09 mes keyvallst)..
6530: 20 20 20 28 6c 65 74 2a 20 28 28 64 62 20 20 20 (let* ((db
6540: 20 20 20 20 23 66 29 0a 09 09 20 20 3b 3b 20 44 #f)... ;; D
6550: 4f 20 4e 4f 54 20 72 75 6e 20 72 65 6d 6f 74 65 O NOT run remote
6560: 0a 09 09 20 20 28 70 61 74 68 73 20 20 20 20 28 ... (paths (
6570: 64 62 3a 74 65 73 74 2d 67 65 74 2d 70 61 74 68 db:test-get-path
6580: 73 2d 6d 61 74 63 68 69 6e 67 20 64 62 20 6b 65 s-matching db ke
6590: 79 6e 61 6d 65 73 20 74 61 72 67 65 74 20 28 61 ynames target (a
65a0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 rgs:get-arg "-te
65b0: 73 74 2d 66 69 6c 65 73 22 29 29 29 29 0a 09 20 st-files"))))..
65c0: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c (for-each (l
65d0: 61 6d 62 64 61 20 28 70 61 74 68 29 0a 09 09 09 ambda (path)....
65e0: 20 28 70 72 69 6e 74 20 70 61 74 68 29 29 0a 09 (print path))..
65f0: 09 20 20 20 20 20 20 20 70 61 74 68 73 29 29 29 . paths)))
6600: 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
6610: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6620: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6630: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6640: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
6650: 20 41 72 63 68 69 76 65 20 74 65 73 74 73 0a 3b Archive tests.;
6660: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
6670: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6680: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6690: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
66a0: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 41 72 63 68 69 =======.;; Archi
66b0: 76 65 20 74 65 73 74 73 20 6d 61 74 63 68 69 6e ve tests matchin
66c0: 67 20 74 61 72 67 65 74 2c 20 72 75 6e 6e 61 6d g target, runnam
66d0: 65 2c 20 61 6e 64 20 74 65 73 74 70 61 74 74 0a e, and testpatt.
66e0: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
66f0: 67 20 22 2d 61 72 63 68 69 76 65 22 29 0a 20 20 g "-archive").
6700: 20 20 3b 3b 20 69 66 20 77 65 20 61 72 65 20 69 ;; if we are i
6710: 6e 20 61 20 74 65 73 74 20 75 73 65 20 74 68 65 n a test use the
6720: 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 64 61 74 61 MT_CMDINFO data
6730: 0a 20 20 20 20 28 69 66 20 28 67 65 74 65 6e 76 . (if (getenv
6740: 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 0a 09 "MT_CMDINFO")..
6750: 28 6c 65 74 2a 20 28 28 73 74 61 72 74 69 6e 67 (let* ((starting
6760: 64 69 72 20 28 63 75 72 72 65 6e 74 2d 64 69 72 dir (current-dir
6770: 65 63 74 6f 72 79 29 29 0a 09 20 20 20 20 20 20 ectory))..
6780: 20 28 63 6d 64 69 6e 66 6f 20 20 20 28 72 65 61 (cmdinfo (rea
6790: 64 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 73 74 d (open-input-st
67a0: 72 69 6e 67 20 28 62 61 73 65 36 34 3a 62 61 73 ring (base64:bas
67b0: 65 36 34 2d 64 65 63 6f 64 65 20 28 67 65 74 65 e64-decode (gete
67c0: 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 nv "MT_CMDINFO")
67d0: 29 29 29 29 0a 09 20 20 20 20 20 20 20 3b 3b 20 )))).. ;;
67e0: 28 72 75 6e 72 65 6d 6f 74 65 20 28 61 73 73 6f (runremote (asso
67f0: 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 72 65 c/default 'runre
6800: 6d 6f 74 65 20 63 6d 64 69 6e 66 6f 29 29 0a 09 mote cmdinfo))..
6810: 20 20 20 20 20 20 20 28 74 72 61 6e 73 70 6f 72 (transpor
6820: 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 t (assoc/default
6830: 20 27 74 72 61 6e 73 70 6f 72 74 20 63 6d 64 69 'transport cmdi
6840: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 74 nfo)).. (t
6850: 65 73 74 70 61 74 68 20 20 28 61 73 73 6f 63 2f estpath (assoc/
6860: 64 65 66 61 75 6c 74 20 27 74 65 73 74 70 61 74 default 'testpat
6870: 68 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 h cmdinfo))..
6880: 20 20 20 20 20 28 74 65 73 74 2d 6e 61 6d 65 20 (test-name
6890: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
68a0: 74 65 73 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 test-name cmdinf
68b0: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e o)).. (run
68c0: 73 63 72 69 70 74 20 28 61 73 73 6f 63 2f 64 65 script (assoc/de
68d0: 66 61 75 6c 74 20 27 72 75 6e 73 63 72 69 70 74 fault 'runscript
68e0: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
68f0: 20 20 20 28 64 62 2d 68 6f 73 74 20 20 20 28 61 (db-host (a
6900: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 64 62 ssoc/default 'db
6910: 2d 68 6f 73 74 20 20 20 63 6d 64 69 6e 66 6f 29 -host cmdinfo)
6920: 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 2d 69 ).. (run-i
6930: 64 20 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 d (assoc/defa
6940: 75 6c 74 20 27 72 75 6e 2d 69 64 20 20 20 20 63 ult 'run-id c
6950: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
6960: 20 28 69 74 65 6d 64 61 74 20 20 20 28 61 73 73 (itemdat (ass
6970: 6f 63 2f 64 65 66 61 75 6c 74 20 27 69 74 65 6d oc/default 'item
6980: 64 61 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a dat cmdinfo)).
6990: 09 20 20 20 20 20 20 20 28 64 62 20 20 20 20 20 . (db
69a0: 20 20 20 23 66 29 0a 09 20 20 20 20 20 20 20 28 #f).. (
69b0: 73 74 61 74 65 20 20 20 20 20 28 61 72 67 73 3a state (args:
69c0: 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 65 22 get-arg ":state"
69d0: 29 29 0a 09 20 20 20 20 20 20 20 28 73 74 61 74 )).. (stat
69e0: 75 73 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d us (args:get-
69f0: 61 72 67 20 22 3a 73 74 61 74 75 73 22 29 29 0a arg ":status")).
6a00: 09 20 20 20 20 20 20 20 28 74 61 72 67 65 74 20 . (target
6a10: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
6a20: 20 22 2d 74 61 72 67 65 74 22 29 29 29 0a 09 20 "-target")))..
6a30: 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f (change-directo
6a40: 72 79 20 74 65 73 74 70 61 74 68 29 0a 09 20 20 ry testpath)..
6a50: 3b 3b 20 28 73 65 74 21 20 2a 72 75 6e 72 65 6d ;; (set! *runrem
6a60: 6f 74 65 2a 20 72 75 6e 72 65 6d 6f 74 65 29 0a ote* runremote).
6a70: 09 20 20 28 73 65 74 21 20 2a 74 72 61 6e 73 70 . (set! *transp
6a80: 6f 72 74 2d 74 79 70 65 2a 20 28 73 74 72 69 6e ort-type* (strin
6a90: 67 2d 3e 73 79 6d 62 6f 6c 20 74 72 61 6e 73 70 g->symbol transp
6aa0: 6f 72 74 29 29 0a 09 20 20 28 69 66 20 28 6e 6f ort)).. (if (no
6ab0: 74 20 74 61 72 67 65 74 29 0a 09 20 20 20 20 20 t target)..
6ac0: 20 28 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 (begin...(debug
6ad0: 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a :print 0 "ERROR:
6ae0: 20 2d 74 61 72 67 65 74 20 69 73 20 72 65 71 75 -target is requ
6af0: 69 72 65 64 2e 22 29 0a 09 09 28 65 78 69 74 20 ired.")...(exit
6b00: 31 29 29 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 1))).. (if (not
6b10: 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 (setup-for-run)
6b20: 29 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a ).. (begin.
6b30: 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 ..(debug:print 0
6b40: 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 "Failed to setu
6b50: 70 2c 20 67 69 76 69 6e 67 20 75 70 20 6f 6e 20 p, giving up on
6b60: 2d 61 72 63 68 69 76 65 2c 20 65 78 69 74 69 6e -archive, exitin
6b70: 67 22 29 0a 09 09 28 65 78 69 74 20 31 29 29 29 g")...(exit 1)))
6b80: 0a 09 20 20 28 6c 65 74 2a 20 28 28 6b 65 79 73 .. (let* ((keys
6b90: 20 20 20 20 20 28 63 64 62 3a 72 65 6d 6f 74 65 (cdb:remote
6ba0: 2d 72 75 6e 20 64 62 3a 67 65 74 2d 6b 65 79 73 -run db:get-keys
6bb0: 20 64 62 29 29 0a 09 09 20 28 6b 65 79 6e 61 6d db))... (keynam
6bc0: 65 73 20 28 6d 61 70 20 6b 65 79 3a 67 65 74 2d es (map key:get-
6bd0: 66 69 65 6c 64 6e 61 6d 65 20 6b 65 79 73 29 29 fieldname keys))
6be0: 0a 09 09 20 3b 3b 20 44 4f 20 4e 4f 54 20 72 75 ... ;; DO NOT ru
6bf0: 6e 20 72 65 6d 6f 74 65 0a 09 09 20 28 70 61 74 n remote... (pat
6c00: 68 73 20 20 20 20 28 64 62 3a 74 65 73 74 2d 67 hs (db:test-g
6c10: 65 74 2d 70 61 74 68 73 2d 6d 61 74 63 68 69 6e et-paths-matchin
6c20: 67 20 64 62 20 6b 65 79 6e 61 6d 65 73 20 74 61 g db keynames ta
6c30: 72 67 65 74 29 29 29 0a 09 20 20 20 20 28 73 65 rget))).. (se
6c40: 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
6c50: 2a 20 23 74 29 0a 09 20 20 20 20 28 66 6f 72 2d * #t).. (for-
6c60: 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 70 61 each (lambda (pa
6c70: 74 68 29 0a 09 09 09 28 70 72 69 6e 74 20 70 61 th)....(print pa
6c80: 74 68 29 29 0a 09 09 20 20 20 20 20 20 70 61 74 th))... pat
6c90: 68 73 29 29 29 0a 09 3b 3b 20 65 6c 73 65 20 64 hs)))..;; else d
6ca0: 6f 20 61 20 67 65 6e 65 72 61 6c 2d 72 75 6e 2d o a general-run-
6cb0: 63 61 6c 6c 0a 09 28 67 65 6e 65 72 61 6c 2d 72 call..(general-r
6cc0: 75 6e 2d 63 61 6c 6c 20 0a 09 20 22 2d 74 65 73 un-call .. "-tes
6cd0: 74 2d 70 61 74 68 73 22 0a 09 20 22 47 65 74 20 t-paths".. "Get
6ce0: 70 61 74 68 73 20 74 6f 20 74 65 73 74 73 22 0a paths to tests".
6cf0: 09 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 . (lambda (targe
6d00: 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b t runname keys k
6d10: 65 79 6e 61 6d 65 73 20 6b 65 79 76 61 6c 6c 73 eynames keyvalls
6d20: 74 29 0a 09 20 20 20 28 6c 65 74 2a 20 28 28 64 t).. (let* ((d
6d30: 62 20 20 20 20 20 20 20 23 66 29 0a 09 09 20 20 b #f)...
6d40: 3b 3b 20 44 4f 20 4e 4f 54 20 72 75 6e 20 72 65 ;; DO NOT run re
6d50: 6d 6f 74 65 0a 09 09 20 20 28 70 61 74 68 73 20 mote... (paths
6d60: 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d (db:test-get-
6d70: 70 61 74 68 73 2d 6d 61 74 63 68 69 6e 67 20 64 paths-matching d
6d80: 62 20 6b 65 79 6e 61 6d 65 73 20 74 61 72 67 65 b keynames targe
6d90: 74 29 29 29 0a 09 20 20 20 20 20 28 66 6f 72 2d t))).. (for-
6da0: 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 70 61 each (lambda (pa
6db0: 74 68 29 0a 09 09 09 20 28 70 72 69 6e 74 20 70 th).... (print p
6dc0: 61 74 68 29 29 0a 09 09 20 20 20 20 20 20 20 70 ath))... p
6dd0: 61 74 68 73 29 29 29 29 29 29 0a 0a 3b 3b 3d 3d aths))))))..;;==
6de0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6df0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6e00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6e10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6e20: 3d 3d 3d 3d 0a 3b 3b 20 45 78 74 72 61 63 74 20 ====.;; Extract
6e30: 61 20 73 70 72 65 61 64 73 68 65 65 74 20 66 72 a spreadsheet fr
6e40: 6f 6d 20 74 68 65 20 72 75 6e 73 20 64 61 74 61 om the runs data
6e50: 62 61 73 65 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d base.;;=========
6e60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6e70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6e80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6e90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 =============..(
6ea0: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
6eb0: 20 22 2d 65 78 74 72 61 63 74 2d 6f 64 73 22 29 "-extract-ods")
6ec0: 0a 20 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 . (general-ru
6ed0: 6e 2d 63 61 6c 6c 0a 20 20 20 20 20 22 2d 65 78 n-call. "-ex
6ee0: 74 72 61 63 74 2d 6f 64 73 22 0a 20 20 20 20 20 tract-ods".
6ef0: 22 4d 61 6b 65 20 6f 64 73 20 73 70 72 65 61 64 "Make ods spread
6f00: 73 68 65 65 74 22 0a 20 20 20 20 20 28 6c 61 6d sheet". (lam
6f10: 62 64 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e bda (target runn
6f20: 61 6d 65 20 6b 65 79 73 20 6b 65 79 6e 61 6d 65 ame keys keyname
6f30: 73 20 6b 65 79 76 61 6c 6c 73 74 29 0a 20 20 20 s keyvallst).
6f40: 20 20 20 20 28 6c 65 74 20 28 28 64 62 20 20 20 (let ((db
6f50: 20 20 20 20 20 20 23 66 29 0a 09 20 20 20 20 20 #f)..
6f60: 28 6f 75 74 70 75 74 66 69 6c 65 20 28 61 72 67 (outputfile (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 29 0a 09 20 20 20 20 act-ods"))..
6f90: 20 28 72 75 6e 73 70 61 74 74 20 20 20 28 61 72 (runspatt (ar
6fa0: 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e gs:get-arg ":run
6fb0: 6e 61 6d 65 22 29 29 0a 09 20 20 20 20 20 28 70 name")).. (p
6fc0: 61 74 68 6d 6f 64 20 20 20 20 28 61 72 67 73 3a athmod (args:
6fd0: 67 65 74 2d 61 72 67 20 22 2d 70 61 74 68 6d 6f get-arg "-pathmo
6fe0: 64 22 29 29 0a 09 20 20 20 20 20 28 6b 65 79 76 d")).. (keyv
6ff0: 61 6c 61 6c 69 73 74 20 28 6b 65 79 73 2d 3e 61 alalist (keys->a
7000: 6c 69 73 74 20 6b 65 79 73 20 22 25 22 29 29 29 list keys "%")))
7010: 0a 09 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 .. (debug:print
7020: 32 20 22 45 78 74 72 61 63 74 20 6f 64 73 2c 20 2 "Extract ods,
7030: 6f 75 74 70 75 74 66 69 6c 65 3a 20 22 20 6f 75 outputfile: " ou
7040: 74 70 75 74 66 69 6c 65 20 22 20 72 75 6e 73 70 tputfile " runsp
7050: 61 74 74 3a 20 22 20 72 75 6e 73 70 61 74 74 20 att: " runspatt
7060: 22 20 6b 65 79 76 61 6c 61 6c 69 73 74 3a 20 22 " keyvalalist: "
7070: 20 6b 65 79 76 61 6c 61 6c 69 73 74 29 0a 09 20 keyvalalist)..
7080: 28 63 64 62 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 (cdb:remote-run
7090: 64 62 3a 65 78 74 72 61 63 74 2d 6f 64 73 2d 66 db:extract-ods-f
70a0: 69 6c 65 20 64 62 20 6f 75 74 70 75 74 66 69 6c ile db outputfil
70b0: 65 20 6b 65 79 76 61 6c 61 6c 69 73 74 20 28 69 e keyvalalist (i
70c0: 66 20 72 75 6e 73 70 61 74 74 20 72 75 6e 73 70 f runspatt runsp
70d0: 61 74 74 20 22 25 22 29 20 70 61 74 68 6d 6f 64 att "%") pathmod
70e0: 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d )))))..;;=======
70f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7100: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7110: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7120: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
7130: 3b 3b 20 65 78 65 63 75 74 65 20 74 68 65 20 74 ;; execute the t
7140: 65 73 74 0a 3b 3b 20 20 20 20 2d 20 67 65 74 73 est.;; - gets
7150: 20 63 61 6c 6c 65 64 20 6f 6e 20 72 65 6d 6f 74 called on remot
7160: 65 20 68 6f 73 74 0a 3b 3b 20 20 20 20 2d 20 72 e host.;; - r
7170: 65 63 65 69 76 65 73 20 69 6e 66 6f 20 66 72 6f eceives info fro
7180: 6d 20 74 68 65 20 2d 65 78 65 63 75 74 65 20 70 m the -execute p
7190: 61 72 61 6d 0a 3b 3b 20 20 20 20 2d 20 70 61 73 aram.;; - pas
71a0: 73 65 73 20 69 6e 66 6f 20 74 6f 20 73 74 65 70 ses info to step
71b0: 73 20 76 69 61 20 4d 54 5f 43 4d 44 49 4e 46 4f s via MT_CMDINFO
71c0: 20 65 6e 76 20 76 61 72 20 28 66 75 74 75 72 65 env var (future
71d0: 20 69 73 20 74 6f 20 75 73 65 20 61 20 64 6f 74 is to use a dot
71e0: 20 66 69 6c 65 29 0a 3b 3b 20 20 20 20 2d 20 67 file).;; - g
71f0: 61 74 68 65 72 73 20 68 6f 73 74 20 69 6e 66 6f athers host info
7200: 20 61 6e 64 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d and .;;========
7210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7220: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7230: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7240: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
7250: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
7260: 67 20 22 2d 65 78 65 63 75 74 65 22 29 0a 20 20 g "-execute").
7270: 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 (begin. (
7280: 6c 61 75 6e 63 68 3a 65 78 65 63 75 74 65 20 28 launch:execute (
7290: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 args:get-arg "-e
72a0: 78 65 63 75 74 65 22 29 29 0a 20 20 20 20 20 20 xecute")).
72b0: 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
72c0: 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d ing* #t)))..;;==
72d0: 3d 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 0a 3b 3b 20 54 65 73 74 20 63 6f 6d ====.;; Test com
7320: 6d 61 6e 64 73 20 28 69 2e 65 2e 20 66 6f 72 20 mands (i.e. for
7330: 75 73 65 20 69 6e 73 69 64 65 20 74 65 73 74 73 use inside tests
7340: 29 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ).;;============
7350: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 ==========..(def
7390: 69 6e 65 20 28 6d 65 67 61 74 65 73 74 3a 73 74 ine (megatest:st
73a0: 65 70 20 73 74 65 70 20 73 74 61 74 65 20 73 74 ep step state st
73b0: 61 74 75 73 20 6c 6f 67 66 69 6c 65 20 6d 73 67 atus logfile msg
73c0: 29 0a 20 20 28 69 66 20 28 6e 6f 74 20 28 67 65 ). (if (not (ge
73d0: 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f tenv "MT_CMDINFO
73e0: 22 29 29 0a 20 20 20 20 20 20 28 62 65 67 69 6e ")). (begin
73f0: 0a 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 ..(debug:print 0
7400: 20 22 45 52 52 4f 52 3a 20 4d 54 5f 43 4d 44 49 "ERROR: MT_CMDI
7410: 4e 46 4f 20 65 6e 76 20 76 61 72 20 6e 6f 74 20 NFO env var not
7420: 73 65 74 2c 20 2d 73 74 65 70 20 6d 75 73 74 20 set, -step must
7430: 62 65 20 63 61 6c 6c 65 64 20 2a 69 6e 73 69 64 be called *insid
7440: 65 2a 20 61 20 6d 65 67 61 74 65 73 74 20 69 6e e* a megatest in
7450: 76 6f 6b 65 64 20 65 6e 76 69 72 6f 6e 6d 65 6e voked environmen
7460: 74 21 22 29 0a 09 28 65 78 69 74 20 35 29 29 0a t!")..(exit 5)).
7470: 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 63 6d (let* ((cm
7480: 64 69 6e 66 6f 20 20 20 28 72 65 61 64 20 28 6f dinfo (read (o
7490: 70 65 6e 2d 69 6e 70 75 74 2d 73 74 72 69 6e 67 pen-input-string
74a0: 20 28 62 61 73 65 36 34 3a 62 61 73 65 36 34 2d (base64:base64-
74b0: 64 65 63 6f 64 65 20 28 67 65 74 65 6e 76 20 22 decode (getenv "
74c0: 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 29 29 29 MT_CMDINFO")))))
74d0: 0a 09 20 20 20 20 20 3b 3b 20 28 72 75 6e 72 65 .. ;; (runre
74e0: 6d 6f 74 65 20 28 61 73 73 6f 63 2f 64 65 66 61 mote (assoc/defa
74f0: 75 6c 74 20 27 72 75 6e 72 65 6d 6f 74 65 20 63 ult 'runremote c
7500: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 mdinfo)).. (
7510: 74 72 61 6e 73 70 6f 72 74 20 28 61 73 73 6f 63 transport (assoc
7520: 2f 64 65 66 61 75 6c 74 20 27 74 72 61 6e 73 70 /default 'transp
7530: 6f 72 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 ort cmdinfo))..
7540: 20 20 20 20 28 74 65 73 74 70 61 74 68 20 20 28 (testpath (
7550: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 assoc/default 't
7560: 65 73 74 70 61 74 68 20 20 63 6d 64 69 6e 66 6f estpath cmdinfo
7570: 29 29 0a 09 20 20 20 20 20 28 74 65 73 74 2d 6e )).. (test-n
7580: 61 6d 65 20 28 61 73 73 6f 63 2f 64 65 66 61 75 ame (assoc/defau
7590: 6c 74 20 27 74 65 73 74 2d 6e 61 6d 65 20 63 6d lt 'test-name cm
75a0: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 72 dinfo)).. (r
75b0: 75 6e 73 63 72 69 70 74 20 28 61 73 73 6f 63 2f unscript (assoc/
75c0: 64 65 66 61 75 6c 74 20 27 72 75 6e 73 63 72 69 default 'runscri
75d0: 70 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 pt cmdinfo))..
75e0: 20 20 20 28 64 62 2d 68 6f 73 74 20 20 20 28 61 (db-host (a
75f0: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 64 62 ssoc/default 'db
7600: 2d 68 6f 73 74 20 20 20 63 6d 64 69 6e 66 6f 29 -host cmdinfo)
7610: 29 0a 09 20 20 20 20 20 28 72 75 6e 2d 69 64 20 ).. (run-id
7620: 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c (assoc/defaul
7630: 74 20 27 72 75 6e 2d 69 64 20 20 20 20 63 6d 64 t 'run-id cmd
7640: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 74 65 info)).. (te
7650: 73 74 2d 69 64 20 20 20 28 61 73 73 6f 63 2f 64 st-id (assoc/d
7660: 65 66 61 75 6c 74 20 27 74 65 73 74 2d 69 64 20 efault 'test-id
7670: 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 cmdinfo))..
7680: 20 20 28 69 74 65 6d 64 61 74 20 20 20 28 61 73 (itemdat (as
7690: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 69 74 65 soc/default 'ite
76a0: 6d 64 61 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 mdat cmdinfo))
76b0: 0a 09 20 20 20 20 20 28 64 62 20 20 20 20 20 20 .. (db
76c0: 20 20 23 66 29 29 0a 09 28 63 68 61 6e 67 65 2d #f))..(change-
76d0: 64 69 72 65 63 74 6f 72 79 20 74 65 73 74 70 61 directory testpa
76e0: 74 68 29 0a 09 3b 3b 20 28 73 65 74 21 20 2a 72 th)..;; (set! *r
76f0: 75 6e 72 65 6d 6f 74 65 2a 20 72 75 6e 72 65 6d unremote* runrem
7700: 6f 74 65 29 0a 09 28 73 65 74 21 20 2a 74 72 61 ote)..(set! *tra
7710: 6e 73 70 6f 72 74 2d 74 79 70 65 2a 20 28 73 74 nsport-type* (st
7720: 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 74 72 61 ring->symbol tra
7730: 6e 73 70 6f 72 74 29 29 0a 09 28 69 66 20 28 6e nsport))..(if (n
7740: 6f 74 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 ot (setup-for-ru
7750: 6e 29 29 0a 09 20 20 20 20 28 62 65 67 69 6e 0a n)).. (begin.
7760: 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
7770: 69 6e 74 20 30 20 22 46 61 69 6c 65 64 20 74 6f int 0 "Failed to
7780: 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 setup, exiting"
7790: 29 0a 09 20 20 20 20 20 20 28 65 78 69 74 20 31 ).. (exit 1
77a0: 29 29 29 0a 09 28 69 66 20 28 61 6e 64 20 73 74 )))..(if (and st
77b0: 61 74 65 20 73 74 61 74 75 73 29 0a 09 20 20 20 ate status)..
77c0: 20 3b 3b 20 44 4f 20 4e 4f 54 20 72 65 6d 6f 74 ;; DO NOT remot
77d0: 65 20 72 75 6e 0a 09 20 20 20 20 28 64 62 3a 74 e run.. (db:t
77e0: 65 73 74 73 74 65 70 2d 73 65 74 2d 73 74 61 74 eststep-set-stat
77f0: 75 73 21 20 64 62 20 74 65 73 74 2d 69 64 20 73 us! db test-id s
7800: 74 65 70 20 73 74 61 74 65 20 73 74 61 74 75 73 tep state status
7810: 20 6d 73 67 20 6c 6f 67 66 69 6c 65 29 0a 09 20 msg logfile)..
7820: 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 (begin..
7830: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
7840: 22 45 52 52 4f 52 3a 20 59 6f 75 20 6d 75 73 74 "ERROR: You must
7850: 20 73 70 65 63 69 66 79 20 3a 73 74 61 74 65 20 specify :state
7860: 61 6e 64 20 3a 73 74 61 74 75 73 20 77 69 74 68 and :status with
7870: 20 65 76 65 72 79 20 63 61 6c 6c 20 74 6f 20 2d every call to -
7880: 73 74 65 70 22 29 0a 09 20 20 20 20 20 20 28 65 step").. (e
7890: 78 69 74 20 36 29 29 29 29 29 29 0a 0a 28 69 66 xit 6))))))..(if
78a0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
78b0: 2d 73 74 65 70 22 29 0a 20 20 20 20 28 62 65 67 -step"). (beg
78c0: 69 6e 0a 20 20 20 20 20 20 28 6d 65 67 61 74 65 in. (megate
78d0: 73 74 3a 73 74 65 70 20 0a 20 20 20 20 20 20 20 st:step .
78e0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
78f0: 73 74 65 70 22 29 0a 20 20 20 20 20 20 20 28 61 step"). (a
7900: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 rgs:get-arg ":st
7910: 61 74 65 22 29 0a 20 20 20 20 20 20 20 28 61 72 ate"). (ar
7920: 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 gs:get-arg ":sta
7930: 74 75 73 22 29 0a 20 20 20 20 20 20 20 28 61 72 tus"). (ar
7940: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 gs:get-arg "-set
7950: 6c 6f 67 22 29 0a 20 20 20 20 20 20 20 28 61 72 log"). (ar
7960: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 gs:get-arg "-m")
7970: 29 0a 20 20 20 20 20 20 3b 3b 20 28 69 66 20 64 ). ;; (if d
7980: 62 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c b (sqlite3:final
7990: 69 7a 65 21 20 64 62 29 29 0a 20 20 20 20 20 20 ize! db)).
79a0: 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
79b0: 69 6e 67 2a 20 23 74 29 29 29 0a 20 20 20 20 0a ing* #t))). .
79c0: 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 (if (or (args:ge
79d0: 74 2d 61 72 67 20 22 2d 73 65 74 6c 6f 67 22 29 t-arg "-setlog")
79e0: 20 20 20 20 20 20 20 3b 3b 20 73 69 6e 63 65 20 ;; since
79f0: 73 65 74 74 69 6e 67 20 75 70 20 69 73 20 73 6f setting up is so
7a00: 20 63 6f 73 74 6c 79 20 6c 65 74 73 20 70 69 67 costly lets pig
7a10: 67 79 62 61 63 6b 20 6f 6e 20 2d 74 65 73 74 2d gyback on -test-
7a20: 73 74 61 74 75 73 0a 09 28 61 72 67 73 3a 67 65 status..(args:ge
7a30: 74 2d 61 72 67 20 22 2d 73 65 74 2d 74 6f 70 6c t-arg "-set-topl
7a40: 6f 67 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d og")..(args:get-
7a50: 61 72 67 20 22 2d 74 65 73 74 2d 73 74 61 74 75 arg "-test-statu
7a60: 73 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 s")..(args:get-a
7a70: 72 67 20 22 2d 73 65 74 2d 76 61 6c 75 65 73 22 rg "-set-values"
7a80: 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 )..(args:get-arg
7a90: 20 22 2d 6c 6f 61 64 2d 74 65 73 74 2d 64 61 74 "-load-test-dat
7aa0: 61 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 a")..(args:get-a
7ab0: 72 67 20 22 2d 72 75 6e 73 74 65 70 22 29 0a 09 rg "-runstep")..
7ac0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
7ad0: 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 22 summarize-items"
7ae0: 29 29 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 )). (if (not
7af0: 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 (getenv "MT_CMDI
7b00: 4e 46 4f 22 29 29 0a 09 28 62 65 67 69 6e 0a 09 NFO"))..(begin..
7b10: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
7b20: 20 22 45 52 52 4f 52 3a 20 4d 54 5f 43 4d 44 49 "ERROR: MT_CMDI
7b30: 4e 46 4f 20 65 6e 76 20 76 61 72 20 6e 6f 74 20 NFO env var not
7b40: 73 65 74 2c 20 63 6f 6d 6d 61 6e 64 73 20 2d 74 set, commands -t
7b50: 65 73 74 2d 73 74 61 74 75 73 2c 20 2d 72 75 6e est-status, -run
7b60: 73 74 65 70 20 61 6e 64 20 2d 73 65 74 6c 6f 67 step and -setlog
7b70: 20 6d 75 73 74 20 62 65 20 63 61 6c 6c 65 64 20 must be called
7b80: 2a 69 6e 73 69 64 65 2a 20 61 20 6d 65 67 61 74 *inside* a megat
7b90: 65 73 74 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 21 est environment!
7ba0: 22 29 0a 09 20 20 28 65 78 69 74 20 35 29 29 0a ").. (exit 5)).
7bb0: 09 28 6c 65 74 2a 20 28 28 73 74 61 72 74 69 6e .(let* ((startin
7bc0: 67 64 69 72 20 28 63 75 72 72 65 6e 74 2d 64 69 gdir (current-di
7bd0: 72 65 63 74 6f 72 79 29 29 0a 09 20 20 20 20 20 rectory))..
7be0: 20 20 28 63 6d 64 69 6e 66 6f 20 20 20 28 72 65 (cmdinfo (re
7bf0: 61 64 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 73 ad (open-input-s
7c00: 74 72 69 6e 67 20 28 62 61 73 65 36 34 3a 62 61 tring (base64:ba
7c10: 73 65 36 34 2d 64 65 63 6f 64 65 20 28 67 65 74 se64-decode (get
7c20: 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 env "MT_CMDINFO"
7c30: 29 29 29 29 29 0a 09 20 20 20 20 20 20 20 3b 3b ))))).. ;;
7c40: 20 28 72 75 6e 72 65 6d 6f 74 65 20 28 61 73 73 (runremote (ass
7c50: 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 72 oc/default 'runr
7c60: 65 6d 6f 74 65 20 63 6d 64 69 6e 66 6f 29 29 0a emote cmdinfo)).
7c70: 09 20 20 20 20 20 20 20 28 74 72 61 6e 73 70 6f . (transpo
7c80: 72 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c rt (assoc/defaul
7c90: 74 20 27 74 72 61 6e 73 70 6f 72 74 20 63 6d 64 t 'transport cmd
7ca0: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
7cb0: 74 65 73 74 70 61 74 68 20 20 28 61 73 73 6f 63 testpath (assoc
7cc0: 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 70 61 /default 'testpa
7cd0: 74 68 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 th cmdinfo))..
7ce0: 20 20 20 20 20 20 28 74 65 73 74 2d 6e 61 6d 65 (test-name
7cf0: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
7d00: 27 74 65 73 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 'test-name cmdin
7d10: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 fo)).. (ru
7d20: 6e 73 63 72 69 70 74 20 28 61 73 73 6f 63 2f 64 nscript (assoc/d
7d30: 65 66 61 75 6c 74 20 27 72 75 6e 73 63 72 69 70 efault 'runscrip
7d40: 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 t cmdinfo))..
7d50: 20 20 20 20 28 64 62 2d 68 6f 73 74 20 20 20 28 (db-host (
7d60: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 64 assoc/default 'd
7d70: 62 2d 68 6f 73 74 20 20 20 63 6d 64 69 6e 66 6f b-host cmdinfo
7d80: 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 2d )).. (run-
7d90: 69 64 20 20 20 20 28 61 73 73 6f 63 2f 64 65 66 id (assoc/def
7da0: 61 75 6c 74 20 27 72 75 6e 2d 69 64 20 20 20 20 ault 'run-id
7db0: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
7dc0: 20 20 28 74 65 73 74 2d 69 64 20 20 20 28 61 73 (test-id (as
7dd0: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 soc/default 'tes
7de0: 74 2d 69 64 20 20 20 63 6d 64 69 6e 66 6f 29 29 t-id cmdinfo))
7df0: 0a 09 20 20 20 20 20 20 20 28 69 74 65 6d 64 61 .. (itemda
7e00: 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 t (assoc/defau
7e10: 6c 74 20 27 69 74 65 6d 64 61 74 20 20 20 63 6d lt 'itemdat cm
7e20: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
7e30: 28 64 62 20 20 20 20 20 20 20 20 23 66 29 20 3b (db #f) ;
7e40: 3b 20 28 6f 70 65 6e 2d 64 62 29 29 0a 09 20 20 ; (open-db))..
7e50: 20 20 20 20 20 28 73 74 61 74 65 20 20 20 20 20 (state
7e60: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a (args:get-arg ":
7e70: 73 74 61 74 65 22 29 29 0a 09 20 20 20 20 20 20 state"))..
7e80: 20 28 73 74 61 74 75 73 20 20 20 20 28 61 72 67 (status (arg
7e90: 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 s:get-arg ":stat
7ea0: 75 73 22 29 29 29 0a 09 20 20 28 63 68 61 6e 67 us"))).. (chang
7eb0: 65 2d 64 69 72 65 63 74 6f 72 79 20 74 65 73 74 e-directory test
7ec0: 70 61 74 68 29 0a 09 20 20 3b 3b 20 28 73 65 74 path).. ;; (set
7ed0: 21 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 72 75 ! *runremote* ru
7ee0: 6e 72 65 6d 6f 74 65 29 0a 09 20 20 28 73 65 74 nremote).. (set
7ef0: 21 20 2a 74 72 61 6e 73 70 6f 72 74 2d 74 79 70 ! *transport-typ
7f00: 65 2a 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 e* (string->symb
7f10: 6f 6c 20 74 72 61 6e 73 70 6f 72 74 29 29 0a 09 ol transport))..
7f20: 20 20 28 69 66 20 28 6e 6f 74 20 28 73 65 74 75 (if (not (setu
7f30: 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 20 20 20 p-for-run))..
7f40: 20 20 20 28 62 65 67 69 6e 0a 09 09 28 64 65 62 (begin...(deb
7f50: 75 67 3a 70 72 69 6e 74 20 30 20 22 46 61 69 6c ug:print 0 "Fail
7f60: 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 69 ed to setup, exi
7f70: 74 69 6e 67 22 29 0a 09 09 28 65 78 69 74 20 31 ting")...(exit 1
7f80: 29 29 29 0a 0a 09 20 20 3b 3b 20 63 61 6e 20 73 )))... ;; can s
7f90: 65 74 75 70 20 61 73 20 63 6c 69 65 6e 74 20 66 etup as client f
7fa0: 6f 72 20 73 65 72 76 65 72 20 6d 6f 64 65 20 6e or server mode n
7fb0: 6f 77 0a 09 20 20 3b 3b 20 28 63 6c 69 65 6e 74 ow.. ;; (client
7fc0: 3a 73 65 74 75 70 29 0a 0a 09 20 20 28 69 66 20 :setup)... (if
7fd0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
7fe0: 6c 6f 61 64 2d 74 65 73 74 2d 64 61 74 61 22 29 load-test-data")
7ff0: 0a 09 20 20 20 20 20 20 3b 3b 20 68 61 73 20 73 .. ;; has s
8000: 75 62 20 63 6f 6d 6d 61 6e 64 73 20 74 68 61 74 ub commands that
8010: 20 61 72 65 20 72 64 62 3a 0a 09 20 20 20 20 20 are rdb:..
8020: 20 3b 3b 20 44 4f 20 4e 4f 54 20 70 75 74 20 74 ;; DO NOT put t
8030: 68 69 73 20 6f 6e 65 20 69 6e 74 6f 20 65 69 74 his one into eit
8040: 68 65 72 20 63 64 62 3a 72 65 6d 6f 74 65 2d 72 her cdb:remote-r
8050: 75 6e 20 6f 72 20 6f 70 65 6e 2d 72 75 6e 2d 63 un or open-run-c
8060: 6c 6f 73 65 0a 09 20 20 20 20 20 20 28 64 62 3a lose.. (db:
8070: 6c 6f 61 64 2d 74 65 73 74 2d 64 61 74 61 20 64 load-test-data d
8080: 62 20 74 65 73 74 2d 69 64 29 29 0a 09 20 20 28 b test-id)).. (
8090: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
80a0: 20 22 2d 73 65 74 6c 6f 67 22 29 0a 09 20 20 20 "-setlog")..
80b0: 20 20 20 28 6c 65 74 20 28 28 6c 6f 67 66 6e 61 (let ((logfna
80c0: 6d 65 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 me (args:get-arg
80d0: 20 22 2d 73 65 74 6c 6f 67 22 29 29 29 0a 09 09 "-setlog")))...
80e0: 28 63 64 62 3a 74 65 73 74 2d 73 65 74 2d 6c 6f (cdb:test-set-lo
80f0: 67 21 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 74 g! *runremote* t
8100: 65 73 74 2d 69 64 20 6c 6f 67 66 6e 61 6d 65 29 est-id logfname)
8110: 29 29 0a 09 20 20 28 69 66 20 28 61 72 67 73 3a )).. (if (args:
8120: 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 74 6f get-arg "-set-to
8130: 70 6c 6f 67 22 29 0a 09 20 20 20 20 20 20 3b 3b plog").. ;;
8140: 20 44 4f 20 4e 4f 54 20 72 75 6e 20 72 65 6d 6f DO NOT run remo
8150: 74 65 0a 09 20 20 20 20 20 20 28 74 65 73 74 73 te.. (tests
8160: 3a 74 65 73 74 2d 73 65 74 2d 74 6f 70 6c 6f 67 :test-set-toplog
8170: 21 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 ! db run-id test
8180: 2d 6e 61 6d 65 20 28 61 72 67 73 3a 67 65 74 2d -name (args:get-
8190: 61 72 67 20 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 arg "-set-toplog
81a0: 22 29 29 29 0a 09 20 20 28 69 66 20 28 61 72 67 "))).. (if (arg
81b0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 75 6d 6d s:get-arg "-summ
81c0: 61 72 69 7a 65 2d 69 74 65 6d 73 22 29 0a 09 20 arize-items")..
81d0: 20 20 20 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 72 ;; DO NOT r
81e0: 75 6e 20 72 65 6d 6f 74 65 0a 09 20 20 20 20 20 un remote..
81f0: 20 28 74 65 73 74 73 3a 73 75 6d 6d 61 72 69 7a (tests:summariz
8200: 65 2d 69 74 65 6d 73 20 64 62 20 72 75 6e 2d 69 e-items db run-i
8210: 64 20 74 65 73 74 2d 6e 61 6d 65 20 23 74 29 29 d test-name #t))
8220: 20 3b 3b 20 64 6f 20 66 6f 72 63 65 20 68 65 72 ;; do force her
8230: 65 0a 09 20 20 28 69 66 20 28 61 72 67 73 3a 67 e.. (if (args:g
8240: 65 74 2d 61 72 67 20 22 2d 72 75 6e 73 74 65 70 et-arg "-runstep
8250: 22 29 0a 09 20 20 20 20 20 20 28 69 66 20 28 6e ").. (if (n
8260: 75 6c 6c 3f 20 72 65 6d 61 72 67 73 29 0a 09 09 ull? remargs)...
8270: 20 20 28 62 65 67 69 6e 0a 09 09 20 20 20 20 28 (begin... (
8280: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 debug:print 0 "E
8290: 52 52 4f 52 3a 20 6e 6f 74 68 69 6e 67 20 73 70 RROR: nothing sp
82a0: 65 63 69 66 69 65 64 20 74 6f 20 72 75 6e 21 22 ecified to run!"
82b0: 29 0a 09 09 20 20 20 20 28 69 66 20 64 62 20 28 )... (if db (
82c0: 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 sqlite3:finalize
82d0: 21 20 64 62 29 29 0a 09 09 20 20 20 20 28 65 78 ! db))... (ex
82e0: 69 74 20 36 29 29 0a 09 09 20 20 28 6c 65 74 2a it 6))... (let*
82f0: 20 28 28 73 74 65 70 6e 61 6d 65 20 20 20 28 61 ((stepname (a
8300: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
8310: 6e 73 74 65 70 22 29 29 0a 09 09 09 20 28 6c 6f nstep")).... (lo
8320: 67 70 72 6f 66 69 6c 65 20 28 61 72 67 73 3a 67 gprofile (args:g
8330: 65 74 2d 61 72 67 20 22 2d 6c 6f 67 70 72 6f 22 et-arg "-logpro"
8340: 29 29 0a 09 09 09 20 28 6c 6f 67 66 69 6c 65 20 )).... (logfile
8350: 20 20 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d (conc stepnam
8360: 65 20 22 2e 6c 6f 67 22 29 29 0a 09 09 09 20 28 e ".log")).... (
8370: 63 6d 64 20 20 20 20 20 20 20 20 28 69 66 20 28 cmd (if (
8380: 6e 75 6c 6c 3f 20 72 65 6d 61 72 67 73 29 20 23 null? remargs) #
8390: 66 20 28 63 61 72 20 72 65 6d 61 72 67 73 29 29 f (car remargs))
83a0: 29 0a 09 09 09 20 28 70 61 72 61 6d 73 20 20 20 ).... (params
83b0: 20 20 28 69 66 20 63 6d 64 20 28 63 64 72 20 72 (if cmd (cdr r
83c0: 65 6d 61 72 67 73 29 20 27 28 29 29 29 0a 09 09 emargs) '()))...
83d0: 09 20 28 65 78 69 74 73 74 61 74 20 20 20 23 66 . (exitstat #f
83e0: 29 0a 09 09 09 20 28 73 68 65 6c 6c 20 20 20 20 ).... (shell
83f0: 20 20 28 6c 61 73 74 20 28 73 74 72 69 6e 67 2d (last (string-
8400: 73 70 6c 69 74 20 28 67 65 74 2d 65 6e 76 69 72 split (get-envir
8410: 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 onment-variable
8420: 22 53 48 45 4c 4c 22 29 20 22 2f 22 29 29 29 0a "SHELL") "/"))).
8430: 09 09 09 20 28 72 65 64 69 72 20 20 20 20 20 20 ... (redir
8440: 28 63 61 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 (case (string->s
8450: 79 6d 62 6f 6c 20 73 68 65 6c 6c 29 0a 09 09 09 ymbol shell)....
8460: 09 20 20 20 20 20 20 20 28 28 74 63 73 68 20 63 . ((tcsh c
8470: 73 68 20 6b 73 68 29 20 20 20 20 22 3e 26 22 29 sh ksh) ">&")
8480: 0a 09 09 09 09 20 20 20 20 20 20 20 28 28 7a 73 ..... ((zs
8490: 68 20 62 61 73 68 20 73 68 20 61 73 68 29 20 22 h bash sh ash) "
84a0: 32 3e 26 31 20 3e 22 29 0a 09 09 09 09 20 20 20 2>&1 >").....
84b0: 20 20 20 20 28 65 6c 73 65 20 22 3e 26 22 29 29 (else ">&"))
84c0: 29 0a 09 09 09 20 28 66 75 6c 6c 63 6d 64 20 20 ).... (fullcmd
84d0: 20 20 28 63 6f 6e 63 20 22 28 22 20 28 73 74 72 (conc "(" (str
84e0: 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 ing-intersperse
84f0: 0a 09 09 09 09 09 09 28 63 6f 6e 73 20 63 6d 64 .......(cons cmd
8500: 20 70 61 72 61 6d 73 29 20 22 20 22 29 0a 09 09 params) " ")...
8510: 09 09 09 20 20 20 22 29 20 22 20 72 65 64 69 72 ... ") " redir
8520: 20 22 20 22 20 6c 6f 67 66 69 6c 65 29 29 29 0a " " logfile))).
8530: 09 09 20 20 20 20 3b 3b 20 6d 61 72 6b 20 74 68 .. ;; mark th
8540: 65 20 73 74 61 72 74 20 6f 66 20 74 68 65 20 74 e start of the t
8550: 65 73 74 0a 09 09 20 20 20 20 3b 3b 20 44 4f 20 est... ;; DO
8560: 4e 4f 54 20 72 75 6e 20 72 65 6d 6f 74 65 0a 09 NOT run remote..
8570: 09 20 20 20 20 28 64 62 3a 74 65 73 74 73 74 65 . (db:testste
8580: 70 2d 73 65 74 2d 73 74 61 74 75 73 21 20 64 62 p-set-status! db
8590: 20 74 65 73 74 2d 69 64 20 73 74 65 70 6e 61 6d test-id stepnam
85a0: 65 20 22 73 74 61 72 74 22 20 22 6e 2f 61 22 20 e "start" "n/a"
85b0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
85c0: 6d 22 29 20 6c 6f 67 66 69 6c 65 29 0a 09 09 20 m") logfile)...
85d0: 20 20 20 3b 3b 20 72 75 6e 20 74 68 65 20 74 65 ;; run the te
85e0: 73 74 20 73 74 65 70 0a 09 09 20 20 20 20 28 64 st step... (d
85f0: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
8600: 32 20 22 52 75 6e 6e 69 6e 67 20 5c 22 22 20 66 2 "Running \"" f
8610: 75 6c 6c 63 6d 64 20 22 5c 22 22 29 0a 09 09 20 ullcmd "\"")...
8620: 20 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 (change-direc
8630: 74 6f 72 79 20 73 74 61 72 74 69 6e 67 64 69 72 tory startingdir
8640: 29 0a 09 09 20 20 20 20 28 73 65 74 21 20 65 78 )... (set! ex
8650: 69 74 73 74 61 74 20 28 73 79 73 74 65 6d 20 66 itstat (system f
8660: 75 6c 6c 63 6d 64 29 29 20 3b 3b 20 63 6d 64 20 ullcmd)) ;; cmd
8670: 70 61 72 61 6d 73 29 29 0a 09 09 20 20 20 20 28 params))... (
8680: 73 65 74 21 20 2a 67 6c 6f 62 61 6c 65 78 69 74 set! *globalexit
8690: 73 74 61 74 75 73 2a 20 65 78 69 74 73 74 61 74 status* exitstat
86a0: 29 0a 09 09 20 20 20 20 28 63 68 61 6e 67 65 2d )... (change-
86b0: 64 69 72 65 63 74 6f 72 79 20 74 65 73 74 70 61 directory testpa
86c0: 74 68 29 0a 09 09 20 20 20 20 3b 3b 20 72 75 6e th)... ;; run
86d0: 20 6c 6f 67 70 72 6f 20 69 66 20 61 70 70 6c 69 logpro if appli
86e0: 63 61 62 6c 65 20 3b 3b 20 28 70 72 6f 63 65 73 cable ;; (proces
86f0: 73 2d 72 75 6e 20 22 6c 73 22 20 28 6c 69 73 74 s-run "ls" (list
8700: 20 22 2f 66 6f 6f 22 20 22 32 3e 26 31 22 20 22 "/foo" "2>&1" "
8710: 62 6c 61 68 2e 6c 6f 67 22 29 29 0a 09 09 20 20 blah.log"))...
8720: 20 20 28 69 66 20 6c 6f 67 70 72 6f 66 69 6c 65 (if logprofile
8730: 0a 09 09 09 28 6c 65 74 2a 20 28 28 68 74 6d 6c ....(let* ((html
8740: 6c 6f 67 66 69 6c 65 20 28 63 6f 6e 63 20 73 74 logfile (conc st
8750: 65 70 6e 61 6d 65 20 22 2e 68 74 6d 6c 22 29 29 epname ".html"))
8760: 0a 09 09 09 20 20 20 20 20 20 20 28 6f 6c 64 65 .... (olde
8770: 78 69 74 73 74 61 74 20 65 78 69 74 73 74 61 74 xitstat exitstat
8780: 29 0a 09 09 09 20 20 20 20 20 20 20 28 63 6d 64 ).... (cmd
8790: 20 20 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 (string
87a0: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 6c 69 -intersperse (li
87b0: 73 74 20 22 6c 6f 67 70 72 6f 22 20 6c 6f 67 70 st "logpro" logp
87c0: 72 6f 66 69 6c 65 20 68 74 6d 6c 6c 6f 67 66 69 rofile htmllogfi
87d0: 6c 65 20 22 3c 22 20 6c 6f 67 66 69 6c 65 20 22 le "<" logfile "
87e0: 3e 22 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d >" (conc stepnam
87f0: 65 20 22 5f 6c 6f 67 70 72 6f 2e 6c 6f 67 22 29 e "_logpro.log")
8800: 29 20 22 20 22 29 29 29 0a 09 09 09 20 20 28 64 ) " "))).... (d
8810: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
8820: 32 20 22 72 75 6e 6e 69 6e 67 20 5c 22 22 20 63 2 "running \"" c
8830: 6d 64 20 22 5c 22 22 29 0a 09 09 09 20 20 28 63 md "\"").... (c
8840: 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 hange-directory
8850: 73 74 61 72 74 69 6e 67 64 69 72 29 0a 09 09 09 startingdir)....
8860: 20 20 28 73 65 74 21 20 65 78 69 74 73 74 61 74 (set! exitstat
8870: 20 28 73 79 73 74 65 6d 20 63 6d 64 29 29 0a 09 (system cmd))..
8880: 09 09 20 20 28 73 65 74 21 20 2a 67 6c 6f 62 61 .. (set! *globa
8890: 6c 65 78 69 74 73 74 61 74 75 73 2a 20 65 78 69 lexitstatus* exi
88a0: 74 73 74 61 74 29 20 3b 3b 20 6e 6f 20 6e 65 63 tstat) ;; no nec
88b0: 65 73 73 61 72 79 0a 09 09 09 20 20 28 63 68 61 essary.... (cha
88c0: 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 74 65 nge-directory te
88d0: 73 74 70 61 74 68 29 0a 09 09 09 20 20 28 63 64 stpath).... (cd
88e0: 62 3a 74 65 73 74 2d 73 65 74 2d 6c 6f 67 21 20 b:test-set-log!
88f0: 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 74 65 73 74 *runremote* test
8900: 2d 69 64 20 68 74 6d 6c 6c 6f 67 66 69 6c 65 29 -id htmllogfile)
8910: 29 29 0a 09 09 20 20 20 20 28 6c 65 74 20 28 28 ))... (let ((
8920: 6d 73 67 20 28 61 72 67 73 3a 67 65 74 2d 61 72 msg (args:get-ar
8930: 67 20 22 2d 6d 22 29 29 29 0a 09 09 20 20 20 20 g "-m")))...
8940: 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 72 75 6e 20 ;; DO NOT run
8950: 72 65 6d 6f 74 65 0a 09 09 20 20 20 20 20 20 28 remote... (
8960: 64 62 3a 74 65 73 74 73 74 65 70 2d 73 65 74 2d db:teststep-set-
8970: 73 74 61 74 75 73 21 20 64 62 20 74 65 73 74 2d status! db test-
8980: 69 64 20 73 74 65 70 6e 61 6d 65 20 22 65 6e 64 id stepname "end
8990: 22 20 65 78 69 74 73 74 61 74 20 6d 73 67 20 6c " exitstat msg l
89a0: 6f 67 66 69 6c 65 29 29 0a 09 09 20 20 20 20 29 ogfile))... )
89b0: 29 29 0a 09 20 20 28 69 66 20 28 6f 72 20 28 61 )).. (if (or (a
89c0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 rgs:get-arg "-te
89d0: 73 74 2d 73 74 61 74 75 73 22 29 0a 09 09 20 20 st-status")...
89e0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
89f0: 73 65 74 2d 76 61 6c 75 65 73 22 29 29 0a 09 20 set-values"))..
8a00: 20 20 20 20 20 28 6c 65 74 20 28 28 6e 65 77 73 (let ((news
8a10: 74 61 74 75 73 20 28 63 6f 6e 64 0a 09 09 09 09 tatus (cond.....
8a20: 28 28 6e 75 6d 62 65 72 3f 20 73 74 61 74 75 73 ((number? status
8a30: 29 20 20 20 20 20 20 20 28 69 66 20 28 65 71 75 ) (if (equ
8a40: 61 6c 3f 20 73 74 61 74 75 73 20 30 29 20 22 50 al? status 0) "P
8a50: 41 53 53 22 20 22 46 41 49 4c 22 29 29 0a 09 09 ASS" "FAIL"))...
8a60: 09 09 28 28 61 6e 64 20 28 73 74 72 69 6e 67 3f ..((and (string?
8a70: 20 73 74 61 74 75 73 29 0a 09 09 09 09 20 20 20 status).....
8a80: 20 20 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 (string->numb
8a90: 65 72 20 73 74 61 74 75 73 29 29 28 69 66 20 28 er status))(if (
8aa0: 65 71 75 61 6c 3f 20 28 73 74 72 69 6e 67 2d 3e equal? (string->
8ab0: 6e 75 6d 62 65 72 20 73 74 61 74 75 73 29 20 30 number status) 0
8ac0: 29 20 22 50 41 53 53 22 20 22 46 41 49 4c 22 29 ) "PASS" "FAIL")
8ad0: 29 0a 09 09 09 09 28 65 6c 73 65 20 73 74 61 74 ).....(else stat
8ae0: 75 73 29 29 29 0a 09 09 20 20 20 20 3b 3b 20 74 us)))... ;; t
8af0: 72 61 6e 73 66 65 72 20 72 65 6c 65 76 61 6e 74 ransfer relevant
8b00: 20 6b 65 79 73 20 69 6e 74 6f 20 61 20 68 61 73 keys into a has
8b10: 68 20 74 6f 20 62 65 20 70 61 73 73 65 64 20 74 h to be passed t
8b20: 6f 20 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 o test-set-statu
8b30: 73 21 0a 09 09 20 20 20 20 3b 3b 20 63 6f 75 6c s!... ;; coul
8b40: 64 20 75 73 65 20 61 6e 20 61 73 73 6f 63 20 6c d use an assoc l
8b50: 69 73 74 20 49 20 67 75 65 73 73 2e 20 0a 09 09 ist I guess. ...
8b60: 20 20 20 20 28 6f 74 68 65 72 64 61 74 61 20 28 (otherdata (
8b70: 6c 65 74 20 28 28 72 65 73 20 28 6d 61 6b 65 2d let ((res (make-
8b80: 68 61 73 68 2d 74 61 62 6c 65 29 29 29 0a 09 09 hash-table)))...
8b90: 09 09 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 .. (for-each (la
8ba0: 6d 62 64 61 20 28 6b 65 79 29 0a 09 09 09 09 09 mbda (key)......
8bb0: 20 20 20 20 20 28 69 66 20 28 61 72 67 73 3a 67 (if (args:g
8bc0: 65 74 2d 61 72 67 20 6b 65 79 29 0a 09 09 09 09 et-arg key).....
8bd0: 09 09 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 .. (hash-table-s
8be0: 65 74 21 20 72 65 73 20 6b 65 79 20 28 61 72 67 et! res key (arg
8bf0: 73 3a 67 65 74 2d 61 72 67 20 6b 65 79 29 29 29 s:get-arg key)))
8c00: 29 0a 09 09 09 09 09 20 20 20 28 6c 69 73 74 20 )...... (list
8c10: 22 3a 76 61 6c 75 65 22 20 22 3a 74 6f 6c 22 20 ":value" ":tol"
8c20: 22 3a 65 78 70 65 63 74 65 64 22 20 22 3a 66 69 ":expected" ":fi
8c30: 72 73 74 5f 65 72 72 22 20 22 3a 66 69 72 73 74 rst_err" ":first
8c40: 5f 77 61 72 6e 22 20 22 3a 75 6e 69 74 73 22 20 _warn" ":units"
8c50: 22 3a 63 61 74 65 67 6f 72 79 22 20 22 3a 76 61 ":category" ":va
8c60: 72 69 61 62 6c 65 22 29 29 0a 09 09 09 09 20 72 riable"))..... r
8c70: 65 73 29 29 29 0a 09 09 28 69 66 20 28 61 6e 64 es)))...(if (and
8c80: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
8c90: 2d 74 65 73 74 2d 73 74 61 74 75 73 22 29 0a 09 -test-status")..
8ca0: 09 09 20 28 6f 72 20 28 6e 6f 74 20 73 74 61 74 .. (or (not stat
8cb0: 65 29 0a 09 09 09 20 20 20 20 20 28 6e 6f 74 20 e).... (not
8cc0: 73 74 61 74 75 73 29 29 29 0a 09 09 20 20 20 20 status)))...
8cd0: 28 62 65 67 69 6e 0a 09 09 20 20 20 20 20 20 28 (begin... (
8ce0: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 debug:print 0 "E
8cf0: 52 52 4f 52 3a 20 59 6f 75 20 6d 75 73 74 20 73 RROR: You must s
8d00: 70 65 63 69 66 79 20 3a 73 74 61 74 65 20 61 6e pecify :state an
8d10: 64 20 3a 73 74 61 74 75 73 20 77 69 74 68 20 65 d :status with e
8d20: 76 65 72 79 20 63 61 6c 6c 20 74 6f 20 2d 74 65 very call to -te
8d30: 73 74 2d 73 74 61 74 75 73 5c 6e 22 20 68 65 6c st-status\n" hel
8d40: 70 29 0a 09 09 20 20 20 20 20 20 3b 3b 20 28 73 p)... ;; (s
8d50: 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
8d60: 20 64 62 29 0a 09 09 20 20 20 20 20 20 28 65 78 db)... (ex
8d70: 69 74 20 36 29 29 29 0a 09 09 28 6c 65 74 2a 20 it 6)))...(let*
8d80: 28 28 6d 73 67 20 20 20 20 28 61 72 67 73 3a 67 ((msg (args:g
8d90: 65 74 2d 61 72 67 20 22 2d 6d 22 29 29 0a 09 09 et-arg "-m"))...
8da0: 20 20 20 20 20 20 20 28 6e 75 6d 6f 74 68 20 28 (numoth (
8db0: 6c 65 6e 67 74 68 20 28 68 61 73 68 2d 74 61 62 length (hash-tab
8dc0: 6c 65 2d 6b 65 79 73 20 6f 74 68 65 72 64 61 74 le-keys otherdat
8dd0: 61 29 29 29 29 0a 09 09 20 20 3b 3b 20 43 6f 6e a))))... ;; Con
8de0: 76 65 72 74 20 74 6f 20 72 70 63 20 69 6e 73 69 vert to rpc insi
8df0: 64 65 20 74 68 65 20 74 65 73 74 73 3a 74 65 73 de the tests:tes
8e00: 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 63 61 t-set-status! ca
8e10: 6c 6c 2c 20 6e 6f 74 20 68 65 72 65 0a 09 09 20 ll, not here...
8e20: 20 28 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 (tests:test-set
8e30: 2d 73 74 61 74 75 73 21 20 74 65 73 74 2d 69 64 -status! test-id
8e40: 20 73 74 61 74 65 20 6e 65 77 73 74 61 74 75 73 state newstatus
8e50: 20 6d 73 67 20 6f 74 68 65 72 64 61 74 61 29 29 msg otherdata))
8e60: 29 29 0a 09 20 20 28 69 66 20 64 62 20 28 73 71 )).. (if db (sq
8e70: 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 lite3:finalize!
8e80: 64 62 29 29 0a 09 20 20 28 73 65 74 21 20 2a 64 db)).. (set! *d
8e90: 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 idsomething* #t)
8ea0: 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
8eb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8ec0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8ed0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8ee0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
8ef0: 20 56 61 72 69 6f 75 73 20 68 65 6c 70 65 72 20 Various helper
8f00: 63 6f 6d 6d 61 6e 64 73 20 63 61 6e 20 67 6f 20 commands can go
8f10: 62 65 6c 6f 77 20 68 65 72 65 0a 3b 3b 3d 3d 3d below here.;;===
8f20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8f30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8f40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8f50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8f60: 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 ===..(if (args:g
8f70: 65 74 2d 61 72 67 20 22 2d 73 68 6f 77 6b 65 79 et-arg "-showkey
8f80: 73 22 29 0a 20 20 20 20 28 6c 65 74 20 28 28 64 s"). (let ((d
8f90: 62 20 23 66 29 0a 09 20 20 28 6b 65 79 73 20 23 b #f).. (keys #
8fa0: 66 29 29 0a 20 20 20 20 20 20 28 69 66 20 28 6e f)). (if (n
8fb0: 6f 74 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 ot (setup-for-ru
8fc0: 6e 29 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 n)).. (begin..
8fd0: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
8fe0: 30 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 0 "Failed to set
8ff0: 75 70 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 20 up, exiting")..
9000: 20 20 20 28 65 78 69 74 20 31 29 29 29 0a 20 20 (exit 1))).
9010: 20 20 20 20 28 73 65 74 21 20 6b 65 79 73 20 28 (set! keys (
9020: 63 62 64 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 64 cbd:remote-run d
9030: 62 3a 67 65 74 2d 6b 65 79 73 20 64 62 29 29 0a b:get-keys db)).
9040: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
9050: 6e 74 20 31 20 22 4b 65 79 73 3a 20 22 20 28 73 nt 1 "Keys: " (s
9060: 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
9070: 65 20 28 6d 61 70 20 6b 65 79 3a 67 65 74 2d 66 e (map key:get-f
9080: 69 65 6c 64 6e 61 6d 65 20 6b 65 79 73 29 20 22 ieldname keys) "
9090: 2c 20 22 29 29 0a 20 20 20 20 20 20 28 69 66 20 , ")). (if
90a0: 64 62 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 db (sqlite3:fina
90b0: 6c 69 7a 65 21 20 64 62 29 29 0a 20 20 20 20 20 lize! db)).
90c0: 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 (set! *didsomet
90d0: 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 hing* #t)))..(if
90e0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
90f0: 2d 67 75 69 22 29 0a 20 20 20 20 28 62 65 67 69 -gui"). (begi
9100: 6e 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 n. (debug:p
9110: 72 69 6e 74 20 30 20 22 4c 6f 6f 6b 20 61 74 20 rint 0 "Look at
9120: 74 68 65 20 64 61 73 68 62 6f 61 72 64 20 66 6f the dashboard fo
9130: 72 20 6e 6f 77 22 29 0a 20 20 20 20 20 20 3b 3b r now"). ;;
9140: 20 28 6d 65 67 61 74 65 73 74 2d 67 75 69 29 0a (megatest-gui).
9150: 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 (set! *did
9160: 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 something* #t)))
9170: 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d ..(if (args:get-
9180: 61 72 67 20 22 2d 67 65 6e 2d 6d 65 67 61 74 65 arg "-gen-megate
9190: 73 74 2d 61 72 65 61 22 29 0a 20 20 20 20 28 62 st-area"). (b
91a0: 65 67 69 6e 0a 20 20 20 20 20 20 28 67 65 6e 65 egin. (gene
91b0: 78 61 6d 70 6c 65 3a 6d 6b 2d 6d 65 67 61 74 65 xample:mk-megate
91c0: 73 74 2e 63 6f 6e 66 69 67 29 0a 20 20 20 20 20 st.config).
91d0: 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 (set! *didsomet
91e0: 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 hing* #t)))..(if
91f0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
9200: 2d 67 65 6e 2d 6d 65 67 61 74 65 73 74 2d 74 65 -gen-megatest-te
9210: 73 74 22 29 0a 20 20 20 20 28 6c 65 74 20 28 28 st"). (let ((
9220: 74 65 73 74 6e 61 6d 65 20 28 61 72 67 73 3a 67 testname (args:g
9230: 65 74 2d 61 72 67 20 22 2d 67 65 6e 2d 6d 65 67 et-arg "-gen-meg
9240: 61 74 65 73 74 2d 74 65 73 74 22 29 29 29 0a 20 atest-test"))).
9250: 20 20 20 20 20 28 67 65 6e 65 78 61 6d 70 6c 65 (genexample
9260: 3a 6d 6b 2d 6d 65 67 61 74 65 73 74 2d 74 65 73 :mk-megatest-tes
9270: 74 20 74 65 73 74 6e 61 6d 65 29 0a 20 20 20 20 t testname).
9280: 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
9290: 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b thing* #t)))..;;
92a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
92b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
92c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
92d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
92e0: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 55 70 64 61 74 65 ======.;; Update
92f0: 20 74 68 65 20 64 61 74 61 62 61 73 65 20 73 63 the database sc
9300: 68 65 6d 61 20 6f 6e 20 72 65 71 75 65 73 74 0a hema on request.
9310: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
9320: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9330: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9340: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9350: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 ========..(if (a
9360: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 rgs:get-arg "-re
9370: 62 75 69 6c 64 2d 64 62 22 29 0a 20 20 20 20 28 build-db"). (
9380: 62 65 67 69 6e 0a 20 20 20 20 20 20 28 69 66 20 begin. (if
9390: 28 6e 6f 74 20 28 73 65 74 75 70 2d 66 6f 72 2d (not (setup-for-
93a0: 72 75 6e 29 29 0a 09 20 20 28 62 65 67 69 6e 0a run)).. (begin.
93b0: 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
93c0: 74 20 30 20 22 46 61 69 6c 65 64 20 74 6f 20 73 t 0 "Failed to s
93d0: 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 29 20 etup, exiting")
93e0: 0a 09 20 20 20 20 28 65 78 69 74 20 31 29 29 29 .. (exit 1)))
93f0: 0a 20 20 20 20 20 20 3b 3b 20 6b 65 65 70 20 74 . ;; keep t
9400: 68 69 73 20 6f 6e 65 20 6c 6f 63 61 6c 0a 20 20 his one local.
9410: 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c (open-run-cl
9420: 6f 73 65 20 70 61 74 63 68 2d 64 62 20 23 66 29 ose patch-db #f)
9430: 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 . (set! *di
9440: 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 dsomething* #t))
9450: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
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 0a 3b 3b 20 55 ===========.;; U
94a0: 70 64 61 74 65 20 74 68 65 20 74 65 73 74 73 20 pdate the tests
94b0: 6d 65 74 61 20 64 61 74 61 20 66 72 6f 6d 20 74 meta data from t
94c0: 68 65 20 74 65 73 74 63 6f 6e 66 69 67 20 66 69 he testconfig fi
94d0: 6c 65 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d les.;;==========
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 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 ============..(i
9520: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
9530: 22 2d 75 70 64 61 74 65 2d 6d 65 74 61 22 29 0a "-update-meta").
9540: 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 (begin.
9550: 20 28 69 66 20 28 6e 6f 74 20 28 73 65 74 75 70 (if (not (setup
9560: 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 20 20 28 62 -for-run)).. (b
9570: 65 67 69 6e 0a 09 20 20 20 20 28 64 65 62 75 67 egin.. (debug
9580: 3a 70 72 69 6e 74 20 30 20 22 46 61 69 6c 65 64 :print 0 "Failed
9590: 20 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 to setup, exiti
95a0: 6e 67 22 29 20 0a 09 20 20 20 20 28 65 78 69 74 ng") .. (exit
95b0: 20 31 29 29 29 0a 20 20 20 20 20 20 3b 3b 20 6e 1))). ;; n
95c0: 6f 77 20 63 61 6e 20 66 69 6e 64 20 6f 75 72 20 ow can find our
95d0: 64 62 0a 20 20 20 20 20 20 3b 3b 20 6b 65 65 70 db. ;; keep
95e0: 20 74 68 69 73 20 6f 6e 65 20 6c 6f 63 61 6c 0a this one local.
95f0: 20 20 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d (open-run-
9600: 63 6c 6f 73 65 20 72 75 6e 73 3a 75 70 64 61 74 close runs:updat
9610: 65 2d 61 6c 6c 2d 74 65 73 74 5f 6d 65 74 61 20 e-all-test_meta
9620: 64 62 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 db). (set!
9630: 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
9640: 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d t)))..;;========
9650: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9660: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9670: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9680: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
9690: 3b 20 53 74 61 72 74 20 61 20 72 65 70 6c 0a 3b ; Start a repl.;
96a0: 3b 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 3d 3d 3d 3d 3d 3d 3d ================
96e0: 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 6f 72 =======..(if (or
96f0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
9700: 2d 72 65 70 6c 22 29 0a 09 28 61 72 67 73 3a 67 -repl")..(args:g
9710: 65 74 2d 61 72 67 20 22 2d 6c 6f 61 64 22 29 29 et-arg "-load"))
9720: 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 74 6f 70 . (let* ((top
9730: 70 61 74 68 20 28 73 65 74 75 70 2d 66 6f 72 2d path (setup-for-
9740: 72 75 6e 29 29 0a 09 20 20 20 28 64 62 20 20 20 run)).. (db
9750: 20 20 20 28 69 66 20 74 6f 70 70 61 74 68 20 28 (if toppath (
9760: 6f 70 65 6e 2d 64 62 29 20 23 66 29 29 29 0a 20 open-db) #f))).
9770: 20 20 20 20 20 28 69 66 20 64 62 0a 09 20 20 28 (if db.. (
9780: 62 65 67 69 6e 0a 09 20 20 20 20 28 73 65 74 21 begin.. (set!
9790: 20 2a 64 62 2a 20 64 62 29 0a 09 20 20 20 20 28 *db* db).. (
97a0: 73 65 74 21 20 2a 63 6c 69 65 6e 74 2d 6e 6f 6e set! *client-non
97b0: 2d 62 6c 6f 63 6b 69 6e 67 2d 6d 6f 64 65 2a 20 -blocking-mode*
97c0: 23 74 29 0a 09 20 20 20 20 3b 3b 20 28 63 6c 69 #t).. ;; (cli
97d0: 65 6e 74 3a 73 65 74 75 70 29 0a 09 20 20 20 20 ent:setup)..
97e0: 3b 3b 20 28 63 6c 69 65 6e 74 3a 6c 61 75 6e 63 ;; (client:launc
97f0: 68 29 0a 09 20 20 20 20 28 69 6d 70 6f 72 74 20 h).. (import
9800: 72 65 61 64 6c 69 6e 65 29 0a 09 20 20 20 20 28 readline).. (
9810: 69 6d 70 6f 72 74 20 61 70 72 6f 70 6f 73 29 0a import apropos).
9820: 09 20 20 20 20 28 67 6e 75 2d 68 69 73 74 6f 72 . (gnu-histor
9830: 79 2d 69 6e 73 74 61 6c 6c 2d 66 69 6c 65 2d 6d y-install-file-m
9840: 61 6e 61 67 65 72 0a 09 20 20 20 20 20 28 73 74 anager.. (st
9850: 72 69 6e 67 2d 61 70 70 65 6e 64 0a 09 20 20 20 ring-append..
9860: 20 20 20 28 6f 72 20 28 67 65 74 2d 65 6e 76 69 (or (get-envi
9870: 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 ronment-variable
9880: 20 22 48 4f 4d 45 22 29 20 22 2e 22 29 20 22 2f "HOME") ".") "/
9890: 2e 6d 65 67 61 74 65 73 74 5f 68 69 73 74 6f 72 .megatest_histor
98a0: 79 22 29 29 0a 09 20 20 20 20 28 63 75 72 72 65 y")).. (curre
98b0: 6e 74 2d 69 6e 70 75 74 2d 70 6f 72 74 20 28 6d nt-input-port (m
98c0: 61 6b 65 2d 67 6e 75 2d 72 65 61 64 6c 69 6e 65 ake-gnu-readline
98d0: 2d 70 6f 72 74 20 22 6d 65 67 61 74 65 73 74 3e -port "megatest>
98e0: 20 22 29 29 0a 09 20 20 20 20 28 69 66 20 28 61 ")).. (if (a
98f0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 rgs:get-arg "-re
9900: 70 6c 22 29 0a 09 09 28 72 65 70 6c 29 0a 09 09 pl")...(repl)...
9910: 28 6c 6f 61 64 20 28 61 72 67 73 3a 67 65 74 2d (load (args:get-
9920: 61 72 67 20 22 2d 6c 6f 61 64 22 29 29 29 29 0a arg "-load")))).
9930: 09 20 20 28 65 78 69 74 29 29 0a 20 20 20 20 20 . (exit)).
9940: 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 (set! *didsomet
9950: 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d hing* #t)))..;;=
9960: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9970: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9980: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9990: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
99a0: 3d 3d 3d 3d 3d 0a 3b 3b 20 45 78 69 74 20 61 6e =====.;; Exit an
99b0: 64 20 63 6c 65 61 6e 20 75 70 0a 3b 3b 3d 3d 3d d clean up.;;===
99c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
99d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
99e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
99f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9a00: 3d 3d 3d 0a 0a 3b 3b 20 74 68 69 73 20 69 73 20 ===..;; this is
9a10: 74 68 65 20 73 6f 63 6b 65 74 20 69 66 20 77 65 the socket if we
9a20: 20 61 72 65 20 61 20 63 6c 69 65 6e 74 0a 3b 3b are a client.;;
9a30: 20 28 69 66 20 28 61 6e 64 20 2a 72 75 6e 72 65 (if (and *runre
9a40: 6d 6f 74 65 2a 0a 3b 3b 20 09 20 28 73 6f 63 6b mote*.;; . (sock
9a50: 65 74 3f 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 29 et? *runremote*)
9a60: 29 0a 3b 3b 20 20 20 20 20 28 63 6c 6f 73 65 2d ).;; (close-
9a70: 73 6f 63 6b 65 74 20 2a 72 75 6e 72 65 6d 6f 74 socket *runremot
9a80: 65 2a 29 29 0a 0a 28 69 66 20 28 6e 6f 74 20 2a e*))..(if (not *
9a90: 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 29 0a 20 didsomething*).
9aa0: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
9ab0: 30 20 68 65 6c 70 29 29 0a 0a 3b 3b 20 28 69 66 0 help))..;; (if
9ac0: 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 28 72 70 *runremote* (rp
9ad0: 63 3a 63 6c 6f 73 65 2d 61 6c 6c 2d 63 6f 6e 6e c:close-all-conn
9ae0: 65 63 74 69 6f 6e 73 21 29 29 0a 20 20 20 20 0a ections!)). .
9af0: 28 69 66 20 28 6e 6f 74 20 28 65 71 3f 20 2a 67 (if (not (eq? *g
9b00: 6c 6f 62 61 6c 65 78 69 74 73 74 61 74 75 73 2a lobalexitstatus*
9b10: 20 30 29 29 0a 20 20 20 20 28 69 66 20 28 6f 72 0)). (if (or
9b20: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
9b30: 2d 72 75 6e 74 65 73 74 73 22 29 28 61 72 67 73 -runtests")(args
9b40: 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 61 6c :get-arg "-runal
9b50: 6c 22 29 29 0a 20 20 20 20 20 20 20 20 28 62 65 l")). (be
9b60: 67 69 6e 0a 20 20 20 20 20 20 20 20 20 20 20 28 gin. (
9b70: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 4e debug:print 0 "N
9b80: 4f 54 45 3a 20 53 75 62 70 72 6f 63 65 73 73 65 OTE: Subprocesse
9b90: 73 20 77 69 74 68 20 6e 6f 6e 2d 7a 65 72 6f 20 s with non-zero
9ba0: 65 78 69 74 20 63 6f 64 65 20 64 65 74 65 63 74 exit code detect
9bb0: 65 64 3a 20 22 20 2a 67 6c 6f 62 61 6c 65 78 69 ed: " *globalexi
9bc0: 74 73 74 61 74 75 73 2a 29 0a 20 20 20 20 20 20 tstatus*).
9bd0: 20 20 20 20 20 28 65 78 69 74 20 30 29 29 0a 20 (exit 0)).
9be0: 20 20 20 20 20 20 20 28 63 61 73 65 20 2a 67 6c (case *gl
9bf0: 6f 62 61 6c 65 78 69 74 73 74 61 74 75 73 2a 0a obalexitstatus*.
9c00: 20 20 20 20 20 20 20 20 20 28 28 30 29 28 65 78 ((0)(ex
9c10: 69 74 20 30 29 29 0a 20 20 20 20 20 20 20 20 20 it 0)).
9c20: 28 28 31 29 28 65 78 69 74 20 31 29 29 0a 20 20 ((1)(exit 1)).
9c30: 20 20 20 20 20 20 20 28 28 32 29 28 65 78 69 74 ((2)(exit
9c40: 20 32 29 29 0a 20 20 20 20 20 20 20 20 20 28 65 2)). (e
9c50: 6c 73 65 20 28 65 78 69 74 20 33 29 29 29 29 29 lse (exit 3)))))
9c60: 0a .