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 37 2c 20 4d 61 74 74 68 65 77 20 6-2017, 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 3b 3b 20 66 61 6b 65 n.scm")..;; fake
0190: 20 6f 75 74 20 72 65 61 64 6c 69 6e 65 20 75 73 out readline us
01a0: 61 67 65 20 6f 66 20 74 6f 70 6c 65 76 65 6c 2d age of toplevel-
01b0: 63 6f 6d 6d 61 6e 64 0a 28 64 65 66 69 6e 65 20 command.(define
01c0: 28 74 6f 70 6c 65 76 65 6c 2d 63 6f 6d 6d 61 6e (toplevel-comman
01d0: 64 20 2e 20 61 29 20 23 66 29 0a 0a 28 75 73 65 d . a) #f)..(use
01e0: 20 73 71 6c 69 74 65 33 20 73 72 66 69 2d 31 20 sqlite3 srfi-1
01f0: 70 6f 73 69 78 20 72 65 67 65 78 20 72 65 67 65 posix regex rege
0200: 78 2d 63 61 73 65 20 73 72 66 69 2d 36 39 20 62 x-case srfi-69 b
0210: 61 73 65 36 34 20 72 65 61 64 6c 69 6e 65 20 61 ase64 readline a
0220: 70 72 6f 70 6f 73 20 6a 73 6f 6e 20 68 74 74 70 propos json http
0230: 2d 63 6c 69 65 6e 74 20 64 69 72 65 63 74 6f 72 -client director
0240: 79 2d 75 74 69 6c 73 20 72 70 63 20 74 79 70 65 y-utils rpc type
0250: 64 2d 72 65 63 6f 72 64 73 3b 3b 20 28 73 72 66 d-records;; (srf
0260: 69 20 31 38 29 20 65 78 74 72 61 73 29 0a 20 20 i 18) extras).
0270: 20 20 20 68 74 74 70 2d 63 6c 69 65 6e 74 20 73 http-client s
0280: 72 66 69 2d 31 38 20 65 78 74 72 61 73 20 66 6f rfi-18 extras fo
0290: 72 6d 61 74 29 20 3b 3b 20 20 7a 6d 71 20 65 78 rmat) ;; zmq ex
02a0: 74 72 61 73 29 0a 0a 3b 3b 20 41 64 64 65 64 20 tras)..;; Added
02b0: 66 6f 72 20 63 73 76 20 73 74 75 66 66 20 2d 20 for csv stuff -
02c0: 77 69 6c 6c 20 62 65 20 72 65 6d 6f 76 65 64 0a will be removed.
02d0: 3b 3b 0a 28 75 73 65 20 73 70 61 72 73 65 2d 76 ;;.(use sparse-v
02e0: 65 63 74 6f 72 73 29 0a 0a 28 69 6d 70 6f 72 74 ectors)..(import
02f0: 20 28 70 72 65 66 69 78 20 73 71 6c 69 74 65 33 (prefix sqlite3
0300: 20 73 71 6c 69 74 65 33 3a 29 29 0a 28 69 6d 70 sqlite3:)).(imp
0310: 6f 72 74 20 28 70 72 65 66 69 78 20 62 61 73 65 ort (prefix base
0320: 36 34 20 62 61 73 65 36 34 3a 29 29 0a 28 69 6d 64 base64:)).(im
0330: 70 6f 72 74 20 28 70 72 65 66 69 78 20 72 70 63 port (prefix rpc
0340: 20 72 70 63 3a 29 29 0a 28 72 65 71 75 69 72 65 rpc:)).(require
0350: 2d 6c 69 62 72 61 72 79 20 6d 75 74 69 6c 73 29 -library mutils)
0360: 0a 0a 3b 3b 20 28 75 73 65 20 7a 6d 71 29 0a 0a ..;; (use zmq)..
0370: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 63 (declare (uses c
0380: 6f 6d 6d 6f 6e 29 29 0a 28 64 65 63 6c 61 72 65 ommon)).(declare
0390: 20 28 75 73 65 73 20 6d 65 67 61 74 65 73 74 2d (uses megatest-
03a0: 76 65 72 73 69 6f 6e 29 29 0a 28 64 65 63 6c 61 version)).(decla
03b0: 72 65 20 28 75 73 65 73 20 6d 61 72 67 73 29 29 re (uses margs))
03c0: 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 .(declare (uses
03d0: 72 75 6e 73 29 29 0a 28 64 65 63 6c 61 72 65 20 runs)).(declare
03e0: 28 75 73 65 73 20 6c 61 75 6e 63 68 29 29 0a 28 (uses launch)).(
03f0: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 73 65 declare (uses se
0400: 72 76 65 72 29 29 0a 28 64 65 63 6c 61 72 65 20 rver)).(declare
0410: 28 75 73 65 73 20 63 6c 69 65 6e 74 29 29 0a 28 (uses client)).(
0420: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 74 65 declare (uses te
0430: 73 74 73 29 29 0a 28 64 65 63 6c 61 72 65 20 28 sts)).(declare (
0440: 75 73 65 73 20 67 65 6e 65 78 61 6d 70 6c 65 29 uses genexample)
0450: 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ).(declare (uses
0460: 20 64 61 65 6d 6f 6e 29 29 0a 28 64 65 63 6c 61 daemon)).(decla
0470: 72 65 20 28 75 73 65 73 20 64 62 29 29 0a 3b 3b re (uses db)).;;
0480: 20 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 (declare (uses
0490: 64 63 6f 6d 6d 6f 6e 29 29 0a 0a 28 64 65 63 6c dcommon))..(decl
04a0: 61 72 65 20 28 75 73 65 73 20 74 64 62 29 29 0a are (uses tdb)).
04b0: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 6d (declare (uses m
04c0: 74 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 t)).(declare (us
04d0: 65 73 20 61 70 69 29 29 0a 28 64 65 63 6c 61 72 es api)).(declar
04e0: 65 20 28 75 73 65 73 20 74 61 73 6b 73 29 29 20 e (uses tasks))
04f0: 3b 3b 20 6f 6e 6c 79 20 75 73 65 64 20 66 6f 72 ;; only used for
0500: 20 64 65 62 75 67 67 69 6e 67 2e 0a 28 64 65 63 debugging..(dec
0510: 6c 61 72 65 20 28 75 73 65 73 20 65 6e 76 29 29 lare (uses env))
0520: 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 .(declare (uses
0530: 64 69 66 66 2d 72 65 70 6f 72 74 29 29 0a 0a 28 diff-report))..(
0540: 64 65 66 69 6e 65 20 2a 64 62 2a 20 23 66 29 20 define *db* #f)
0550: 3b 3b 20 74 68 69 73 20 69 73 20 6f 6e 6c 79 20 ;; this is only
0560: 66 6f 72 20 74 68 65 20 72 65 70 6c 2c 20 64 6f for the repl, do
0570: 20 6e 6f 74 20 75 73 65 20 69 6e 20 67 65 6e 65 not use in gene
0580: 72 61 6c 21 21 21 21 0a 0a 28 69 6e 63 6c 75 64 ral!!!!..(includ
0590: 65 20 22 63 6f 6d 6d 6f 6e 5f 72 65 63 6f 72 64 e "common_record
05a0: 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 s.scm").(include
05b0: 20 22 6b 65 79 5f 72 65 63 6f 72 64 73 2e 73 63 "key_records.sc
05c0: 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 64 62 m").(include "db
05d0: 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 28 _records.scm").(
05e0: 69 6e 63 6c 75 64 65 20 22 72 75 6e 5f 72 65 63 include "run_rec
05f0: 6f 72 64 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c ords.scm").(incl
0600: 75 64 65 20 22 6d 65 67 61 74 65 73 74 2d 66 6f ude "megatest-fo
0610: 73 73 69 6c 2d 68 61 73 68 2e 73 63 6d 22 29 0a ssil-hash.scm").
0620: 0a 28 64 65 66 69 6e 65 20 2a 75 73 61 67 65 2d .(define *usage-
0630: 6c 6f 67 2d 66 69 6c 65 2a 20 23 66 29 20 20 20 log-file* #f)
0640: 20 3b 3b 20 70 75 74 20 70 61 74 68 20 74 6f 20 ;; put path to
0650: 66 69 6c 65 20 66 6f 72 20 6c 6f 67 67 69 6e 67 file for logging
0660: 20 75 73 61 67 65 20 69 6e 20 74 68 69 73 20 76 usage in this v
0670: 61 72 20 69 6e 20 74 68 65 20 7e 2f 2e 6d 65 67 ar in the ~/.meg
0680: 61 74 65 73 74 72 63 20 66 69 6c 65 0a 28 64 65 atestrc file.(de
0690: 66 69 6e 65 20 2a 75 73 61 67 65 2d 75 73 65 2d fine *usage-use-
06a0: 73 65 63 6f 6e 64 73 2a 20 23 74 29 20 3b 3b 20 seconds* #t) ;;
06b0: 66 6f 72 20 45 70 6f 63 20 73 65 63 6f 6e 64 73 for Epoc seconds
06c0: 20 69 6e 20 75 73 61 67 65 20 6c 6f 67 67 69 6e in usage loggin
06d0: 67 20 63 68 61 6e 67 65 20 74 68 69 73 20 74 6f g change this to
06e0: 20 23 74 20 69 6e 20 7e 2f 2e 6d 65 67 61 74 65 #t in ~/.megate
06f0: 73 74 72 63 20 66 69 6c 65 0a 0a 3b 3b 20 6c 6f strc file..;; lo
0700: 61 64 20 74 68 65 20 7e 2f 2e 6d 65 67 61 74 65 ad the ~/.megate
0710: 73 74 72 63 20 66 69 6c 65 2c 20 70 75 74 20 28 strc file, put (
0720: 75 73 65 20 74 72 61 63 65 29 28 74 72 61 63 65 use trace)(trace
0730: 2d 63 61 6c 6c 2d 73 69 74 65 73 20 23 74 29 28 -call-sites #t)(
0740: 74 72 61 63 65 20 66 75 6e 63 74 69 6f 6e 2d 79 trace function-y
0750: 6f 75 2d 77 61 6e 74 2d 74 6f 2d 74 72 61 63 65 ou-want-to-trace
0760: 29 20 69 6e 20 74 68 69 73 20 66 69 6c 65 0a 3b ) in this file.;
0770: 3b 0a 28 6c 65 74 20 28 28 64 65 62 75 67 63 6f ;.(let ((debugco
0780: 6e 74 72 6f 6c 66 20 28 63 6f 6e 63 20 28 67 65 ntrolf (conc (ge
0790: 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 t-environment-va
07a0: 72 69 61 62 6c 65 20 22 48 4f 4d 45 22 29 20 22 riable "HOME") "
07b0: 2f 2e 6d 65 67 61 74 65 73 74 72 63 22 29 29 29 /.megatestrc")))
07c0: 0a 20 20 28 69 66 20 28 63 6f 6d 6d 6f 6e 3a 66 . (if (common:f
07d0: 69 6c 65 2d 65 78 69 73 74 73 3f 20 64 65 62 75 ile-exists? debu
07e0: 67 63 6f 6e 74 72 6f 6c 66 29 0a 20 20 20 20 20 gcontrolf).
07f0: 20 28 6c 6f 61 64 20 64 65 62 75 67 63 6f 6e 74 (load debugcont
0800: 72 6f 6c 66 29 29 29 0a 0a 3b 3b 20 75 73 61 67 rolf)))..;; usag
0810: 65 20 6c 6f 67 67 69 6e 67 2c 20 63 61 72 65 66 e logging, caref
0820: 75 6c 20 77 69 74 68 20 74 68 69 73 2c 20 69 74 ul with this, it
0830: 20 69 73 20 6e 6f 74 20 64 65 73 69 67 6e 65 64 is not designed
0840: 20 74 6f 20 64 65 61 6c 20 77 69 74 68 20 61 6c to deal with al
0850: 6c 20 72 65 61 6c 20 77 6f 72 6c 64 20 63 68 61 l real world cha
0860: 6c 6c 65 6e 67 65 73 21 0a 3b 3b 0a 28 69 66 20 llenges!.;;.(if
0870: 28 61 6e 64 20 2a 75 73 61 67 65 2d 6c 6f 67 2d (and *usage-log-
0880: 66 69 6c 65 2a 0a 20 20 20 20 20 20 20 20 20 28 file*. (
0890: 66 69 6c 65 2d 77 72 69 74 65 2d 61 63 63 65 73 file-write-acces
08a0: 73 3f 20 2a 75 73 61 67 65 2d 6c 6f 67 2d 66 69 s? *usage-log-fi
08b0: 6c 65 2a 29 29 0a 20 20 20 20 28 77 69 74 68 2d le*)). (with-
08c0: 6f 75 74 70 75 74 2d 74 6f 2d 66 69 6c 65 0a 20 output-to-file.
08d0: 20 20 20 20 20 20 20 2a 75 73 61 67 65 2d 6c 6f *usage-lo
08e0: 67 2d 66 69 6c 65 2a 0a 20 20 20 20 20 20 28 6c g-file*. (l
08f0: 61 6d 62 64 61 20 28 29 0a 20 20 20 20 20 20 20 ambda ().
0900: 20 28 70 72 69 6e 74 0a 20 20 20 20 20 20 20 20 (print.
0910: 20 28 69 66 20 2a 75 73 61 67 65 2d 75 73 65 2d (if *usage-use-
0920: 73 65 63 6f 6e 64 73 2a 0a 20 20 20 20 20 20 20 seconds*.
0930: 20 20 20 20 20 20 28 63 75 72 72 65 6e 74 2d 73 (current-s
0940: 65 63 6f 6e 64 73 29 0a 20 20 20 20 20 20 20 20 econds).
0950: 20 20 20 20 20 28 74 69 6d 65 2d 3e 73 74 72 69 (time->stri
0960: 6e 67 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ng.
0970: 20 28 73 65 63 6f 6e 64 73 2d 3e 6c 6f 63 61 6c (seconds->local
0980: 2d 74 69 6d 65 20 28 63 75 72 72 65 6e 74 2d 73 -time (current-s
0990: 65 63 6f 6e 64 73 29 29 0a 20 20 20 20 20 20 20 econds)).
09a0: 20 20 20 20 20 20 20 22 25 59 77 77 25 56 2e 25 "%Yww%V.%
09b0: 77 20 25 48 3a 25 4d 3a 25 53 22 29 29 0a 20 20 w %H:%M:%S")).
09c0: 20 20 20 20 20 20 20 22 20 22 0a 20 20 20 20 20 " ".
09d0: 20 20 20 20 28 63 75 72 72 65 6e 74 2d 75 73 65 (current-use
09e0: 72 2d 6e 61 6d 65 29 20 22 20 22 0a 20 20 20 20 r-name) " ".
09f0: 20 20 20 20 20 28 63 75 72 72 65 6e 74 2d 64 69 (current-di
0a00: 72 65 63 74 6f 72 79 29 20 22 20 22 0a 20 20 20 rectory) " ".
0a10: 20 20 20 20 20 20 22 5c 22 22 20 28 73 74 72 69 "\"" (stri
0a20: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 ng-intersperse (
0a30: 61 72 67 76 29 20 22 20 22 29 20 22 5c 22 22 29 argv) " ") "\"")
0a40: 29 0a 20 20 20 20 20 20 23 3a 61 70 70 65 6e 64 ). #:append
0a50: 29 29 0a 0a 3b 3b 20 44 69 73 61 62 6c 65 64 20 ))..;; Disabled
0a60: 68 65 6c 70 20 69 74 65 6d 73 0a 3b 3b 20 20 2d help items.;; -
0a70: 72 6f 6c 6c 75 70 20 20 20 20 20 20 20 20 20 20 rollup
0a80: 20 20 20 20 20 20 20 3a 20 28 63 75 72 72 65 6e : (curren
0a90: 74 6c 79 20 64 69 73 61 62 6c 65 64 29 20 66 69 tly disabled) fi
0aa0: 6c 6c 20 72 75 6e 20 28 73 65 74 20 62 79 20 3a ll run (set by :
0ab0: 72 75 6e 6e 61 6d 65 29 20 20 77 69 74 68 20 6c runname) with l
0ac0: 61 74 65 73 74 20 74 65 73 74 28 73 29 0a 3b 3b atest test(s).;;
0ad0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ae0: 20 20 20 20 20 20 20 20 20 20 20 20 66 72 6f 6d from
0af0: 20 70 72 69 6f 72 20 72 75 6e 73 20 77 69 74 68 prior runs with
0b00: 20 73 61 6d 65 20 6b 65 79 73 0a 3b 3b 20 20 2d same keys.;; -
0b10: 64 61 65 6d 6f 6e 69 7a 65 20 20 20 20 20 20 20 daemonize
0b20: 20 20 20 20 20 20 20 3a 20 66 6f 72 6b 20 69 6e : fork in
0b30: 74 6f 20 62 61 63 6b 67 72 6f 75 6e 64 20 61 6e to background an
0b40: 64 20 64 69 73 63 6f 6e 6e 65 63 74 20 66 72 6f d disconnect fro
0b50: 6d 20 73 74 64 69 6e 2f 6f 75 74 0a 0a 28 64 65 m stdin/out..(de
0b60: 66 69 6e 65 20 68 65 6c 70 20 28 63 6f 6e 63 20 fine help (conc
0b70: 22 0a 4d 65 67 61 74 65 73 74 2c 20 64 6f 63 75 ".Megatest, docu
0b80: 6d 65 6e 74 61 74 69 6f 6e 20 61 74 20 68 74 74 mentation at htt
0b90: 70 3a 2f 2f 77 77 77 2e 6b 69 61 74 6f 61 2e 63 p://www.kiatoa.c
0ba0: 6f 6d 2f 66 6f 73 73 69 6c 73 2f 6d 65 67 61 74 om/fossils/megat
0bb0: 65 73 74 0a 20 20 76 65 72 73 69 6f 6e 20 22 20 est. version "
0bc0: 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e megatest-version
0bd0: 20 22 0a 20 20 6c 69 63 65 6e 73 65 20 47 50 4c ". license GPL
0be0: 2c 20 43 6f 70 79 72 69 67 68 74 20 4d 61 74 74 , Copyright Matt
0bf0: 20 57 65 6c 6c 61 6e 64 20 32 30 30 36 2d 32 30 Welland 2006-20
0c00: 31 37 0a 20 0a 55 73 61 67 65 3a 20 6d 65 67 61 17. .Usage: mega
0c10: 74 65 73 74 20 5b 6f 70 74 69 6f 6e 73 5d 0a 20 test [options].
0c20: 20 2d 68 20 20 20 20 20 20 20 20 20 20 20 20 20 -h
0c30: 20 20 20 20 20 20 20 20 20 3a 20 74 68 69 73 20 : this
0c40: 68 65 6c 70 0a 20 20 2d 6d 61 6e 75 61 6c 20 20 help. -manual
0c50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a :
0c60: 20 73 68 6f 77 20 74 68 65 20 4d 65 67 61 74 65 show the Megate
0c70: 73 74 20 75 73 65 72 20 6d 61 6e 75 61 6c 0a 20 st user manual.
0c80: 20 2d 76 65 72 73 69 6f 6e 20 20 20 20 20 20 20 -version
0c90: 20 20 20 20 20 20 20 20 20 3a 20 70 72 69 6e 74 : print
0ca0: 20 6d 65 67 61 74 65 73 74 20 76 65 72 73 69 6f megatest versio
0cb0: 6e 20 28 63 75 72 72 65 6e 74 6c 79 20 22 20 6d n (currently " m
0cc0: 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 20 egatest-version
0cd0: 22 29 0a 0a 4c 61 75 6e 63 68 69 6e 67 20 61 6e ")..Launching an
0ce0: 64 20 6d 61 6e 61 67 69 6e 67 20 72 75 6e 73 0a d managing runs.
0cf0: 20 20 2d 72 75 6e 20 20 20 20 20 20 20 20 20 20 -run
0d00: 20 20 20 20 20 20 20 20 20 20 3a 20 72 75 6e 20 : run
0d10: 61 6c 6c 20 74 65 73 74 73 20 6f 72 20 61 73 20 all tests or as
0d20: 73 70 65 63 69 66 69 65 64 20 62 79 20 2d 74 65 specified by -te
0d30: 73 74 70 61 74 74 0a 20 20 2d 72 65 6d 6f 76 65 stpatt. -remove
0d40: 2d 72 75 6e 73 20 20 20 20 20 20 20 20 20 20 20 -runs
0d50: 20 3a 20 72 65 6d 6f 76 65 20 74 68 65 20 64 61 : remove the da
0d60: 74 61 20 66 6f 72 20 61 20 72 75 6e 2c 20 72 65 ta for a run, re
0d70: 71 75 69 72 65 73 20 2d 72 75 6e 6e 61 6d 65 20 quires -runname
0d80: 61 6e 64 20 2d 74 65 73 74 70 61 74 74 0a 20 20 and -testpatt.
0d90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0da0: 20 20 20 20 20 20 20 20 20 20 4f 70 74 69 6f 6e Option
0db0: 61 6c 6c 79 20 75 73 65 20 3a 73 74 61 74 65 20 ally use :state
0dc0: 61 6e 64 20 3a 73 74 61 74 75 73 2c 20 75 73 65 and :status, use
0dd0: 20 2d 6b 65 65 70 2d 72 65 63 6f 72 64 73 20 74 -keep-records t
0de0: 6f 20 72 65 6d 6f 76 65 20 6f 6e 6c 79 0a 20 20 o remove only.
0df0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e00: 20 20 20 20 20 20 20 20 20 20 74 68 65 20 72 75 the ru
0e10: 6e 20 64 61 74 61 2e 0a 20 20 2d 73 65 74 2d 73 n data.. -set-s
0e20: 74 61 74 65 2d 73 74 61 74 75 73 20 58 2c 59 20 tate-status X,Y
0e30: 20 20 3a 20 73 65 74 20 73 74 61 74 65 20 74 6f : set state to
0e40: 20 58 20 61 6e 64 20 73 74 61 74 75 73 20 74 6f X and status to
0e50: 20 59 2c 20 72 65 71 75 69 72 65 73 20 63 6f 6e Y, requires con
0e60: 74 72 6f 6c 73 20 70 65 72 20 2d 72 65 6d 6f 76 trols per -remov
0e70: 65 2d 72 75 6e 73 0a 20 20 2d 72 65 72 75 6e 20 e-runs. -rerun
0e80: 46 41 49 4c 2c 57 41 52 4e 2e 2e 2e 20 20 20 20 FAIL,WARN...
0e90: 20 3a 20 66 6f 72 63 65 20 72 65 2d 72 75 6e 20 : force re-run
0ea0: 66 6f 72 20 74 65 73 74 73 20 77 69 74 68 20 73 for tests with s
0eb0: 70 65 63 69 66 69 63 65 64 20 73 74 61 74 75 73 pecificed status
0ec0: 28 73 29 0a 20 20 2d 72 65 72 75 6e 2d 63 6c 65 (s). -rerun-cle
0ed0: 61 6e 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 an :
0ee0: 73 65 74 20 61 6c 6c 20 74 65 73 74 73 20 6e 6f set all tests no
0ef0: 74 20 43 4f 4d 50 4c 45 54 45 44 2b 50 41 53 53 t COMPLETED+PASS
0f00: 2c 57 41 52 4e 2c 57 41 49 56 45 44 20 74 6f 20 ,WARN,WAIVED to
0f10: 4e 4f 54 5f 53 54 41 52 54 45 44 2c 6e 2f 61 0a NOT_STARTED,n/a.
0f20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0f30: 20 20 20 20 20 20 20 20 20 20 20 20 61 6e 64 20 and
0f40: 74 68 65 6e 20 72 75 6e 20 74 68 65 20 73 70 65 then run the spe
0f50: 63 69 66 69 65 64 20 74 65 73 74 70 61 74 74 20 cified testpatt
0f60: 77 69 74 68 20 2d 70 72 65 63 6c 65 61 6e 0a 20 with -preclean.
0f70: 20 2d 72 65 72 75 6e 2d 61 6c 6c 20 20 20 20 20 -rerun-all
0f80: 20 20 20 20 20 20 20 20 20 3a 20 73 65 74 20 61 : set a
0f90: 6c 6c 20 74 65 73 74 73 20 74 6f 20 4e 4f 54 5f ll tests to NOT_
0fa0: 53 54 41 52 54 45 44 2c 6e 2f 61 20 61 6e 64 20 STARTED,n/a and
0fb0: 72 75 6e 20 77 69 74 68 20 2d 70 72 65 63 6c 65 run with -precle
0fc0: 61 6e 0a 20 20 2d 6c 6f 63 6b 20 20 20 20 20 20 an. -lock
0fd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 6c : l
0fe0: 6f 63 6b 20 72 75 6e 20 73 70 65 63 69 66 69 65 ock run specifie
0ff0: 64 20 62 79 20 74 61 72 67 65 74 20 61 6e 64 20 d by target and
1000: 72 75 6e 6e 61 6d 65 0a 20 20 2d 75 6e 6c 6f 63 runname. -unloc
1010: 6b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 k
1020: 20 20 3a 20 75 6e 6c 6f 63 6b 20 72 75 6e 20 73 : unlock run s
1030: 70 65 63 69 66 69 65 64 20 62 79 20 74 61 72 67 pecified by targ
1040: 65 74 20 61 6e 64 20 72 75 6e 6e 61 6d 65 0a 20 et and runname.
1050: 20 2d 73 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 -set-run-status
1060: 20 73 74 61 74 75 73 20 20 3a 20 73 65 74 73 20 status : sets
1070: 73 74 61 74 75 73 20 66 6f 72 20 72 75 6e 20 74 status for run t
1080: 6f 20 73 74 61 74 75 73 2c 20 72 65 71 75 69 72 o status, requir
1090: 65 73 20 2d 74 61 72 67 65 74 20 61 6e 64 20 2d es -target and -
10a0: 72 75 6e 6e 61 6d 65 0a 20 20 2d 67 65 74 2d 72 runname. -get-r
10b0: 75 6e 2d 73 74 61 74 75 73 20 20 20 20 20 20 20 un-status
10c0: 20 20 3a 20 67 65 74 73 20 73 74 61 74 75 73 20 : gets status
10d0: 66 6f 72 20 72 75 6e 20 73 70 65 63 69 66 69 65 for run specifie
10e0: 64 20 62 79 20 74 61 72 67 65 74 20 61 6e 64 20 d by target and
10f0: 72 75 6e 6e 61 6d 65 0a 20 20 2d 72 75 6e 2d 77 runname. -run-w
1100: 61 69 74 20 20 20 20 20 20 20 20 20 20 20 20 20 ait
1110: 20 20 3a 20 77 61 69 74 20 6f 6e 20 72 75 6e 20 : wait on run
1120: 73 70 65 63 69 66 69 65 64 20 62 79 20 74 61 72 specified by tar
1130: 67 65 74 20 61 6e 64 20 72 75 6e 6e 61 6d 65 0a get and runname.
1140: 20 20 2d 70 72 65 63 6c 65 61 6e 20 20 20 20 20 -preclean
1150: 20 20 20 20 20 20 20 20 20 20 3a 20 72 65 6d 6f : remo
1160: 76 65 20 74 68 65 20 65 78 69 73 74 69 6e 67 20 ve the existing
1170: 74 65 73 74 20 64 69 72 65 63 74 6f 72 79 20 62 test directory b
1180: 65 66 6f 72 65 20 72 75 6e 6e 69 6e 67 20 74 68 efore running th
1190: 65 20 74 65 73 74 0a 20 20 2d 63 6c 65 61 6e 2d e test. -clean-
11a0: 63 61 63 68 65 20 20 20 20 20 20 20 20 20 20 20 cache
11b0: 20 3a 20 72 65 6d 6f 76 65 20 74 68 65 20 63 61 : remove the ca
11c0: 63 68 65 64 20 6d 65 67 61 74 65 73 74 2e 63 6f ched megatest.co
11d0: 6e 66 69 67 20 61 6e 64 20 72 75 6e 63 6f 6e 66 nfig and runconf
11e0: 69 67 73 2e 63 6f 6e 66 69 67 20 66 69 6c 65 73 igs.config files
11f0: 0a 20 20 2d 6e 6f 2d 63 61 63 68 65 20 20 20 20 . -no-cache
1200: 20 20 20 20 20 20 20 20 20 20 20 3a 20 64 6f 20 : do
1210: 6e 6f 74 20 75 73 65 20 74 68 65 20 63 61 63 68 not use the cach
1220: 65 64 20 63 6f 6e 66 69 67 20 66 69 6c 65 73 2e ed config files.
1230: 20 0a 20 20 2d 6f 6e 65 2d 70 61 73 73 20 20 20 . -one-pass
1240: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 6c 61 : la
1250: 75 6e 63 68 20 61 73 20 6d 61 6e 79 20 74 65 73 unch as many tes
1260: 74 73 20 61 73 20 79 6f 75 20 63 61 6e 20 62 75 ts as you can bu
1270: 74 20 64 6f 20 6e 6f 74 20 77 61 69 74 20 66 6f t do not wait fo
1280: 72 20 6d 6f 72 65 20 74 6f 20 62 65 20 72 65 61 r more to be rea
1290: 64 79 0a 0a 53 65 6c 65 63 74 6f 72 73 20 28 65 dy..Selectors (e
12a0: 2e 67 2e 20 75 73 65 20 66 6f 72 20 2d 72 75 6e .g. use for -run
12b0: 74 65 73 74 73 2c 20 2d 72 65 6d 6f 76 65 2d 72 tests, -remove-r
12c0: 75 6e 73 2c 20 2d 73 65 74 2d 73 74 61 74 65 2d uns, -set-state-
12d0: 73 74 61 74 75 73 2c 20 2d 6c 69 73 74 2d 72 75 status, -list-ru
12e0: 6e 73 20 65 74 63 2e 29 0a 20 20 2d 74 61 72 67 ns etc.). -targ
12f0: 65 74 20 6b 65 79 31 2f 6b 65 79 32 2f 2e 2e 2e et key1/key2/...
1300: 20 20 20 3a 20 72 75 6e 20 66 6f 72 20 6b 65 79 : run for key
1310: 31 2c 20 6b 65 79 32 2c 20 65 74 63 2e 0a 20 20 1, key2, etc..
1320: 2d 72 65 71 74 61 72 67 20 6b 65 79 31 2f 6b 65 -reqtarg key1/ke
1330: 79 32 2f 2e 2e 2e 20 20 3a 20 72 75 6e 20 66 6f y2/... : run fo
1340: 72 20 6b 65 79 31 2c 20 6b 65 79 32 2c 20 65 74 r key1, key2, et
1350: 63 2e 20 62 75 74 20 6b 65 79 31 2f 6b 65 79 32 c. but key1/key2
1360: 20 6d 75 73 74 20 62 65 20 69 6e 20 72 75 6e 63 must be in runc
1370: 6f 6e 66 69 67 73 0a 20 20 2d 74 65 73 74 70 61 onfigs. -testpa
1380: 74 74 20 70 61 74 74 31 2f 70 61 74 74 32 2c 70 tt patt1/patt2,p
1390: 61 74 74 33 2f 2e 2e 2e 20 20 3a 20 25 20 69 73 att3/... : % is
13a0: 20 77 69 6c 64 63 61 72 64 0a 20 20 2d 72 75 6e wildcard. -run
13b0: 6e 61 6d 65 20 20 20 20 20 20 20 20 20 20 20 20 name
13c0: 20 20 20 20 3a 20 72 65 71 75 69 72 65 64 2c 20 : required,
13d0: 6e 61 6d 65 20 66 6f 72 20 74 68 69 73 20 70 61 name for this pa
13e0: 72 74 69 63 75 6c 61 72 20 74 65 73 74 20 72 75 rticular test ru
13f0: 6e 0a 20 20 2d 73 74 61 74 65 20 20 20 20 20 20 n. -state
1400: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 41 70 : Ap
1410: 70 6c 69 65 73 20 74 6f 20 72 75 6e 73 2c 20 74 plies to runs, t
1420: 65 73 74 73 20 6f 72 20 73 74 65 70 73 20 64 65 ests or steps de
1430: 70 65 6e 64 69 6e 67 20 6f 6e 20 63 6f 6e 74 65 pending on conte
1440: 78 74 0a 20 20 2d 73 74 61 74 75 73 20 20 20 20 xt. -status
1450: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 41 : A
1460: 70 70 6c 69 65 73 20 74 6f 20 72 75 6e 73 2c 20 pplies to runs,
1470: 74 65 73 74 73 20 6f 72 20 73 74 65 70 73 20 64 tests or steps d
1480: 65 70 65 6e 64 69 6e 67 20 6f 6e 20 63 6f 6e 74 epending on cont
1490: 65 78 74 0a 20 20 2d 2d 6d 6f 64 65 70 61 74 74 ext. --modepatt
14a0: 20 6b 65 79 20 20 20 20 20 20 20 20 20 20 3a 20 key :
14b0: 6c 6f 61 64 20 74 65 73 74 70 61 74 74 20 66 72 load testpatt fr
14c0: 6f 6d 20 3c 6b 65 79 3e 20 69 6e 20 72 75 6e 63 om <key> in runc
14d0: 6f 6e 66 69 67 73 20 69 6e 73 74 65 61 64 20 6f onfigs instead o
14e0: 66 20 64 65 66 61 75 6c 74 20 54 45 53 54 50 41 f default TESTPA
14f0: 54 54 20 69 66 20 2d 74 65 73 74 70 61 74 74 20 TT if -testpatt
1500: 61 6e 64 20 2d 74 61 67 65 78 70 72 20 61 72 65 and -tagexpr are
1510: 20 6e 6f 74 20 73 70 65 63 69 66 69 65 64 0a 20 not specified.
1520: 20 2d 74 61 67 65 78 70 72 20 74 61 67 31 2c 74 -tagexpr tag1,t
1530: 61 67 32 25 2c 2e 2e 20 20 3a 20 73 65 6c 65 63 ag2%,.. : selec
1540: 74 20 74 65 73 74 73 20 77 69 74 68 20 74 61 67 t tests with tag
1550: 73 20 6d 61 74 63 68 69 6e 67 20 65 78 70 72 65 s matching expre
1560: 73 73 69 6f 6e 0a 20 20 0a 0a 54 65 73 74 20 68 ssion. ..Test h
1570: 65 6c 70 65 72 73 20 28 66 6f 72 20 75 73 65 20 elpers (for use
1580: 69 6e 73 69 64 65 20 74 65 73 74 73 29 0a 20 20 inside tests).
1590: 2d 73 74 65 70 20 73 74 65 70 6e 61 6d 65 0a 20 -step stepname.
15a0: 20 2d 74 65 73 74 2d 73 74 61 74 75 73 20 20 20 -test-status
15b0: 20 20 20 20 20 20 20 20 20 3a 20 73 65 74 20 74 : set t
15c0: 68 65 20 73 74 61 74 65 20 61 6e 64 20 73 74 61 he state and sta
15d0: 74 75 73 20 6f 66 20 61 20 74 65 73 74 20 28 75 tus of a test (u
15e0: 73 65 20 3a 73 74 61 74 65 20 61 6e 64 20 3a 73 se :state and :s
15f0: 74 61 74 75 73 29 0a 20 20 2d 73 65 74 6c 6f 67 tatus). -setlog
1600: 20 6c 6f 67 66 6e 61 6d 65 20 20 20 20 20 20 20 logfname
1610: 20 3a 20 73 65 74 20 74 68 65 20 70 61 74 68 2f : set the path/
1620: 66 69 6c 65 6e 61 6d 65 20 74 6f 20 74 68 65 20 filename to the
1630: 66 69 6e 61 6c 20 6c 6f 67 20 72 65 6c 61 74 69 final log relati
1640: 76 65 20 74 6f 20 74 68 65 20 74 65 73 74 0a 20 ve to the test.
1650: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1660: 20 20 20 20 20 20 20 20 20 20 20 64 69 72 65 63 direc
1670: 74 6f 72 79 2e 20 6d 61 79 20 62 65 20 75 73 65 tory. may be use
1680: 64 20 77 69 74 68 20 2d 74 65 73 74 2d 73 74 61 d with -test-sta
1690: 74 75 73 0a 20 20 2d 73 65 74 2d 74 6f 70 6c 6f tus. -set-toplo
16a0: 67 20 6c 6f 67 66 6e 61 6d 65 20 20 20 20 3a 20 g logfname :
16b0: 73 65 74 20 74 68 65 20 6f 76 65 72 61 6c 6c 20 set the overall
16c0: 6c 6f 67 20 66 6f 72 20 61 20 73 75 69 74 65 20 log for a suite
16d0: 6f 66 20 73 75 62 2d 74 65 73 74 73 0a 20 20 2d of sub-tests. -
16e0: 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 20 summarize-items
16f0: 20 20 20 20 20 20 20 3a 20 66 6f 72 20 61 6e 20 : for an
1700: 69 74 65 6d 69 7a 65 64 20 74 65 73 74 20 63 72 itemized test cr
1710: 65 61 74 65 20 61 20 73 75 6d 6d 61 72 79 20 68 eate a summary h
1720: 74 6d 6c 20 0a 20 20 2d 6d 20 63 6f 6d 6d 65 6e tml . -m commen
1730: 74 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a t :
1740: 20 69 6e 73 65 72 74 20 61 20 63 6f 6d 6d 65 6e insert a commen
1750: 74 20 66 6f 72 20 74 68 69 73 20 74 65 73 74 0a t for this test.
1760: 0a 54 65 73 74 20 64 61 74 61 20 63 61 70 74 75 .Test data captu
1770: 72 65 0a 20 20 2d 73 65 74 2d 76 61 6c 75 65 73 re. -set-values
1780: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 75 : u
1790: 70 64 61 74 65 20 6f 72 20 73 65 74 20 76 61 6c pdate or set val
17a0: 75 65 73 20 69 6e 20 74 68 65 20 74 65 73 74 64 ues in the testd
17b0: 61 74 61 20 74 61 62 6c 65 0a 20 20 3a 63 61 74 ata table. :cat
17c0: 65 67 6f 72 79 20 20 20 20 20 20 20 20 20 20 20 egory
17d0: 20 20 20 20 3a 20 73 65 74 20 74 68 65 20 63 61 : set the ca
17e0: 74 65 67 6f 72 79 20 66 69 65 6c 64 20 28 6f 70 tegory field (op
17f0: 74 69 6f 6e 61 6c 29 0a 20 20 3a 76 61 72 69 61 tional). :varia
1800: 62 6c 65 20 20 20 20 20 20 20 20 20 20 20 20 20 ble
1810: 20 20 3a 20 73 65 74 20 74 68 65 20 76 61 72 69 : set the vari
1820: 61 62 6c 65 20 6e 61 6d 65 20 28 6f 70 74 69 6f able name (optio
1830: 6e 61 6c 29 0a 20 20 3a 76 61 6c 75 65 20 20 20 nal). :value
1840: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a :
1850: 20 76 61 6c 75 65 20 6d 65 61 73 75 72 65 64 20 value measured
1860: 28 72 65 71 75 69 72 65 64 29 0a 20 20 3a 65 78 (required). :ex
1870: 70 65 63 74 65 64 20 20 20 20 20 20 20 20 20 20 pected
1880: 20 20 20 20 20 3a 20 76 61 6c 75 65 20 65 78 70 : value exp
1890: 65 63 74 65 64 20 28 72 65 71 75 69 72 65 64 29 ected (required)
18a0: 0a 20 20 3a 74 6f 6c 20 20 20 20 20 20 20 20 20 . :tol
18b0: 20 20 20 20 20 20 20 20 20 20 20 3a 20 7c 76 61 : |va
18c0: 6c 75 65 2d 65 78 70 65 63 74 7c 20 3c 3d 20 74 lue-expect| <= t
18d0: 6f 6c 20 28 72 65 71 75 69 72 65 64 2c 20 63 61 ol (required, ca
18e0: 6e 20 62 65 20 3c 2c 20 3e 2c 20 3e 3d 2c 20 3c n be <, >, >=, <
18f0: 3d 20 6f 72 20 6e 75 6d 62 65 72 29 0a 20 20 3a = or number). :
1900: 75 6e 69 74 73 20 20 20 20 20 20 20 20 20 20 20 units
1910: 20 20 20 20 20 20 20 3a 20 6e 61 6d 65 20 6f 66 : name of
1920: 20 74 68 65 20 75 6e 69 74 73 20 66 6f 72 20 76 the units for v
1930: 61 6c 75 65 2c 20 65 78 70 65 63 74 65 64 5f 76 alue, expected_v
1940: 61 6c 75 65 20 65 74 63 2e 20 28 6f 70 74 69 6f alue etc. (optio
1950: 6e 61 6c 29 0a 20 20 2d 6c 6f 61 64 2d 74 65 73 nal). -load-tes
1960: 74 2d 64 61 74 61 20 20 20 20 20 20 20 20 20 3a t-data :
1970: 20 72 65 61 64 20 74 65 73 74 20 73 70 65 63 69 read test speci
1980: 66 69 63 20 64 61 74 61 20 66 6f 72 20 73 74 6f fic data for sto
1990: 72 61 67 65 20 69 6e 20 74 68 65 20 74 65 73 74 rage in the test
19a0: 5f 64 61 74 61 20 74 61 62 6c 65 0a 20 20 20 20 _data table.
19b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19c0: 20 20 20 20 20 20 20 20 66 72 6f 6d 20 73 74 61 from sta
19d0: 6e 64 61 72 64 20 69 6e 2e 20 45 61 63 68 20 6c ndard in. Each l
19e0: 69 6e 65 20 69 73 20 63 6f 6d 6d 61 20 64 65 6c ine is comma del
19f0: 69 6d 69 74 65 64 20 77 69 74 68 20 66 6f 75 72 imited with four
1a00: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1a10: 20 20 20 20 20 20 20 20 20 20 20 20 20 66 69 65 fie
1a20: 6c 64 73 20 63 61 74 65 67 6f 72 79 2c 76 61 72 lds category,var
1a30: 69 61 62 6c 65 2c 76 61 6c 75 65 2c 63 6f 6d 6d iable,value,comm
1a40: 65 6e 74 0a 0a 51 75 65 72 69 65 73 0a 20 20 2d ent..Queries. -
1a50: 6c 69 73 74 2d 72 75 6e 73 20 70 61 74 74 20 20 list-runs patt
1a60: 20 20 20 20 20 20 20 3a 20 6c 69 73 74 20 72 75 : list ru
1a70: 6e 73 20 6d 61 74 63 68 69 6e 67 20 70 61 74 74 ns matching patt
1a80: 65 72 6e 20 5c 22 70 61 74 74 5c 22 2c 20 25 20 ern \"patt\", %
1a90: 69 73 20 74 68 65 20 77 69 6c 64 63 61 72 64 0a is the wildcard.
1aa0: 20 20 2d 73 68 6f 77 2d 6b 65 79 73 20 20 20 20 -show-keys
1ab0: 20 20 20 20 20 20 20 20 20 20 3a 20 73 68 6f 77 : show
1ac0: 20 74 68 65 20 6b 65 79 73 20 75 73 65 64 20 69 the keys used i
1ad0: 6e 20 74 68 69 73 20 6d 65 67 61 74 65 73 74 20 n this megatest
1ae0: 73 65 74 75 70 0a 20 20 2d 74 65 73 74 2d 66 69 setup. -test-fi
1af0: 6c 65 73 20 74 61 72 67 70 61 74 74 20 20 20 20 les targpatt
1b00: 3a 20 67 65 74 20 74 68 65 20 6d 6f 73 74 20 72 : get the most r
1b10: 65 63 65 6e 74 20 74 65 73 74 20 70 61 74 68 2f ecent test path/
1b20: 66 69 6c 65 20 6d 61 74 63 68 69 6e 67 20 74 61 file matching ta
1b30: 72 67 70 61 74 74 20 65 2e 67 2e 20 25 2f 25 20 rgpatt e.g. %/%
1b40: 6f 72 20 27 2a 2e 6c 6f 67 27 0a 20 20 20 20 20 or '*.log'.
1b50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b60: 20 20 20 20 20 20 20 72 65 74 75 72 6e 73 20 6c returns l
1b70: 69 73 74 20 73 6f 72 74 65 64 20 62 79 20 61 67 ist sorted by ag
1b80: 65 20 61 73 63 65 6e 64 69 6e 67 2c 20 73 65 65 e ascending, see
1b90: 20 65 78 61 6d 70 6c 65 73 20 62 65 6c 6f 77 0a examples below.
1ba0: 20 20 2d 74 65 73 74 2d 70 61 74 68 73 20 20 20 -test-paths
1bb0: 20 20 20 20 20 20 20 20 20 20 3a 20 67 65 74 20 : get
1bc0: 74 68 65 20 74 65 73 74 20 70 61 74 68 73 20 6d the test paths m
1bd0: 61 74 63 68 69 6e 67 20 74 61 72 67 65 74 2c 20 atching target,
1be0: 72 75 6e 6e 61 6d 65 2c 20 69 74 65 6d 20 61 6e runname, item an
1bf0: 64 20 74 65 73 74 0a 20 20 20 20 20 20 20 20 20 d test.
1c00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c10: 20 20 20 70 61 74 74 65 72 6e 73 2e 0a 20 20 2d patterns.. -
1c20: 6c 69 73 74 2d 64 69 73 6b 73 20 20 20 20 20 20 list-disks
1c30: 20 20 20 20 20 20 20 3a 20 6c 69 73 74 20 74 68 : list th
1c40: 65 20 64 69 73 6b 73 20 61 76 61 69 6c 61 62 6c e disks availabl
1c50: 65 20 66 6f 72 20 73 74 6f 72 69 6e 67 20 72 75 e for storing ru
1c60: 6e 73 0a 20 20 2d 6c 69 73 74 2d 74 61 72 67 65 ns. -list-targe
1c70: 74 73 20 20 20 20 20 20 20 20 20 20 20 3a 20 6c ts : l
1c80: 69 73 74 20 74 68 65 20 74 61 72 67 65 74 73 20 ist the targets
1c90: 69 6e 20 72 75 6e 63 6f 6e 66 69 67 73 2e 63 6f in runconfigs.co
1ca0: 6e 66 69 67 0a 20 20 2d 6c 69 73 74 2d 64 62 2d nfig. -list-db-
1cb0: 74 61 72 67 65 74 73 20 20 20 20 20 20 20 20 3a targets :
1cc0: 20 6c 69 73 74 20 74 68 65 20 74 61 72 67 65 74 list the target
1cd0: 20 63 6f 6d 62 69 6e 61 74 69 6f 6e 73 20 75 73 combinations us
1ce0: 65 64 20 69 6e 20 74 68 65 20 64 62 0a 20 20 2d ed in the db. -
1cf0: 73 68 6f 77 2d 63 6f 6e 66 69 67 20 20 20 20 20 show-config
1d00: 20 20 20 20 20 20 20 3a 20 64 75 6d 70 20 74 68 : dump th
1d10: 65 20 69 6e 74 65 72 6e 61 6c 20 72 65 70 72 65 e internal repre
1d20: 73 65 6e 74 61 74 69 6f 6e 20 6f 66 20 74 68 65 sentation of the
1d30: 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 megatest.config
1d40: 20 66 69 6c 65 0a 20 20 2d 73 68 6f 77 2d 72 75 file. -show-ru
1d50: 6e 63 6f 6e 66 69 67 20 20 20 20 20 20 20 20 20 nconfig
1d60: 3a 20 64 75 6d 70 20 74 68 65 20 69 6e 74 65 72 : dump the inter
1d70: 6e 61 6c 20 72 65 70 72 65 73 65 6e 74 61 74 69 nal representati
1d80: 6f 6e 20 6f 66 20 74 68 65 20 72 75 6e 63 6f 6e on of the runcon
1d90: 66 69 67 73 2e 63 6f 6e 66 69 67 20 66 69 6c 65 figs.config file
1da0: 0a 20 20 2d 64 75 6d 70 6d 6f 64 65 20 4d 4f 44 . -dumpmode MOD
1db0: 45 20 20 20 20 20 20 20 20 20 20 3a 20 64 75 6d E : dum
1dc0: 70 20 69 6e 20 4d 4f 44 45 20 66 6f 72 6d 61 74 p in MODE format
1dd0: 20 69 6e 73 74 65 61 64 20 6f 66 20 73 65 78 70 instead of sexp
1de0: 72 2c 20 4d 4f 44 45 3d 6a 73 6f 6e 2c 69 6e 69 r, MODE=json,ini
1df0: 2c 73 65 78 70 20 65 74 63 2e 20 28 61 64 64 20 ,sexp etc. (add
1e00: 2d 64 65 62 75 67 20 30 2c 39 20 74 6f 20 73 65 -debug 0,9 to se
1e10: 65 20 77 68 69 63 68 20 66 69 6c 65 20 63 6f 6e e which file con
1e20: 74 72 69 62 75 74 65 73 20 65 61 63 68 20 6c 69 tributes each li
1e30: 6e 65 29 0a 20 20 2d 73 68 6f 77 2d 63 6d 64 69 ne). -show-cmdi
1e40: 6e 66 6f 20 20 20 20 20 20 20 20 20 20 20 3a 20 nfo :
1e50: 64 75 6d 70 20 74 68 65 20 63 6f 6d 6d 61 6e 64 dump the command
1e60: 20 69 6e 66 6f 20 66 6f 72 20 61 20 74 65 73 74 info for a test
1e70: 20 28 72 75 6e 20 69 6e 20 74 65 73 74 20 65 6e (run in test en
1e80: 76 69 72 6f 6e 6d 65 6e 74 29 0a 20 20 2d 73 65 vironment). -se
1e90: 63 74 69 6f 6e 20 73 65 63 74 69 6f 6e 4e 61 6d ction sectionNam
1ea0: 65 0a 20 20 2d 76 61 72 20 76 61 72 4e 61 6d 65 e. -var varName
1eb0: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 66 6f : fo
1ec0: 72 20 63 6f 6e 66 69 67 20 61 6e 64 20 72 75 6e r config and run
1ed0: 63 6f 6e 66 69 67 20 6c 6f 6f 6b 75 70 20 76 61 config lookup va
1ee0: 6c 75 65 20 66 6f 72 20 73 65 63 74 69 6f 6e 4e lue for sectionN
1ef0: 61 6d 65 20 76 61 72 4e 61 6d 65 0a 20 20 2d 73 ame varName. -s
1f00: 69 6e 63 65 20 4e 20 20 20 20 20 20 20 20 20 20 ince N
1f10: 20 20 20 20 20 20 3a 20 67 65 74 20 6c 69 73 74 : get list
1f20: 20 6f 66 20 72 75 6e 73 20 63 68 61 6e 67 65 64 of runs changed
1f30: 20 73 69 6e 63 65 20 74 69 6d 65 20 4e 20 28 55 since time N (U
1f40: 6e 69 78 20 73 65 63 6f 6e 64 73 29 0a 20 20 2d nix seconds). -
1f50: 66 69 65 6c 64 73 20 66 69 65 6c 64 73 70 65 63 fields fieldspec
1f60: 20 20 20 20 20 20 20 3a 20 66 69 65 6c 64 73 20 : fields
1f70: 74 6f 20 69 6e 63 6c 75 64 65 20 69 6e 20 6a 73 to include in js
1f80: 6f 6e 20 64 75 6d 70 3b 20 72 75 6e 73 3a 69 64 on dump; runs:id
1f90: 2c 72 75 6e 61 6d 65 2b 74 65 73 74 73 3a 74 65 ,runame+tests:te
1fa0: 73 74 6e 61 6d 65 2b 73 74 65 70 73 0a 20 20 2d stname+steps. -
1fb0: 73 6f 72 74 20 66 69 65 6c 64 6e 61 6d 65 20 20 sort fieldname
1fc0: 20 20 20 20 20 20 20 3a 20 69 6e 20 2d 6c 69 73 : in -lis
1fd0: 74 2d 72 75 6e 73 20 73 6f 72 74 20 74 65 73 74 t-runs sort test
1fe0: 73 20 62 79 20 74 68 69 73 20 66 69 65 6c 64 0a s by this field.
1ff0: 20 20 2d 74 65 73 74 64 61 74 61 2d 63 73 76 20 -testdata-csv
2000: 5b 63 61 74 65 67 6f 72 79 70 61 74 74 2f 5d 76 [categorypatt/]v
2010: 61 72 70 61 74 74 20 20 3a 20 64 75 6d 70 20 74 arpatt : dump t
2020: 65 73 74 64 61 74 61 20 66 6f 72 20 67 69 76 65 estdata for give
2030: 6e 20 63 61 74 65 67 6f 72 79 0a 0a 4d 69 73 63 n category..Misc
2040: 20 0a 20 20 2d 73 74 61 72 74 2d 64 69 72 20 70 . -start-dir p
2050: 61 74 68 20 20 20 20 20 20 20 20 20 3a 20 73 77 ath : sw
2060: 69 74 63 68 20 74 6f 20 74 68 69 73 20 64 69 72 itch to this dir
2070: 65 63 74 6f 72 79 20 62 65 66 6f 72 65 20 72 75 ectory before ru
2080: 6e 6e 69 6e 67 20 6d 65 67 61 74 65 73 74 0a 20 nning megatest.
2090: 20 2d 63 6f 6e 74 6f 75 72 20 63 6e 61 6d 65 20 -contour cname
20a0: 20 20 20 20 20 20 20 20 20 3a 20 61 64 64 20 61 : add a
20b0: 20 6c 65 76 65 6c 20 6f 66 20 68 69 65 72 61 72 level of hierar
20c0: 63 79 20 74 6f 20 74 68 65 20 6c 69 6e 6b 74 72 cy to the linktr
20d0: 65 65 20 61 6e 64 20 72 75 6e 20 70 61 74 68 73 ee and run paths
20e0: 0a 20 20 2d 72 65 62 75 69 6c 64 2d 64 62 20 20 . -rebuild-db
20f0: 20 20 20 20 20 20 20 20 20 20 20 3a 20 62 72 69 : bri
2100: 6e 67 20 74 68 65 20 64 61 74 61 62 61 73 65 20 ng the database
2110: 73 63 68 65 6d 61 20 75 70 20 74 6f 20 64 61 74 schema up to dat
2120: 65 0a 20 20 2d 63 6c 65 61 6e 75 70 2d 64 62 20 e. -cleanup-db
2130: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 72 65 : re
2140: 6d 6f 76 65 20 61 6e 79 20 6f 72 70 68 61 6e 20 move any orphan
2150: 72 65 63 6f 72 64 73 2c 20 76 61 63 75 75 6d 20 records, vacuum
2160: 74 68 65 20 64 62 0a 20 20 2d 69 6d 70 6f 72 74 the db. -import
2170: 2d 6d 65 67 61 74 65 73 74 2e 64 62 20 20 20 20 -megatest.db
2180: 20 3a 20 70 75 73 68 20 64 61 74 61 20 66 72 6f : push data fro
2190: 6d 20 6d 65 67 61 74 65 73 74 2e 64 62 20 74 6f m megatest.db to
21a0: 20 63 61 63 68 65 20 64 62 20 66 69 6c 65 73 20 cache db files
21b0: 69 6e 20 2f 74 6d 70 2f 24 55 53 45 52 0a 20 20 in /tmp/$USER.
21c0: 2d 73 79 6e 63 2d 74 6f 2d 6d 65 67 61 74 65 73 -sync-to-megates
21d0: 74 2e 64 62 20 20 20 20 3a 20 70 75 6c 6c 20 64 t.db : pull d
21e0: 61 74 61 20 66 72 6f 6d 20 63 61 63 68 65 20 66 ata from cache f
21f0: 69 6c 65 73 20 69 6e 20 2f 74 6d 70 2f 24 55 53 iles in /tmp/$US
2200: 45 52 20 74 6f 20 6d 65 67 61 74 65 73 74 2e 64 ER to megatest.d
2210: 62 0a 20 20 2d 73 79 6e 63 2d 74 6f 20 64 65 73 b. -sync-to des
2220: 74 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 79 t : sy
2230: 6e 63 20 74 6f 20 6e 65 77 20 70 6f 73 74 67 72 nc to new postgr
2240: 65 73 71 6c 20 63 65 6e 74 72 61 6c 20 73 74 79 esql central sty
2250: 6c 65 20 64 61 74 61 62 61 73 65 0a 20 20 2d 75 le database. -u
2260: 70 64 61 74 65 2d 6d 65 74 61 20 20 20 20 20 20 pdate-meta
2270: 20 20 20 20 20 20 3a 20 75 70 64 61 74 65 20 74 : update t
2280: 68 65 20 74 65 73 74 73 20 6d 65 74 61 64 61 74 he tests metadat
2290: 61 20 66 6f 72 20 61 6c 6c 20 74 65 73 74 73 0a a for all tests.
22a0: 20 20 2d 73 65 74 76 61 72 73 20 56 41 52 31 3d -setvars VAR1=
22b0: 76 61 6c 31 2c 56 41 52 32 3d 76 61 6c 32 20 3a val1,VAR2=val2 :
22c0: 20 41 64 64 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 Add environment
22d0: 20 76 61 72 69 61 62 6c 65 73 20 74 6f 20 61 20 variables to a
22e0: 72 75 6e 20 4e 42 2f 2f 20 74 68 65 73 65 20 61 run NB// these a
22f0: 72 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 re.
2300: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2310: 20 20 20 20 6f 76 65 72 77 72 69 74 74 65 6e 20 overwritten
2320: 62 79 20 76 61 6c 75 65 73 20 73 65 74 20 69 6e by values set in
2330: 20 63 6f 6e 66 69 67 20 66 69 6c 65 73 2e 0a 20 config files..
2340: 20 2d 73 65 72 76 65 72 20 2d 7c 68 6f 73 74 6e -server -|hostn
2350: 61 6d 65 20 20 20 20 20 20 3a 20 73 74 61 72 74 ame : start
2360: 20 74 68 65 20 73 65 72 76 65 72 20 28 72 65 64 the server (red
2370: 75 63 65 73 20 63 6f 6e 74 65 6e 74 69 6f 6e 20 uces contention
2380: 6f 6e 20 6d 65 67 61 74 65 73 74 2e 64 62 29 2c on megatest.db),
2390: 20 75 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 use.
23a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23b0: 20 2d 20 74 6f 20 61 75 74 6f 6d 61 74 69 63 61 - to automatica
23c0: 6c 6c 79 20 66 69 67 75 72 65 20 6f 75 74 20 68 lly figure out h
23d0: 6f 73 74 6e 61 6d 65 0a 20 20 2d 74 72 61 6e 73 ostname. -trans
23e0: 70 6f 72 74 20 68 74 74 70 7c 72 70 63 20 20 20 port http|rpc
23f0: 20 20 3a 20 75 73 65 20 68 74 74 70 20 6f 72 20 : use http or
2400: 72 70 63 20 66 6f 72 20 74 72 61 6e 73 70 6f 72 rpc for transpor
2410: 74 20 28 64 65 66 61 75 6c 74 20 69 73 20 68 74 t (default is ht
2420: 74 70 29 20 0a 20 20 2d 6c 6f 67 20 6c 6f 67 66 tp) . -log logf
2430: 69 6c 65 20 20 20 20 20 20 20 20 20 20 20 20 3a ile :
2440: 20 73 65 6e 64 20 73 74 64 6f 75 74 20 61 6e 64 send stdout and
2450: 20 73 74 64 65 72 72 20 74 6f 20 6c 6f 67 66 69 stderr to logfi
2460: 6c 65 0a 20 20 2d 6c 69 73 74 2d 73 65 72 76 65 le. -list-serve
2470: 72 73 20 20 20 20 20 20 20 20 20 20 20 3a 20 6c rs : l
2480: 69 73 74 20 74 68 65 20 73 65 72 76 65 72 73 20 ist the servers
2490: 0a 20 20 2d 6b 69 6c 6c 2d 73 65 72 76 65 72 73 . -kill-servers
24a0: 20 20 20 20 20 20 20 20 20 20 20 3a 20 6b 69 6c : kil
24b0: 6c 20 61 6c 6c 20 73 65 72 76 65 72 73 0a 20 20 l all servers.
24c0: 2d 72 65 70 6c 20 20 20 20 20 20 20 20 20 20 20 -repl
24d0: 20 20 20 20 20 20 20 20 3a 20 73 74 61 72 74 20 : start
24e0: 61 20 72 65 70 6c 20 28 75 73 65 66 75 6c 20 66 a repl (useful f
24f0: 6f 72 20 65 78 74 65 6e 64 69 6e 67 20 6d 65 67 or extending meg
2500: 61 74 65 73 74 29 0a 20 20 2d 6c 6f 61 64 20 66 atest). -load f
2510: 69 6c 65 2e 73 63 6d 20 20 20 20 20 20 20 20 20 ile.scm
2520: 20 3a 20 6c 6f 61 64 20 61 6e 64 20 72 75 6e 20 : load and run
2530: 66 69 6c 65 2e 73 63 6d 0a 20 20 2d 6d 61 72 6b file.scm. -mark
2540: 2d 69 6e 63 6f 6d 70 6c 65 74 65 73 20 20 20 20 -incompletes
2550: 20 20 20 3a 20 66 69 6e 64 20 61 6e 64 20 6d 61 : find and ma
2560: 72 6b 20 69 6e 63 6f 6d 70 6c 65 74 65 20 74 65 rk incomplete te
2570: 73 74 73 0a 20 20 2d 70 69 6e 67 20 72 75 6e 2d sts. -ping run-
2580: 69 64 7c 68 6f 73 74 3a 70 6f 72 74 20 20 3a 20 id|host:port :
2590: 70 69 6e 67 20 73 65 72 76 65 72 2c 20 65 78 69 ping server, exi
25a0: 74 20 77 69 74 68 20 30 20 69 66 20 66 6f 75 6e t with 0 if foun
25b0: 64 0a 20 20 2d 64 65 62 75 67 20 4e 7c 4e 2c 4d d. -debug N|N,M
25c0: 2c 4f 2e 2e 2e 20 20 20 20 20 20 20 3a 20 65 6e ,O... : en
25d0: 61 62 6c 65 20 64 65 62 75 67 20 30 2d 4e 20 6f able debug 0-N o
25e0: 72 20 4e 20 61 6e 64 20 4d 20 61 6e 64 20 4f 20 r N and M and O
25f0: 2e 2e 2e 0a 20 20 2d 63 6f 6e 66 69 67 20 66 6e .... -config fn
2600: 61 6d 65 20 20 20 20 20 20 20 20 20 20 20 3a 20 ame :
2610: 6f 76 65 72 72 69 64 65 20 74 68 65 20 6d 65 67 override the meg
2620: 61 74 65 73 74 2e 63 6f 6e 66 69 67 20 66 69 6c atest.config fil
2630: 65 20 77 69 74 68 20 66 6e 61 6d 65 0a 20 20 2d e with fname. -
2640: 61 70 70 65 6e 64 2d 63 6f 6e 66 69 67 20 66 6e append-config fn
2650: 61 6d 65 20 20 20 20 3a 20 61 70 70 65 6e 64 20 ame : append
2660: 66 6e 61 6d 65 20 74 6f 20 74 68 65 20 6d 65 67 fname to the meg
2670: 61 74 65 73 74 2e 63 6f 6e 66 69 67 20 66 69 6c atest.config fil
2680: 65 0a 0a 55 74 69 6c 69 74 69 65 73 0a 20 20 2d e..Utilities. -
2690: 65 6e 76 32 66 69 6c 65 20 66 6e 61 6d 65 20 20 env2file fname
26a0: 20 20 20 20 20 20 20 3a 20 77 72 69 74 65 20 74 : write t
26b0: 68 65 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 74 he environment t
26c0: 6f 20 66 6e 61 6d 65 2e 63 73 68 20 61 6e 64 20 o fname.csh and
26d0: 66 6e 61 6d 65 2e 73 68 0a 20 20 2d 65 6e 76 63 fname.sh. -envc
26e0: 61 70 20 61 20 20 20 20 20 20 20 20 20 20 20 20 ap a
26f0: 20 20 20 3a 20 73 61 76 65 20 63 75 72 72 65 6e : save curren
2700: 74 20 76 61 72 69 61 62 6c 65 73 20 6c 61 62 65 t variables labe
2710: 6c 65 64 20 61 73 20 63 6f 6e 74 65 78 74 20 27 led as context '
2720: 61 27 20 69 6e 20 66 69 6c 65 20 65 6e 76 64 61 a' in file envda
2730: 74 2e 64 62 0a 20 20 2d 65 6e 76 64 65 6c 74 61 t.db. -envdelta
2740: 20 61 2d 62 20 20 20 20 20 20 20 20 20 20 20 3a a-b :
2750: 20 6f 75 74 70 75 74 20 65 6e 76 69 72 6f 6d 65 output envirome
2760: 6e 74 20 64 65 6c 74 61 20 66 72 6f 6d 20 63 6f nt delta from co
2770: 6e 74 65 78 74 20 61 20 74 6f 20 63 6f 6e 74 65 ntext a to conte
2780: 78 74 20 62 20 74 6f 20 2d 6f 20 66 6e 61 6d 65 xt b to -o fname
2790: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
27a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 set
27b0: 20 74 68 65 20 6f 75 74 70 75 74 20 6d 6f 64 65 the output mode
27c0: 20 77 69 74 68 20 2d 64 75 6d 70 6d 6f 64 65 20 with -dumpmode
27d0: 63 73 68 2c 20 62 61 73 68 20 6f 72 20 69 6e 69 csh, bash or ini
27e0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
27f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 6e 6f 74 not
2800: 65 3a 20 69 6e 69 20 66 6f 72 6d 61 74 20 77 69 e: ini format wi
2810: 6c 6c 20 75 73 65 20 63 61 6c 6c 73 20 74 6f 20 ll use calls to
2820: 75 73 65 20 63 75 72 72 20 61 6e 64 20 6d 69 6e use curr and min
2830: 69 6d 69 7a 65 20 70 61 74 68 0a 20 20 2d 72 65 imize path. -re
2840: 66 64 62 32 64 61 74 20 72 65 66 64 62 20 20 20 fdb2dat refdb
2850: 20 20 20 20 20 3a 20 63 6f 6e 76 65 72 74 20 72 : convert r
2860: 65 66 64 62 20 74 6f 20 73 65 78 70 20 6f 72 20 efdb to sexp or
2870: 74 6f 20 66 6f 72 6d 61 74 20 73 70 65 63 69 66 to format specif
2880: 69 65 64 20 62 79 20 73 2d 64 75 6d 70 6d 6f 64 ied by s-dumpmod
2890: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 e.
28a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 66 6f fo
28b0: 72 6d 61 74 73 3a 20 70 65 72 6c 2c 20 72 75 62 rmats: perl, rub
28c0: 79 2c 20 73 71 6c 69 74 65 33 2c 20 63 73 76 20 y, sqlite3, csv
28d0: 28 66 6f 72 20 63 73 76 20 74 68 65 20 2d 6f 20 (for csv the -o
28e0: 70 61 72 61 6d 0a 20 20 20 20 20 20 20 20 20 20 param.
28f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2900: 20 20 77 69 6c 6c 20 73 75 62 73 74 69 74 75 74 will substitut
2910: 65 20 25 73 20 66 6f 72 20 74 68 65 20 73 68 65 e %s for the she
2920: 65 74 20 6e 61 6d 65 20 69 6e 20 67 65 6e 65 72 et name in gener
2930: 61 74 69 6e 67 20 0a 20 20 20 20 20 20 20 20 20 ating .
2940: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2950: 20 20 20 6d 75 6c 74 69 70 6c 65 20 73 68 65 65 multiple shee
2960: 74 73 29 0a 20 20 2d 6f 20 20 20 20 20 20 20 20 ts). -o
2970: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 :
2980: 6f 75 74 70 75 74 20 66 69 6c 65 20 66 6f 72 20 output file for
2990: 72 65 66 64 62 32 64 61 74 20 28 64 65 66 61 75 refdb2dat (defau
29a0: 6c 74 73 20 74 6f 20 73 74 64 6f 75 74 29 0a 20 lts to stdout).
29b0: 20 2d 61 72 63 68 69 76 65 20 63 6d 64 20 20 20 -archive cmd
29c0: 20 20 20 20 20 20 20 20 20 3a 20 61 72 63 68 69 : archi
29d0: 76 65 20 72 75 6e 73 20 73 70 65 63 69 66 69 65 ve runs specifie
29e0: 64 20 62 79 20 73 65 6c 65 63 74 6f 72 73 20 74 d by selectors t
29f0: 6f 20 6f 6e 65 20 6f 66 20 64 69 73 6b 73 20 73 o one of disks s
2a00: 70 65 63 69 66 69 65 64 0a 20 20 20 20 20 20 20 pecified.
2a10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2a20: 20 20 20 20 20 69 6e 20 74 68 65 20 5b 61 72 63 in the [arc
2a30: 68 69 76 65 2d 64 69 73 6b 73 5d 20 73 65 63 74 hive-disks] sect
2a40: 69 6f 6e 2e 0a 20 20 20 20 20 20 20 20 20 20 20 ion..
2a50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2a60: 20 63 6d 64 3a 20 6b 65 65 70 2d 68 74 6d 6c 2c cmd: keep-html,
2a70: 20 72 65 73 74 6f 72 65 2c 20 73 61 76 65 2c 20 restore, save,
2a80: 73 61 76 65 2d 72 65 6d 6f 76 65 0a 20 20 2d 67 save-remove. -g
2a90: 65 6e 65 72 61 74 65 2d 68 74 6d 6c 20 20 20 20 enerate-html
2aa0: 20 20 20 20 20 20 3a 20 63 72 65 61 74 65 20 61 : create a
2ab0: 20 73 69 6d 70 6c 65 20 68 74 6d 6c 20 74 72 65 simple html tre
2ac0: 65 20 66 6f 72 20 62 72 6f 77 73 69 6e 67 20 79 e for browsing y
2ad0: 6f 75 72 20 72 75 6e 73 0a 0a 44 69 66 66 20 72 our runs..Diff r
2ae0: 65 70 6f 72 74 0a 20 20 2d 64 69 66 66 2d 72 65 eport. -diff-re
2af0: 70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 p
2b00: 3a 20 67 65 6e 65 72 61 74 65 20 64 69 66 66 20 : generate diff
2b10: 72 65 70 6f 72 74 20 28 6d 75 73 74 20 69 6e 63 report (must inc
2b20: 6c 75 64 65 20 2d 73 72 63 2d 74 61 72 67 65 74 lude -src-target
2b30: 2c 20 2d 73 72 63 2d 72 75 6e 6e 61 6d 65 2c 20 , -src-runname,
2b40: 2d 74 61 72 67 65 74 2c 20 2d 72 75 6e 6e 61 6d -target, -runnam
2b50: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 e.
2b60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2b70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2b80: 20 20 20 20 61 6e 64 20 65 69 74 68 65 72 20 2d and either -
2b90: 64 69 66 66 2d 65 6d 61 69 6c 20 6f 72 20 2d 64 diff-email or -d
2ba0: 69 66 66 2d 68 74 6d 6c 29 0a 20 20 2d 73 72 63 iff-html). -src
2bb0: 2d 74 61 72 67 65 74 20 3c 74 61 72 67 65 74 3e -target <target>
2bc0: 0a 20 20 2d 73 72 63 2d 72 75 6e 6e 61 6d 65 20 . -src-runname
2bd0: 3c 74 61 72 67 65 74 3e 0a 20 20 2d 64 69 66 66 <target>. -diff
2be0: 2d 65 6d 61 69 6c 20 3c 65 6d 61 69 6c 73 3e 20 -email <emails>
2bf0: 20 20 20 3a 20 63 6f 6d 6d 61 20 73 65 70 61 72 : comma separ
2c00: 61 74 65 64 20 6c 69 73 74 20 6f 66 20 65 6d 61 ated list of ema
2c10: 69 6c 20 61 64 64 72 65 73 73 65 73 20 74 6f 20 il addresses to
2c20: 73 65 6e 64 20 64 69 66 66 20 72 65 70 6f 72 74 send diff report
2c30: 0a 20 20 2d 64 69 66 66 2d 68 74 6d 6c 20 20 3c . -diff-html <
2c40: 72 65 70 2e 68 74 6d 6c 3e 20 20 3a 20 70 61 74 rep.html> : pat
2c50: 68 20 74 6f 20 68 74 6d 6c 20 66 69 6c 65 20 74 h to html file t
2c60: 6f 20 67 65 6e 65 72 61 74 65 0a 0a 53 70 72 65 o generate..Spre
2c70: 61 64 73 68 65 65 74 20 67 65 6e 65 72 61 74 69 adsheet generati
2c80: 6f 6e 0a 20 20 2d 65 78 74 72 61 63 74 2d 6f 64 on. -extract-od
2c90: 73 20 66 6e 61 6d 65 2e 6f 64 73 20 20 3a 20 65 s fname.ods : e
2ca0: 78 74 72 61 63 74 20 61 6e 20 6f 70 65 6e 20 64 xtract an open d
2cb0: 6f 63 75 6d 65 6e 74 20 73 70 72 65 61 64 73 68 ocument spreadsh
2cc0: 65 65 74 20 66 72 6f 6d 20 74 68 65 20 64 61 74 eet from the dat
2cd0: 61 62 61 73 65 0a 20 20 2d 70 61 74 68 6d 6f 64 abase. -pathmod
2ce0: 20 70 61 74 68 20 20 20 20 20 20 20 20 20 20 20 path
2cf0: 3a 20 69 6e 73 65 72 74 20 70 61 74 68 2c 20 69 : insert path, i
2d00: 2e 65 2e 20 70 61 74 68 2f 72 75 6e 61 6d 65 2f .e. path/runame/
2d10: 69 74 65 6d 70 61 74 68 2f 6c 6f 67 66 69 6c 65 itempath/logfile
2d20: 2e 68 74 6d 6c 0a 20 20 20 20 20 20 20 20 20 20 .html.
2d30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2d40: 20 20 77 69 6c 6c 20 63 6c 65 61 72 20 74 68 65 will clear the
2d50: 20 66 69 65 6c 64 20 69 66 20 6e 6f 20 72 75 6e field if no run
2d60: 64 69 72 2f 74 65 73 74 6e 61 6d 65 2f 69 74 65 dir/testname/ite
2d70: 6d 70 61 74 68 2f 6c 6f 67 66 69 6c 65 0a 20 20 mpath/logfile.
2d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2d90: 20 20 20 20 20 20 20 20 20 20 69 66 20 69 74 20 if it
2da0: 63 6f 6e 74 61 69 6e 73 20 66 6f 72 77 61 72 64 contains forward
2db0: 20 73 6c 61 73 68 65 73 20 74 68 65 20 70 61 74 slashes the pat
2dc0: 68 20 77 69 6c 6c 20 62 65 20 63 6f 6e 76 65 72 h will be conver
2dd0: 74 65 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 ted.
2de0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2df0: 74 6f 20 77 69 6e 64 6f 77 73 20 73 74 79 6c 65 to windows style
2e00: 0a 47 65 74 74 69 6e 67 20 73 74 61 72 74 65 64 .Getting started
2e10: 0a 20 20 2d 63 72 65 61 74 65 2d 6d 65 67 61 74 . -create-megat
2e20: 65 73 74 2d 61 72 65 61 20 20 20 20 20 20 20 3a est-area :
2e30: 20 63 72 65 61 74 65 20 61 20 73 6b 65 6c 65 74 create a skelet
2e40: 6f 6e 20 6d 65 67 61 74 65 73 74 20 61 72 65 61 on megatest area
2e50: 2e 20 59 6f 75 20 77 69 6c 6c 20 62 65 20 70 72 . You will be pr
2e60: 6f 6d 70 74 65 64 20 66 6f 72 20 70 61 74 68 73 ompted for paths
2e70: 0a 20 20 2d 63 72 65 61 74 65 2d 74 65 73 74 20 . -create-test
2e80: 74 65 73 74 6e 61 6d 65 20 20 20 20 20 20 20 3a testname :
2e90: 20 63 72 65 61 74 65 20 61 20 73 6b 65 6c 65 74 create a skelet
2ea0: 6f 6e 20 6d 65 67 61 74 65 73 74 20 74 65 73 74 on megatest test
2eb0: 2e 20 59 6f 75 20 77 69 6c 6c 20 62 65 20 70 72 . You will be pr
2ec0: 6f 6d 70 74 65 64 20 66 6f 72 20 69 6e 66 6f 0a ompted for info.
2ed0: 0a 45 78 61 6d 70 6c 65 73 0a 0a 23 20 47 65 74 .Examples..# Get
2ee0: 20 74 65 73 74 20 70 61 74 68 2c 20 75 73 65 20 test path, use
2ef0: 27 2e 27 20 74 6f 20 67 65 74 20 61 20 73 69 6e '.' to get a sin
2f00: 67 6c 65 20 70 61 74 68 20 6f 72 20 61 20 73 70 gle path or a sp
2f10: 65 63 69 66 69 63 20 70 61 74 68 2f 66 69 6c 65 ecific path/file
2f20: 20 70 61 74 74 65 72 6e 0a 6d 65 67 61 74 65 73 pattern.megates
2f30: 74 20 2d 74 65 73 74 2d 66 69 6c 65 73 20 27 6c t -test-files 'l
2f40: 6f 67 73 2f 2a 2e 6c 6f 67 27 20 2d 74 61 72 67 ogs/*.log' -targ
2f50: 65 74 20 75 62 75 6e 74 75 2f 6e 25 2f 6e 6f 25 et ubuntu/n%/no%
2f60: 20 2d 72 75 6e 6e 61 6d 65 20 77 34 39 25 20 2d -runname w49% -
2f70: 74 65 73 74 70 61 74 74 20 74 65 73 74 5f 6d 74 testpatt test_mt
2f80: 25 0a 0a 43 61 6c 6c 65 64 20 61 73 20 22 20 28 %..Called as " (
2f90: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
2fa0: 73 65 20 28 61 72 67 76 29 20 22 20 22 29 20 22 se (argv) " ") "
2fb0: 0a 56 65 72 73 69 6f 6e 20 22 20 6d 65 67 61 74 .Version " megat
2fc0: 65 73 74 2d 76 65 72 73 69 6f 6e 20 22 2c 20 62 est-version ", b
2fd0: 75 69 6c 74 20 66 72 6f 6d 20 22 20 6d 65 67 61 uilt from " mega
2fe0: 74 65 73 74 2d 66 6f 73 73 69 6c 2d 68 61 73 68 test-fossil-hash
2ff0: 20 29 29 0a 0a 3b 3b 20 20 2d 67 75 69 20 20 20 ))..;; -gui
3000: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3010: 20 3a 20 73 74 61 72 74 20 61 20 67 75 69 20 69 : start a gui i
3020: 6e 74 65 72 66 61 63 65 0a 3b 3b 20 20 2d 63 6f nterface.;; -co
3030: 6e 66 69 67 20 66 6e 61 6d 65 20 20 20 20 20 20 nfig fname
3040: 20 20 20 20 20 3a 20 6f 76 65 72 72 69 64 65 20 : override
3050: 74 68 65 20 72 75 6e 63 6f 6e 66 69 67 73 20 66 the runconfigs f
3060: 69 6c 65 20 77 69 74 68 20 66 6e 61 6d 65 0a 0a ile with fname..
3070: 3b 3b 20 70 72 6f 63 65 73 73 20 61 72 67 73 0a ;; process args.
3080: 28 64 65 66 69 6e 65 20 72 65 6d 61 72 67 73 20 (define remargs
3090: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 73 20 0a (args:get-args .
30a0: 09 09 20 28 61 72 67 76 29 0a 09 09 20 28 6c 69 .. (argv)... (li
30b0: 73 74 20 20 22 2d 72 75 6e 74 65 73 74 73 22 20 st "-runtests"
30c0: 20 3b 3b 20 72 75 6e 20 61 20 73 70 65 63 69 66 ;; run a specif
30d0: 69 63 20 74 65 73 74 0a 09 09 09 22 2d 63 6f 6e ic test...."-con
30e0: 66 69 67 22 20 20 20 20 3b 3b 20 6f 76 65 72 72 fig" ;; overr
30f0: 69 64 65 20 74 68 65 20 63 6f 6e 66 69 67 20 66 ide the config f
3100: 69 6c 65 20 6e 61 6d 65 0a 09 09 09 22 2d 61 70 ile name...."-ap
3110: 70 65 6e 64 2d 63 6f 6e 66 69 67 22 0a 09 09 09 pend-config"....
3120: 22 2d 65 78 65 63 75 74 65 22 20 20 20 3b 3b 20 "-execute" ;;
3130: 72 75 6e 20 74 68 65 20 63 6f 6d 6d 61 6e 64 20 run the command
3140: 65 6e 63 6f 64 65 64 20 69 6e 20 74 68 65 20 62 encoded in the b
3150: 61 73 65 36 34 20 70 61 72 61 6d 65 74 65 72 0a ase64 parameter.
3160: 09 09 09 22 2d 73 74 65 70 22 0a 09 09 09 22 2d ..."-step"...."-
3170: 74 61 72 67 65 74 22 0a 09 09 09 22 2d 72 65 71 target"...."-req
3180: 74 61 72 67 22 0a 09 09 09 22 3a 72 75 6e 6e 61 targ"....":runna
3190: 6d 65 22 0a 09 09 09 22 2d 72 75 6e 6e 61 6d 65 me"...."-runname
31a0: 22 0a 09 09 09 22 3a 73 74 61 74 65 22 20 20 0a "....":state" .
31b0: 09 09 09 22 2d 73 74 61 74 65 22 0a 09 09 09 22 ..."-state"...."
31c0: 3a 73 74 61 74 75 73 22 0a 09 09 09 22 2d 73 74 :status"...."-st
31d0: 61 74 75 73 22 0a 09 09 09 22 2d 6c 69 73 74 2d atus"...."-list-
31e0: 72 75 6e 73 22 0a 20 20 20 20 20 20 20 20 20 20 runs".
31f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 22 2d "-
3200: 74 65 73 74 64 61 74 61 2d 63 73 76 22 0a 09 09 testdata-csv"...
3210: 09 22 2d 74 65 73 74 70 61 74 74 22 0a 20 20 20 ."-testpatt".
3220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3230: 20 20 20 20 20 22 2d 2d 6d 6f 64 65 70 61 74 74 "--modepatt
3240: 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ".
3250: 20 20 20 20 20 20 20 20 20 20 22 2d 74 61 67 65 "-tage
3260: 78 70 72 22 0a 09 09 09 22 2d 69 74 65 6d 70 61 xpr"...."-itempa
3270: 74 74 22 0a 09 09 09 22 2d 73 65 74 6c 6f 67 22 tt"...."-setlog"
3280: 0a 09 09 09 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 ...."-set-toplog
3290: 22 0a 09 09 09 22 2d 72 75 6e 73 74 65 70 22 0a "...."-runstep".
32a0: 09 09 09 22 2d 6c 6f 67 70 72 6f 22 0a 09 09 09 ..."-logpro"....
32b0: 22 2d 6d 22 0a 09 09 09 22 2d 72 65 72 75 6e 22 "-m"...."-rerun"
32c0: 0a 09 09 09 22 2d 64 61 79 73 22 0a 09 09 09 22 ...."-days"...."
32d0: 2d 72 65 6e 61 6d 65 2d 72 75 6e 22 0a 09 09 09 -rename-run"....
32e0: 22 2d 74 6f 22 0a 09 09 09 3b 3b 20 76 61 6c 75 "-to"....;; valu
32f0: 65 73 20 61 6e 64 20 6d 65 73 73 61 67 65 73 0a es and messages.
3300: 09 09 09 22 3a 63 61 74 65 67 6f 72 79 22 0a 09 ...":category"..
3310: 09 09 22 3a 76 61 72 69 61 62 6c 65 22 0a 09 09 ..":variable"...
3320: 09 22 3a 76 61 6c 75 65 22 0a 09 09 09 22 3a 65 .":value"....":e
3330: 78 70 65 63 74 65 64 22 0a 09 09 09 22 3a 74 6f xpected"....":to
3340: 6c 22 0a 09 09 09 22 3a 75 6e 69 74 73 22 0a 09 l"....":units"..
3350: 09 09 3b 3b 20 6d 69 73 63 0a 09 09 09 22 2d 73 ..;; misc...."-s
3360: 74 61 72 74 2d 64 69 72 22 0a 09 09 09 22 2d 63 tart-dir"...."-c
3370: 6f 6e 74 6f 75 72 22 0a 09 09 09 22 2d 73 65 72 ontour"...."-ser
3380: 76 65 72 22 0a 09 09 09 22 2d 74 72 61 6e 73 70 ver"...."-transp
3390: 6f 72 74 22 0a 09 09 09 22 2d 70 6f 72 74 22 0a ort"...."-port".
33a0: 09 09 09 22 2d 65 78 74 72 61 63 74 2d 6f 64 73 ..."-extract-ods
33b0: 22 0a 09 09 09 22 2d 70 61 74 68 6d 6f 64 22 0a "...."-pathmod".
33c0: 09 09 09 22 2d 65 6e 76 32 66 69 6c 65 22 0a 09 ..."-env2file"..
33d0: 09 09 22 2d 65 6e 76 63 61 70 22 0a 09 09 09 22 .."-envcap"...."
33e0: 2d 65 6e 76 64 65 6c 74 61 22 0a 09 09 09 22 2d -envdelta"...."-
33f0: 73 65 74 76 61 72 73 22 0a 09 09 09 22 2d 73 65 setvars"...."-se
3400: 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 22 0a t-state-status".
3410: 09 09 09 22 2d 73 65 74 2d 72 75 6e 2d 73 74 61 ..."-set-run-sta
3420: 74 75 73 22 0a 09 09 09 22 2d 64 65 62 75 67 22 tus"...."-debug"
3430: 20 3b 3b 20 66 6f 72 20 2a 76 65 72 62 6f 73 69 ;; for *verbosi
3440: 74 79 2a 20 3e 20 32 0a 09 09 09 22 2d 63 72 65 ty* > 2...."-cre
3450: 61 74 65 2d 74 65 73 74 22 0a 09 09 09 22 2d 6f ate-test"...."-o
3460: 76 65 72 72 69 64 65 2d 74 69 6d 65 6f 75 74 22 verride-timeout"
3470: 0a 09 09 09 22 2d 74 65 73 74 2d 66 69 6c 65 73 ...."-test-files
3480: 22 20 20 3b 3b 20 2d 74 65 73 74 2d 70 61 74 68 " ;; -test-path
3490: 73 20 69 73 20 66 6f 72 20 6c 69 73 74 69 6e 67 s is for listing
34a0: 20 61 6c 6c 0a 09 09 09 22 2d 6c 6f 61 64 22 20 all...."-load"
34b0: 20 20 20 20 20 20 20 3b 3b 20 6c 6f 61 64 20 61 ;; load a
34c0: 6e 64 20 65 78 65 63 74 75 74 65 20 61 20 73 63 nd exectute a sc
34d0: 68 65 6d 65 20 66 69 6c 65 0a 09 09 09 22 2d 73 heme file...."-s
34e0: 65 63 74 69 6f 6e 22 0a 09 09 09 22 2d 76 61 72 ection"...."-var
34f0: 22 0a 09 09 09 22 2d 64 75 6d 70 6d 6f 64 65 22 "...."-dumpmode"
3500: 0a 09 09 09 22 2d 72 75 6e 2d 69 64 22 0a 09 09 ...."-run-id"...
3510: 09 22 2d 70 69 6e 67 22 0a 09 09 09 22 2d 72 65 ."-ping"...."-re
3520: 66 64 62 32 64 61 74 22 0a 09 09 09 22 2d 6f 22 fdb2dat"...."-o"
3530: 0a 09 09 09 22 2d 6c 6f 67 22 0a 09 09 09 22 2d ...."-log"...."-
3540: 61 72 63 68 69 76 65 22 0a 09 09 09 22 2d 73 69 archive"...."-si
3550: 6e 63 65 22 0a 09 09 09 22 2d 66 69 65 6c 64 73 nce"...."-fields
3560: 22 0a 09 09 09 22 2d 72 65 63 6f 76 65 72 2d 74 "...."-recover-t
3570: 65 73 74 22 20 3b 3b 20 72 75 6e 2d 69 64 2c 74 est" ;; run-id,t
3580: 65 73 74 2d 69 64 20 2d 20 75 73 65 64 20 69 6e est-id - used in
3590: 74 65 72 6e 61 6c 6c 79 20 74 6f 20 72 65 63 6f ternally to reco
35a0: 76 65 72 20 61 20 74 65 73 74 20 73 74 75 63 6b ver a test stuck
35b0: 20 69 6e 20 52 55 4e 4e 49 4e 47 20 73 74 61 74 in RUNNING stat
35c0: 65 0a 09 09 09 22 2d 73 6f 72 74 22 0a 09 09 09 e...."-sort"....
35d0: 22 2d 74 61 72 67 65 74 2d 64 62 22 0a 09 09 09 "-target-db"....
35e0: 22 2d 73 6f 75 72 63 65 2d 64 62 22 0a 09 09 09 "-source-db"....
35f0: 22 2d 70 72 65 66 69 78 2d 74 61 72 67 65 74 22 "-prefix-target"
3600: 0a 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ..
3610: 20 20 20 20 20 20 20 20 20 20 22 2d 73 72 63 2d "-src-
3620: 74 61 72 67 65 74 22 0a 20 20 20 20 20 20 20 20 target".
3630: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3640: 22 2d 73 72 63 2d 72 75 6e 6e 61 6d 65 22 0a 20 "-src-runname".
3650: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3660: 20 20 20 20 20 20 20 22 2d 64 69 66 66 2d 65 6d "-diff-em
3670: 61 69 6c 22 0a 09 09 09 22 2d 73 79 6e 63 2d 74 ail"...."-sync-t
3680: 6f 22 09 09 09 0a 09 09 09 22 2d 70 67 73 79 6e o"......."-pgsyn
3690: 63 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 c".
36a0: 20 20 20 20 20 20 20 20 20 20 20 22 2d 64 69 66 "-dif
36b0: 66 2d 68 74 6d 6c 22 0a 09 09 09 29 0a 20 09 09 f-html"....). ..
36c0: 20 28 6c 69 73 74 20 20 22 2d 68 22 20 22 2d 68 (list "-h" "-h
36d0: 65 6c 70 22 20 22 2d 2d 68 65 6c 70 22 0a 09 09 elp" "--help"...
36e0: 09 22 2d 6d 61 6e 75 61 6c 22 0a 09 09 09 22 2d ."-manual"...."-
36f0: 76 65 72 73 69 6f 6e 22 0a 09 09 20 20 20 20 20 version"...
3700: 20 20 20 22 2d 66 6f 72 63 65 22 0a 09 09 20 20 "-force"...
3710: 20 20 20 20 20 20 22 2d 78 74 65 72 6d 22 0a 09 "-xterm"..
3720: 09 20 20 20 20 20 20 20 20 22 2d 73 68 6f 77 6b . "-showk
3730: 65 79 73 22 0a 09 09 20 20 20 20 20 20 20 20 22 eys"... "
3740: 2d 73 68 6f 77 2d 6b 65 79 73 22 0a 09 09 20 20 -show-keys"...
3750: 20 20 20 20 20 20 22 2d 74 65 73 74 2d 73 74 61 "-test-sta
3760: 74 75 73 22 0a 09 09 09 22 2d 73 65 74 2d 76 61 tus"...."-set-va
3770: 6c 75 65 73 22 0a 09 09 09 22 2d 6c 6f 61 64 2d lues"...."-load-
3780: 74 65 73 74 2d 64 61 74 61 22 0a 09 09 09 22 2d test-data"...."-
3790: 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 22 summarize-items"
37a0: 0a 09 09 20 20 20 20 20 20 20 20 22 2d 67 75 69 ... "-gui
37b0: 22 0a 09 09 09 22 2d 64 61 65 6d 6f 6e 69 7a 65 "...."-daemonize
37c0: 22 0a 09 09 09 22 2d 70 72 65 63 6c 65 61 6e 22 "...."-preclean"
37d0: 0a 09 09 09 22 2d 72 65 72 75 6e 2d 63 6c 65 61 ...."-rerun-clea
37e0: 6e 22 0a 09 09 09 22 2d 72 65 72 75 6e 2d 61 6c n"...."-rerun-al
37f0: 6c 22 0a 09 09 09 22 2d 63 6c 65 61 6e 2d 63 61 l"...."-clean-ca
3800: 63 68 65 22 0a 09 09 09 22 2d 6e 6f 2d 63 61 63 che"...."-no-cac
3810: 68 65 22 0a 09 09 09 22 2d 63 61 63 68 65 2d 64 he"...."-cache-d
3820: 62 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 b".
3830: 20 20 20 20 20 20 20 20 20 20 20 22 2d 75 73 65 "-use
3840: 2d 64 62 2d 63 61 63 68 65 22 0a 20 20 20 20 20 -db-cache".
3850: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3860: 20 20 20 22 2d 70 72 65 70 65 6e 64 2d 63 6f 6e "-prepend-con
3870: 74 6f 75 72 22 0a 09 09 09 3b 3b 20 6d 69 73 63 tour"....;; misc
3880: 0a 09 09 09 22 2d 72 65 70 6c 22 0a 09 09 09 22 ...."-repl"...."
3890: 2d 6c 6f 63 6b 22 0a 09 09 09 22 2d 75 6e 6c 6f -lock"...."-unlo
38a0: 63 6b 22 0a 09 09 09 22 2d 6c 69 73 74 2d 73 65 ck"...."-list-se
38b0: 72 76 65 72 73 22 0a 09 09 09 22 2d 6b 69 6c 6c rvers"...."-kill
38c0: 2d 73 65 72 76 65 72 73 22 0a 20 20 20 20 20 20 -servers".
38d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
38e0: 20 20 22 2d 72 75 6e 2d 77 61 69 74 22 20 20 20 "-run-wait"
38f0: 20 20 20 3b 3b 20 77 61 69 74 20 6f 6e 20 61 20 ;; wait on a
3900: 72 75 6e 20 74 6f 20 63 6f 6d 70 6c 65 74 65 20 run to complete
3910: 28 69 2e 65 2e 20 6e 6f 20 52 55 4e 4e 49 4e 47 (i.e. no RUNNING
3920: 29 0a 09 09 09 22 2d 6f 6e 65 2d 70 61 73 73 22 )...."-one-pass"
3930: 20 20 20 20 20 20 20 3b 3b 0a 09 09 09 22 2d 6c ;;...."-l
3940: 6f 63 61 6c 22 20 20 20 20 20 20 20 20 20 3b 3b ocal" ;;
3950: 20 72 75 6e 20 73 6f 6d 65 20 63 6f 6d 6d 61 6e run some comman
3960: 64 73 20 75 73 69 6e 67 20 6c 6f 63 61 6c 20 64 ds using local d
3970: 62 20 61 63 63 65 73 73 0a 20 20 20 20 20 20 20 b access.
3980: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3990: 20 22 2d 67 65 6e 65 72 61 74 65 2d 68 74 6d 6c "-generate-html
39a0: 22 0a 0a 09 09 09 3b 3b 20 6d 69 73 63 20 71 75 ".....;; misc qu
39b0: 65 72 69 65 73 0a 09 09 09 22 2d 6c 69 73 74 2d eries...."-list-
39c0: 64 69 73 6b 73 22 0a 09 09 09 22 2d 6c 69 73 74 disks"...."-list
39d0: 2d 74 61 72 67 65 74 73 22 0a 09 09 09 22 2d 6c -targets"...."-l
39e0: 69 73 74 2d 64 62 2d 74 61 72 67 65 74 73 22 0a ist-db-targets".
39f0: 09 09 09 22 2d 73 68 6f 77 2d 72 75 6e 63 6f 6e ..."-show-runcon
3a00: 66 69 67 22 0a 09 09 09 22 2d 73 68 6f 77 2d 63 fig"...."-show-c
3a10: 6f 6e 66 69 67 22 0a 09 09 09 22 2d 73 68 6f 77 onfig"...."-show
3a20: 2d 63 6d 64 69 6e 66 6f 22 0a 09 09 09 22 2d 67 -cmdinfo"...."-g
3a30: 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 22 0a 0a et-run-status"..
3a40: 09 09 09 3b 3b 20 71 75 65 72 69 65 73 0a 09 09 ...;; queries...
3a50: 09 22 2d 74 65 73 74 2d 70 61 74 68 73 22 20 3b ."-test-paths" ;
3a60: 3b 20 67 65 74 20 70 61 74 68 28 73 29 20 74 6f ; get path(s) to
3a70: 20 61 20 74 65 73 74 2c 20 6f 72 64 65 72 65 64 a test, ordered
3a80: 20 62 79 20 79 6f 75 6e 67 65 73 74 20 66 69 72 by youngest fir
3a90: 73 74 0a 0a 09 09 09 22 2d 72 75 6e 61 6c 6c 22 st....."-runall"
3aa0: 20 20 20 20 3b 3b 20 72 75 6e 20 61 6c 6c 20 74 ;; run all t
3ab0: 65 73 74 73 2c 20 72 65 73 70 65 63 74 73 20 2d ests, respects -
3ac0: 74 65 73 74 70 61 74 74 2c 20 64 65 66 61 75 6c testpatt, defaul
3ad0: 74 73 20 74 6f 20 25 0a 09 09 09 22 2d 72 75 6e ts to %...."-run
3ae0: 22 20 20 20 20 20 20 20 3b 3b 20 61 6c 69 61 73 " ;; alias
3af0: 20 66 6f 72 20 2d 72 75 6e 61 6c 6c 0a 09 09 09 for -runall....
3b00: 22 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 22 0a 20 "-remove-runs".
3b10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3b20: 20 20 20 20 20 20 20 22 2d 6b 65 65 70 2d 72 65 "-keep-re
3b30: 63 6f 72 64 73 22 20 3b 3b 20 75 73 65 20 77 69 cords" ;; use wi
3b40: 74 68 20 2d 72 65 6d 6f 76 65 2d 72 75 6e 73 20 th -remove-runs
3b50: 74 6f 20 72 65 6d 6f 76 65 20 6f 6e 6c 79 20 74 to remove only t
3b60: 68 65 20 72 75 6e 20 64 61 74 61 0a 09 09 09 22 he run data...."
3b70: 2d 72 65 62 75 69 6c 64 2d 64 62 22 0a 09 09 09 -rebuild-db"....
3b80: 22 2d 63 6c 65 61 6e 75 70 2d 64 62 22 0a 09 09 "-cleanup-db"...
3b90: 09 22 2d 72 6f 6c 6c 75 70 22 0a 09 09 09 22 2d ."-rollup"...."-
3ba0: 75 70 64 61 74 65 2d 6d 65 74 61 22 0a 09 09 09 update-meta"....
3bb0: 22 2d 63 72 65 61 74 65 2d 6d 65 67 61 74 65 73 "-create-megates
3bc0: 74 2d 61 72 65 61 22 0a 09 09 09 22 2d 6d 61 72 t-area"...."-mar
3bd0: 6b 2d 69 6e 63 6f 6d 70 6c 65 74 65 73 22 0a 0a k-incompletes"..
3be0: 09 09 09 22 2d 63 6f 6e 76 65 72 74 2d 74 6f 2d ..."-convert-to-
3bf0: 6e 6f 72 6d 22 0a 09 09 09 22 2d 63 6f 6e 76 65 norm"...."-conve
3c00: 72 74 2d 74 6f 2d 6f 6c 64 22 0a 09 09 09 22 2d rt-to-old"...."-
3c10: 69 6d 70 6f 72 74 2d 6d 65 67 61 74 65 73 74 2e import-megatest.
3c20: 64 62 22 0a 09 09 09 22 2d 73 79 6e 63 2d 74 6f db"...."-sync-to
3c30: 2d 6d 65 67 61 74 65 73 74 2e 64 62 22 0a 09 09 -megatest.db"...
3c40: 09 0a 09 09 09 22 2d 6c 6f 67 67 69 6e 67 22 0a ....."-logging".
3c50: 09 09 09 22 2d 76 22 20 3b 3b 20 76 65 72 62 6f ..."-v" ;; verbo
3c60: 73 65 20 32 2c 20 6d 6f 72 65 20 74 68 61 6e 20 se 2, more than
3c70: 6e 6f 72 6d 61 6c 20 28 6e 6f 72 6d 61 6c 20 69 normal (normal i
3c80: 73 20 31 29 0a 09 09 09 22 2d 71 22 20 3b 3b 20 s 1)...."-q" ;;
3c90: 71 75 69 65 74 20 30 2c 20 65 72 72 6f 72 73 2f quiet 0, errors/
3ca0: 77 61 72 6e 69 6e 67 73 20 6f 6e 6c 79 0a 0a 20 warnings only..
3cb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3cc0: 20 20 20 20 20 20 20 22 2d 64 69 66 66 2d 72 65 "-diff-re
3cd0: 70 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 p".
3ce0: 20 20 20 20 20 20 20 20 20 20 20 29 0a 09 09 20 )...
3cf0: 61 72 67 73 3a 61 72 67 2d 68 61 73 68 0a 09 09 args:arg-hash...
3d00: 20 30 29 29 0a 0a 3b 3b 20 41 64 64 20 61 72 67 0))..;; Add arg
3d10: 73 20 74 68 61 74 20 75 73 65 20 72 65 6d 61 72 s that use remar
3d20: 67 73 20 68 65 72 65 0a 3b 3b 0a 28 69 66 20 28 gs here.;;.(if (
3d30: 61 6e 64 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 and (not (null?
3d40: 72 65 6d 61 72 67 73 29 29 0a 09 20 28 6e 6f 74 remargs)).. (not
3d50: 20 28 6f 72 0a 09 20 20 20 20 20 20 20 28 61 72 (or.. (ar
3d60: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
3d70: 73 74 65 70 22 29 0a 09 20 20 20 20 20 20 20 28 step").. (
3d80: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 args:get-arg "-e
3d90: 6e 76 63 61 70 22 29 0a 09 20 20 20 20 20 20 20 nvcap")..
3da0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
3db0: 65 6e 76 64 65 6c 74 61 22 29 0a 09 20 20 20 20 envdelta")..
3dc0: 20 20 20 29 0a 09 20 20 20 20 20 20 29 29 0a 20 ).. )).
3dd0: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
3de0: 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 error 0 *default
3df0: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 55 6e 72 65 -log-port* "Unre
3e00: 63 6f 67 6e 69 73 65 64 20 61 72 67 75 6d 65 6e cognised argumen
3e10: 74 73 3a 20 22 20 28 73 74 72 69 6e 67 2d 69 6e ts: " (string-in
3e20: 74 65 72 73 70 65 72 73 65 20 28 69 66 20 28 6c tersperse (if (l
3e30: 69 73 74 3f 20 72 65 6d 61 72 67 73 29 20 72 65 ist? remargs) re
3e40: 6d 61 72 67 73 20 28 61 72 67 76 29 29 20 20 22 margs (argv)) "
3e50: 20 22 29 29 29 0a 0a 3b 3b 20 62 65 66 6f 72 65 ")))..;; before
3e60: 20 64 6f 69 6e 67 20 61 6e 79 74 68 69 6e 67 20 doing anything
3e70: 65 6c 73 65 20 63 68 61 6e 67 65 20 74 6f 20 74 else change to t
3e80: 68 65 20 73 74 61 72 74 2d 64 69 72 20 69 66 20 he start-dir if
3e90: 70 72 6f 76 69 64 65 64 0a 3b 3b 0a 28 69 66 20 provided.;;.(if
3ea0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
3eb0: 73 74 61 72 74 2d 64 69 72 22 29 0a 20 20 20 20 start-dir").
3ec0: 28 69 66 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 (if (common:file
3ed0: 2d 65 78 69 73 74 73 3f 20 28 61 72 67 73 3a 67 -exists? (args:g
3ee0: 65 74 2d 61 72 67 20 22 2d 73 74 61 72 74 2d 64 et-arg "-start-d
3ef0: 69 72 22 29 29 0a 20 20 20 20 20 20 20 20 28 6c ir")). (l
3f00: 65 74 20 28 28 66 75 6c 6c 70 61 74 68 20 28 63 et ((fullpath (c
3f10: 6f 6d 6d 6f 6e 3a 72 65 61 6c 2d 70 61 74 68 20 ommon:real-path
3f20: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
3f30: 73 74 61 72 74 2d 64 69 72 22 29 29 29 29 0a 20 start-dir")))).
3f40: 20 20 20 20 20 20 20 20 20 28 73 65 74 65 6e 76 (setenv
3f50: 20 22 50 57 44 22 20 66 75 6c 6c 70 61 74 68 29 "PWD" fullpath)
3f60: 0a 20 20 20 20 20 20 20 20 20 20 28 63 68 61 6e . (chan
3f70: 67 65 2d 64 69 72 65 63 74 6f 72 79 20 66 75 6c ge-directory ful
3f80: 6c 70 61 74 68 29 29 0a 09 28 62 65 67 69 6e 0a lpath))..(begin.
3f90: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d . (debug:print-
3fa0: 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 error 0 *default
3fb0: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 6e 6f 6e 2d -log-port* "non-
3fc0: 65 78 69 73 74 61 6e 74 20 73 74 61 72 74 20 64 existant start d
3fd0: 69 72 20 22 20 28 61 72 67 73 3a 67 65 74 2d 61 ir " (args:get-a
3fe0: 72 67 20 22 2d 73 74 61 72 74 2d 64 69 72 22 29 rg "-start-dir")
3ff0: 20 22 20 73 70 65 63 69 66 69 65 64 2c 20 65 78 " specified, ex
4000: 69 74 69 6e 67 2e 22 29 0a 09 20 20 28 65 78 69 iting.").. (exi
4010: 74 20 31 29 29 29 29 0a 0a 3b 3b 20 69 6d 6d 65 t 1))))..;; imme
4020: 64 69 61 74 65 6c 79 20 73 65 74 20 4d 54 5f 54 diately set MT_T
4030: 41 52 47 45 54 20 69 66 20 2d 72 65 71 74 61 72 ARGET if -reqtar
4040: 67 20 6f 72 20 2d 74 61 72 67 65 74 20 61 72 65 g or -target are
4050: 20 61 76 61 69 6c 61 62 6c 65 0a 3b 3b 0a 28 6c available.;;.(l
4060: 65 74 20 28 28 74 61 72 67 20 28 6f 72 20 28 61 et ((targ (or (a
4070: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 rgs:get-arg "-re
4080: 71 74 61 72 67 22 29 28 61 72 67 73 3a 67 65 74 qtarg")(args:get
4090: 2d 61 72 67 20 22 2d 74 61 72 67 65 74 22 29 29 -arg "-target"))
40a0: 29 29 0a 20 20 28 69 66 20 74 61 72 67 20 28 73 )). (if targ (s
40b0: 65 74 65 6e 76 20 22 4d 54 5f 54 41 52 47 45 54 etenv "MT_TARGET
40c0: 22 20 74 61 72 67 29 29 29 0a 0a 3b 3b 20 54 68 " targ)))..;; Th
40d0: 65 20 77 61 74 63 68 64 6f 67 20 69 73 20 74 6f e watchdog is to
40e0: 20 6b 65 65 70 20 61 6e 20 65 79 65 20 6f 6e 20 keep an eye on
40f0: 74 68 69 6e 67 73 20 6c 69 6b 65 20 64 62 20 73 things like db s
4100: 79 6e 63 20 65 74 63 2e 0a 3b 3b 0a 0a 3b 3b 20 ync etc..;;..;;
4110: 54 4f 44 4f 3a 20 66 6f 72 20 6d 75 6c 74 69 70 TODO: for multip
4120: 6c 65 20 61 72 65 61 73 2c 20 77 65 20 77 69 6c le areas, we wil
4130: 6c 20 68 61 76 65 20 6d 75 6c 74 69 70 6c 65 20 l have multiple
4140: 77 61 74 63 68 64 6f 67 73 3b 20 61 6e 64 20 6d watchdogs; and m
4150: 75 6c 74 69 70 6c 65 20 74 68 72 65 61 64 73 20 ultiple threads
4160: 74 6f 20 6d 61 6e 61 67 65 0a 28 64 65 66 69 6e to manage.(defin
4170: 65 20 2a 77 61 74 63 68 64 6f 67 2a 20 28 6d 61 e *watchdog* (ma
4180: 6b 65 2d 74 68 72 65 61 64 0a 09 09 20 20 20 20 ke-thread...
4190: 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 20 20 20 (lambda ()...
41a0: 20 20 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 (handle-excep
41b0: 74 69 6f 6e 73 0a 09 09 09 20 20 65 78 6e 0a 09 tions.... exn..
41c0: 09 09 20 20 28 62 65 67 69 6e 0a 09 09 09 20 20 .. (begin....
41d0: 20 20 28 70 72 69 6e 74 2d 63 61 6c 6c 2d 63 68 (print-call-ch
41e0: 61 69 6e 29 0a 09 09 09 20 20 20 20 28 70 72 69 ain).... (pri
41f0: 6e 74 20 22 20 6d 65 73 73 61 67 65 3a 20 22 20 nt " message: "
4200: 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 ((condition-prop
4210: 65 72 74 79 2d 61 63 63 65 73 73 6f 72 20 27 65 erty-accessor 'e
4220: 78 6e 20 27 6d 65 73 73 61 67 65 29 20 65 78 6e xn 'message) exn
4230: 29 29 29 0a 09 09 09 28 63 6f 6d 6d 6f 6e 3a 77 )))....(common:w
4240: 61 74 63 68 64 6f 67 29 29 29 0a 09 09 20 20 20 atchdog)))...
4250: 20 22 57 61 74 63 68 64 6f 67 20 74 68 72 65 61 "Watchdog threa
4260: 64 22 29 29 0a 0a 3b 3b 28 69 66 20 28 6e 6f 74 d"))..;;(if (not
4270: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
4280: 2d 73 65 72 76 65 72 22 29 29 0a 3b 3b 20 20 20 -server")).;;
4290: 20 28 74 68 72 65 61 64 2d 73 74 61 72 74 21 20 (thread-start!
42a0: 2a 77 61 74 63 68 64 6f 67 2a 29 29 20 3b 3b 20 *watchdog*)) ;;
42b0: 69 66 20 73 74 61 72 74 69 6e 67 20 61 20 73 65 if starting a se
42c0: 72 76 65 72 3b 20 77 61 69 74 20 74 69 6c 6c 20 rver; wait till
42d0: 77 65 20 67 65 74 20 74 6f 20 72 75 6e 6e 69 6e we get to runnin
42e0: 67 20 73 74 61 74 65 20 62 65 66 6f 72 65 20 6b g state before k
42f0: 69 63 6b 69 6e 67 20 6f 66 66 20 77 61 74 63 68 icking off watch
4300: 64 6f 67 0a 28 6c 65 74 2a 20 28 28 6e 6f 2d 77 dog.(let* ((no-w
4310: 61 74 63 68 64 6f 67 2d 61 72 67 73 0a 20 20 20 atchdog-args.
4320: 20 20 20 20 27 28 22 2d 6c 69 73 74 2d 72 75 6e '("-list-run
4330: 73 22 0a 20 20 20 20 20 20 20 20 20 22 2d 74 65 s". "-te
4340: 73 74 64 61 74 61 2d 63 73 76 22 0a 20 20 20 20 stdata-csv".
4350: 20 20 20 20 20 22 2d 6c 69 73 74 2d 73 65 72 76 "-list-serv
4360: 65 72 73 22 0a 20 20 20 20 20 20 20 20 20 22 2d ers". "-
4370: 73 65 72 76 65 72 22 0a 20 20 20 20 20 20 20 20 server".
4380: 20 22 2d 6c 69 73 74 2d 64 69 73 6b 73 22 0a 20 "-list-disks".
4390: 20 20 20 20 20 20 20 20 22 2d 6c 69 73 74 2d 74 "-list-t
43a0: 61 72 67 65 74 73 22 0a 20 20 20 20 20 20 20 20 argets".
43b0: 20 22 2d 73 68 6f 77 2d 72 75 6e 63 6f 6e 66 69 "-show-runconfi
43c0: 67 22 0a 20 20 20 20 20 20 20 20 20 3b 3b 22 2d g". ;;"-
43d0: 6c 69 73 74 2d 64 62 2d 74 61 72 67 65 74 73 22 list-db-targets"
43e0: 0a 20 20 20 20 20 20 20 20 20 22 2d 73 68 6f 77 . "-show
43f0: 2d 72 75 6e 63 6f 6e 66 69 67 22 0a 20 20 20 20 -runconfig".
4400: 20 20 20 20 20 22 2d 73 68 6f 77 2d 63 6f 6e 66 "-show-conf
4410: 69 67 22 0a 20 20 20 20 20 20 20 20 20 22 2d 73 ig". "-s
4420: 68 6f 77 2d 63 6d 64 69 6e 66 6f 22 0a 09 20 22 how-cmdinfo".. "
4430: 2d 63 6c 65 61 6e 75 70 2d 64 62 22 29 29 0a 20 -cleanup-db")).
4440: 20 20 20 20 20 20 28 6e 6f 2d 77 61 74 63 68 64 (no-watchd
4450: 6f 67 2d 61 72 67 73 2d 76 61 6c 73 20 28 66 69 og-args-vals (fi
4460: 6c 74 65 72 20 28 6c 61 6d 62 64 61 20 28 78 29 lter (lambda (x)
4470: 20 78 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 x).
4480: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4490: 20 20 20 20 20 20 20 20 20 20 28 6d 61 70 20 61 (map a
44a0: 72 67 73 3a 67 65 74 2d 61 72 67 20 6e 6f 2d 77 rgs:get-arg no-w
44b0: 61 74 63 68 64 6f 67 2d 61 72 67 73 29 29 29 0a atchdog-args))).
44c0: 20 20 20 20 20 20 20 28 73 74 61 72 74 2d 77 61 (start-wa
44d0: 74 63 68 64 6f 67 20 28 6e 75 6c 6c 3f 20 6e 6f tchdog (null? no
44e0: 2d 77 61 74 63 68 64 6f 67 2d 61 72 67 73 2d 76 -watchdog-args-v
44f0: 61 6c 73 29 29 29 0a 20 20 3b 3b 28 42 42 3e 20 als))). ;;(BB>
4500: 22 6e 6f 2d 77 61 74 63 68 64 6f 67 2d 61 72 67 "no-watchdog-arg
4510: 73 3d 22 6e 6f 2d 77 61 74 63 68 64 6f 67 2d 61 s="no-watchdog-a
4520: 72 67 73 20 22 6e 6f 2d 77 61 74 63 68 64 6f 67 rgs "no-watchdog
4530: 2d 61 72 67 73 2d 76 61 6c 73 3d 22 6e 6f 2d 77 -args-vals="no-w
4540: 61 74 63 68 64 6f 67 2d 61 72 67 73 2d 76 61 6c atchdog-args-val
4550: 73 29 20 0a 20 20 28 69 66 20 73 74 61 72 74 2d s) . (if start-
4560: 77 61 74 63 68 64 6f 67 0a 20 20 20 20 20 20 28 watchdog. (
4570: 74 68 72 65 61 64 2d 73 74 61 72 74 21 20 2a 77 thread-start! *w
4580: 61 74 63 68 64 6f 67 2a 29 29 29 0a 0a 0a 3b 3b atchdog*)))...;;
4590: 20 62 72 61 63 6b 65 74 20 6f 70 65 6e 2d 6f 75 bracket open-ou
45a0: 74 70 75 74 2d 66 69 6c 65 20 77 69 74 68 20 63 tput-file with c
45b0: 6f 64 65 20 74 6f 20 6d 61 6b 65 20 6c 65 61 64 ode to make lead
45c0: 69 6e 67 20 64 69 72 65 63 74 6f 72 79 20 69 66 ing directory if
45d0: 20 69 74 20 64 6f 65 73 20 6e 6f 74 20 65 78 69 it does not exi
45e0: 73 74 20 61 6e 64 20 68 61 6e 64 6c 65 20 65 78 st and handle ex
45f0: 63 65 70 74 69 6f 6e 73 0a 28 64 65 66 69 6e 65 ceptions.(define
4600: 20 28 6f 70 65 6e 2d 6c 6f 67 66 69 6c 65 20 6c (open-logfile l
4610: 6f 67 70 61 74 68 29 0a 20 20 28 63 6f 6e 64 69 ogpath). (condi
4620: 74 69 6f 6e 2d 63 61 73 65 0a 20 20 20 28 6c 65 tion-case. (le
4630: 74 2a 20 28 28 6c 6f 67 2d 64 69 72 20 28 6f 72 t* ((log-dir (or
4640: 20 28 70 61 74 68 6e 61 6d 65 2d 64 69 72 65 63 (pathname-direc
4650: 74 6f 72 79 20 6c 6f 67 70 61 74 68 29 20 22 2e tory logpath) ".
4660: 22 29 29 29 0a 20 20 20 20 20 28 69 66 20 28 6e "))). (if (n
4670: 6f 74 20 28 64 69 72 65 63 74 6f 72 79 2d 65 78 ot (directory-ex
4680: 69 73 74 73 3f 20 6c 6f 67 2d 64 69 72 29 29 0a ists? log-dir)).
4690: 20 20 20 20 20 20 20 20 20 28 73 79 73 74 65 6d (system
46a0: 20 28 63 6f 6e 63 20 22 6d 6b 64 69 72 20 2d 70 (conc "mkdir -p
46b0: 20 22 20 6c 6f 67 2d 64 69 72 29 29 29 0a 20 20 " log-dir))).
46c0: 20 20 20 28 6f 70 65 6e 2d 6f 75 74 70 75 74 2d (open-output-
46d0: 66 69 6c 65 20 6c 6f 67 70 61 74 68 29 29 0a 20 file logpath)).
46e0: 20 20 28 65 78 6e 20 28 29 0a 20 20 20 20 20 20 (exn ().
46f0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 (debug:print-e
4700: 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d rror 0 *default-
4710: 6c 6f 67 2d 70 6f 72 74 2a 20 22 43 6f 75 6c 64 log-port* "Could
4720: 20 6e 6f 74 20 6f 70 65 6e 20 6c 6f 67 20 66 69 not open log fi
4730: 6c 65 20 66 6f 72 20 77 72 69 74 65 3a 20 22 6c le for write: "l
4740: 6f 67 70 61 74 68 29 0a 20 20 20 20 20 20 20 20 ogpath).
4750: 28 64 65 66 69 6e 65 20 2a 64 69 64 73 6f 6d 65 (define *didsome
4760: 74 68 69 6e 67 2a 20 23 74 29 20 20 0a 20 20 20 thing* #t) .
4770: 20 20 20 20 20 28 65 78 69 74 20 31 29 29 29 29 (exit 1))))
4780: 0a 0a 3b 3b 20 74 68 69 73 20 73 65 67 6d 65 6e ..;; this segmen
4790: 74 20 77 69 6c 6c 20 72 75 6e 20 6c 61 75 6e 63 t will run launc
47a0: 68 3a 73 65 74 75 70 20 6f 6e 6c 79 20 69 66 20 h:setup only if
47b0: 2d 6c 6f 67 20 69 73 20 6e 6f 74 20 73 65 74 2e -log is not set.
47c0: 20 54 68 69 73 20 69 73 20 66 61 69 72 6c 79 20 This is fairly
47d0: 73 61 66 65 20 61 73 20 73 65 72 76 65 72 73 20 safe as servers
47e0: 61 72 65 20 6e 6f 74 0a 3b 3b 20 6d 61 6e 75 61 are not.;; manua
47f0: 6c 6c 79 20 73 74 61 72 74 65 64 20 61 6e 64 20 lly started and
4800: 74 68 75 73 20 73 68 6f 75 6c 64 20 6e 65 76 65 thus should neve
4810: 72 20 62 65 20 73 74 61 72 74 65 64 20 69 6e 20 r be started in
4820: 61 20 6e 6f 6e 2d 6d 65 67 61 74 65 73 74 20 61 a non-megatest a
4830: 72 65 61 2e 20 54 68 75 73 20 6e 6f 20 6e 65 65 rea. Thus no nee
4840: 64 20 74 6f 20 68 61 6e 64 6c 65 20 73 69 74 75 d to handle situ
4850: 61 74 69 6f 6e 0a 3b 3b 20 77 68 65 72 65 20 28 ation.;; where (
4860: 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 20 72 65 launch:setup) re
4870: 74 75 72 6e 73 20 23 66 3f 0a 3b 3b 0a 28 69 66 turns #f?.;;.(if
4880: 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 (or (args:get-a
4890: 72 67 20 22 2d 6c 6f 67 22 29 28 61 72 67 73 3a rg "-log")(args:
48a0: 67 65 74 2d 61 72 67 20 22 2d 73 65 72 76 65 72 get-arg "-server
48b0: 22 29 29 20 3b 3b 20 72 65 64 69 72 65 63 74 20 ")) ;; redirect
48c0: 74 68 65 20 6c 6f 67 20 61 6c 77 61 79 73 20 77 the log always w
48d0: 68 65 6e 20 61 20 73 65 72 76 65 72 0a 20 20 20 hen a server.
48e0: 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 (handle-excepti
48f0: 6f 6e 73 0a 09 65 78 6e 0a 09 28 62 65 67 69 6e ons..exn..(begin
4900: 0a 09 20 20 28 70 72 69 6e 74 20 22 45 52 52 4f .. (print "ERRO
4910: 52 3a 20 46 61 69 6c 65 64 20 74 6f 20 73 77 69 R: Failed to swi
4920: 74 63 68 20 74 6f 20 6c 6f 67 20 6f 75 74 70 75 tch to log outpu
4930: 74 2e 20 22 20 28 28 63 6f 6e 64 69 74 69 6f 6e t. " ((condition
4940: 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 65 73 73 -property-access
4950: 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 61 67 65 or 'exn 'message
4960: 29 20 65 78 6e 29 29 0a 09 20 20 29 0a 20 20 20 ) exn)).. ).
4970: 20 20 20 28 6c 65 74 2a 20 28 28 74 6c 20 20 20 (let* ((tl
4980: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
4990: 67 20 22 2d 6c 6f 67 22 29 28 6c 61 75 6e 63 68 g "-log")(launch
49a0: 3a 73 65 74 75 70 29 29 29 20 20 20 3b 3b 20 72 :setup))) ;; r
49b0: 75 6e 20 6c 61 75 6e 63 68 3a 73 65 74 75 70 20 un launch:setup
49c0: 69 66 20 2d 73 65 72 76 65 72 2c 20 65 6e 73 75 if -server, ensu
49d0: 72 65 20 77 65 20 64 6f 20 4e 4f 54 20 72 75 6e re we do NOT run
49e0: 20 6c 61 75 6e 63 68 3a 73 65 74 75 70 20 69 66 launch:setup if
49f0: 20 2d 6c 6f 67 20 73 70 65 63 69 66 69 65 64 0a -log specified.
4a00: 09 20 20 20 20 20 28 6c 6f 67 66 20 28 6f 72 20 . (logf (or
4a10: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
4a20: 6c 6f 67 22 29 20 3b 3b 20 75 73 65 20 2d 6c 6f log") ;; use -lo
4a30: 67 20 75 6e 6c 65 73 73 20 77 65 20 61 72 65 20 g unless we are
4a40: 61 20 73 65 72 76 65 72 2c 20 74 68 65 6e 20 63 a server, then c
4a50: 72 61 66 74 20 61 20 6c 6f 67 66 69 6c 65 20 6e raft a logfile n
4a60: 61 6d 65 0a 09 09 20 20 20 20 20 20 20 28 63 6f ame... (co
4a70: 6e 63 20 74 6c 20 22 2f 6c 6f 67 73 2f 73 65 72 nc tl "/logs/ser
4a80: 76 65 72 2d 22 20 28 63 75 72 72 65 6e 74 2d 70 ver-" (current-p
4a90: 72 6f 63 65 73 73 2d 69 64 29 20 22 2d 22 20 28 rocess-id) "-" (
4aa0: 67 65 74 2d 68 6f 73 74 2d 6e 61 6d 65 29 20 22 get-host-name) "
4ab0: 2e 6c 6f 67 22 29 29 29 0a 09 20 20 20 20 20 28 .log"))).. (
4ac0: 6f 75 70 20 20 28 6f 70 65 6e 2d 6c 6f 67 66 69 oup (open-logfi
4ad0: 6c 65 20 6c 6f 67 66 29 29 29 0a 09 28 69 66 20 le logf)))..(if
4ae0: 28 6e 6f 74 20 28 61 72 67 73 3a 67 65 74 2d 61 (not (args:get-a
4af0: 72 67 20 22 2d 6c 6f 67 22 29 29 0a 09 20 20 20 rg "-log"))..
4b00: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set
4b10: 21 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 20 ! args:arg-hash
4b20: 22 2d 6c 6f 67 22 20 6c 6f 67 66 29 29 20 3b 3b "-log" logf)) ;;
4b30: 20 66 61 6b 65 20 6f 75 74 20 66 75 74 75 72 65 fake out future
4b40: 20 71 75 65 72 69 65 73 20 6f 66 20 2d 6c 6f 67 queries of -log
4b50: 0a 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 ..(debug:print-i
4b60: 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c nfo 0 *default-l
4b70: 6f 67 2d 70 6f 72 74 2a 20 22 53 65 6e 64 69 6e og-port* "Sendin
4b80: 67 20 6c 6f 67 20 6f 75 74 70 75 74 20 74 6f 20 g log output to
4b90: 22 20 6c 6f 67 66 29 0a 09 28 73 65 74 21 20 2a " logf)..(set! *
4ba0: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
4bb0: 2a 20 6f 75 70 29 29 29 29 0a 0a 28 69 66 20 28 * oup))))..(if (
4bc0: 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 or (args:get-arg
4bd0: 20 22 2d 68 22 29 0a 09 28 61 72 67 73 3a 67 65 "-h")..(args:ge
4be0: 74 2d 61 72 67 20 22 2d 68 65 6c 70 22 29 0a 09 t-arg "-help")..
4bf0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
4c00: 2d 68 65 6c 70 22 29 29 0a 20 20 20 20 28 62 65 -help")). (be
4c10: 67 69 6e 0a 20 20 20 20 20 20 28 70 72 69 6e 74 gin. (print
4c20: 20 68 65 6c 70 29 0a 20 20 20 20 20 20 28 65 78 help). (ex
4c30: 69 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 it)))..(if (args
4c40: 3a 67 65 74 2d 61 72 67 20 22 2d 6d 61 6e 75 61 :get-arg "-manua
4c50: 6c 22 29 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 l"). (let* ((
4c60: 68 74 6d 6c 76 69 65 77 65 72 63 6d 64 20 28 6f htmlviewercmd (o
4c70: 72 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 r (configf:looku
4c80: 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 p *configdat* "s
4c90: 65 74 75 70 22 20 22 68 74 6d 6c 76 69 65 77 65 etup" "htmlviewe
4ca0: 72 63 6d 64 22 29 0a 09 09 09 20 20 20 20 20 20 rcmd")....
4cb0: 28 63 6f 6d 6d 6f 6e 3a 77 68 69 63 68 20 27 28 (common:which '(
4cc0: 22 66 69 72 65 66 6f 78 22 20 22 61 72 6f 72 61 "firefox" "arora
4cd0: 22 29 29 29 29 0a 09 20 20 20 28 69 6e 73 74 61 ")))).. (insta
4ce0: 6c 6c 2d 68 6f 6d 65 20 20 28 63 6f 6d 6d 6f 6e ll-home (common
4cf0: 3a 67 65 74 2d 69 6e 73 74 61 6c 6c 2d 61 72 65 :get-install-are
4d00: 61 29 29 0a 09 20 20 20 28 6d 61 6e 75 61 6c 2d a)).. (manual-
4d10: 68 74 6d 6c 20 20 20 28 63 6f 6e 63 20 69 6e 73 html (conc ins
4d20: 74 61 6c 6c 2d 68 6f 6d 65 20 22 2f 73 68 61 72 tall-home "/shar
4d30: 65 2f 64 6f 63 73 2f 6d 65 67 61 74 65 73 74 5f e/docs/megatest_
4d40: 6d 61 6e 75 61 6c 2e 68 74 6d 6c 22 29 29 29 0a manual.html"))).
4d50: 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 69 (if (and i
4d60: 6e 73 74 61 6c 6c 2d 68 6f 6d 65 0a 09 20 20 20 nstall-home..
4d70: 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 (common:file
4d80: 2d 65 78 69 73 74 73 3f 20 6d 61 6e 75 61 6c 2d -exists? manual-
4d90: 68 74 6d 6c 29 29 0a 09 20 20 28 73 79 73 74 65 html)).. (syste
4da0: 6d 20 28 63 6f 6e 63 20 22 28 22 20 68 74 6d 6c m (conc "(" html
4db0: 76 69 65 77 65 72 63 6d 64 20 22 20 22 20 6d 61 viewercmd " " ma
4dc0: 6e 75 61 6c 2d 68 74 6d 6c 20 22 20 29 20 26 22 nual-html " ) &"
4dd0: 29 29 0a 09 20 20 28 73 79 73 74 65 6d 20 28 63 )).. (system (c
4de0: 6f 6e 63 20 22 28 22 20 68 74 6d 6c 76 69 65 77 onc "(" htmlview
4df0: 65 72 63 6d 64 20 22 20 68 74 74 70 3a 2f 2f 77 ercmd " http://w
4e00: 77 77 2e 6b 69 61 74 6f 61 2e 63 6f 6d 2f 63 67 ww.kiatoa.com/cg
4e10: 69 2d 62 69 6e 2f 66 6f 73 73 69 6c 73 2f 6d 65 i-bin/fossils/me
4e20: 67 61 74 65 73 74 2f 64 6f 63 2f 74 69 70 2f 64 gatest/doc/tip/d
4e30: 6f 63 73 2f 6d 61 6e 75 61 6c 2f 6d 65 67 61 74 ocs/manual/megat
4e40: 65 73 74 5f 6d 61 6e 75 61 6c 2e 68 74 6d 6c 20 est_manual.html
4e50: 29 20 26 22 29 29 29 0a 20 20 20 20 20 20 28 65 ) &"))). (e
4e60: 78 69 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 xit)))..(if (arg
4e70: 73 3a 67 65 74 2d 61 72 67 20 22 2d 76 65 72 73 s:get-arg "-vers
4e80: 69 6f 6e 22 29 0a 20 20 20 20 28 62 65 67 69 6e ion"). (begin
4e90: 0a 20 20 20 20 20 20 28 70 72 69 6e 74 20 28 63 . (print (c
4ea0: 6f 6d 6d 6f 6e 3a 76 65 72 73 69 6f 6e 2d 73 69 ommon:version-si
4eb0: 67 6e 61 74 75 72 65 29 29 20 3b 3b 20 28 70 72 gnature)) ;; (pr
4ec0: 69 6e 74 20 6d 65 67 61 74 65 73 74 2d 76 65 72 int megatest-ver
4ed0: 73 69 6f 6e 29 0a 20 20 20 20 20 20 28 65 78 69 sion). (exi
4ee0: 74 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 2a 64 t)))..(define *d
4ef0: 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 66 29 idsomething* #f)
4f00: 0a 0a 3b 3b 20 4f 76 65 72 61 6c 6c 20 65 78 69 ..;; Overall exi
4f10: 74 20 68 61 6e 64 6c 69 6e 67 20 73 65 74 75 70 t handling setup
4f20: 20 69 6d 6d 65 64 69 61 74 65 6c 79 0a 3b 3b 0a immediately.;;.
4f30: 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 (if (or (args:ge
4f40: 74 2d 61 72 67 20 22 2d 70 72 6f 63 65 73 73 2d t-arg "-process-
4f50: 72 65 61 70 22 29 29 0a 20 20 20 20 20 20 20 20 reap")).
4f60: 3b 3b 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 ;; (args:get-arg
4f70: 20 22 2d 72 75 6e 74 65 73 74 73 22 29 0a 09 3b "-runtests")..;
4f80: 3b 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ; (args:get-arg
4f90: 22 2d 65 78 65 63 75 74 65 22 29 0a 09 3b 3b 20 "-execute")..;;
4fa0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
4fb0: 72 65 6d 6f 76 65 2d 72 75 6e 73 22 29 0a 09 3b remove-runs")..;
4fc0: 3b 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ; (args:get-arg
4fd0: 22 2d 72 75 6e 73 74 65 70 22 29 29 0a 20 20 20 "-runstep")).
4fe0: 20 28 6c 65 74 20 28 28 6f 72 69 67 69 6e 61 6c (let ((original
4ff0: 2d 65 78 69 74 20 28 65 78 69 74 2d 68 61 6e 64 -exit (exit-hand
5000: 6c 65 72 29 29 29 0a 20 20 20 20 20 20 28 65 78 ler))). (ex
5010: 69 74 2d 68 61 6e 64 6c 65 72 20 28 6c 61 6d 62 it-handler (lamb
5020: 64 61 20 28 23 21 6f 70 74 69 6f 6e 61 6c 20 28 da (#!optional (
5030: 65 78 69 74 2d 63 6f 64 65 20 30 29 29 0a 09 09 exit-code 0))...
5040: 20 20 20 20 20 20 28 70 72 69 6e 74 66 20 22 50 (printf "P
5050: 72 65 70 61 72 69 6e 67 20 74 6f 20 65 78 69 74 reparing to exit
5060: 20 77 69 74 68 20 65 78 69 74 20 63 6f 64 65 20 with exit code
5070: 7e 41 20 2e 2e 2e 5c 6e 22 20 65 78 69 74 2d 63 ~A ...\n" exit-c
5080: 6f 64 65 29 0a 09 09 20 20 20 20 20 20 28 66 6f ode)... (fo
5090: 72 2d 65 61 63 68 0a 09 09 20 20 20 20 20 20 20 r-each...
50a0: 0a 09 09 20 20 20 20 20 20 20 28 6c 61 6d 62 64 ... (lambd
50b0: 61 20 28 70 69 64 29 0a 09 09 09 20 28 68 61 6e a (pid).... (han
50c0: 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 dle-exceptions..
50d0: 09 09 20 20 65 78 6e 0a 09 09 09 20 20 23 74 0a .. exn.... #t.
50e0: 09 09 09 20 20 28 6c 65 74 2d 76 61 6c 75 65 73 ... (let-values
50f0: 20 28 28 28 70 69 64 2d 76 61 6c 20 65 78 69 74 (((pid-val exit
5100: 2d 73 74 61 74 75 73 20 65 78 69 74 2d 63 6f 64 -status exit-cod
5110: 65 29 20 28 70 72 6f 63 65 73 73 2d 77 61 69 74 e) (process-wait
5120: 20 70 69 64 20 23 74 29 29 29 0a 09 09 09 09 20 pid #t))).....
5130: 20 20 20 20 20 28 69 66 20 28 6f 72 20 28 65 71 (if (or (eq
5140: 3f 20 70 69 64 2d 76 61 6c 20 70 69 64 29 0a 09 ? pid-val pid)..
5150: 09 09 09 09 20 20 20 20 20 20 28 65 71 3f 20 70 .... (eq? p
5160: 69 64 2d 76 61 6c 20 30 29 29 0a 09 09 09 09 09 id-val 0))......
5170: 20 20 28 62 65 67 69 6e 0a 09 09 09 09 09 20 20 (begin......
5180: 20 20 28 70 72 69 6e 74 66 20 22 53 65 6e 64 69 (printf "Sendi
5190: 6e 67 20 73 69 67 6e 61 6c 2f 74 65 72 6d 20 74 ng signal/term t
51a0: 6f 20 7e 41 5c 6e 22 20 70 69 64 29 0a 09 09 09 o ~A\n" pid)....
51b0: 09 09 20 20 20 20 28 70 72 6f 63 65 73 73 2d 73 .. (process-s
51c0: 69 67 6e 61 6c 20 70 69 64 20 73 69 67 6e 61 6c ignal pid signal
51d0: 2f 74 65 72 6d 29 29 29 29 29 29 0a 09 09 20 20 /term))))))...
51e0: 20 20 20 20 20 28 70 72 6f 63 65 73 73 3a 63 68 (process:ch
51f0: 69 6c 64 72 65 6e 20 23 66 29 29 0a 09 09 20 20 ildren #f))...
5200: 20 20 20 20 28 6f 72 69 67 69 6e 61 6c 2d 65 78 (original-ex
5210: 69 74 20 65 78 69 74 2d 63 6f 64 65 29 29 29 29 it exit-code))))
5220: 29 0a 0a 3b 3b 20 66 6f 72 20 73 6f 6d 65 20 73 )..;; for some s
5230: 77 69 74 63 68 65 73 20 61 6c 77 61 79 73 20 70 witches always p
5240: 72 69 6e 74 20 74 68 65 20 63 6f 6d 6d 61 6e 64 rint the command
5250: 20 74 6f 20 73 74 64 65 72 72 0a 3b 3b 0a 28 69 to stderr.;;.(i
5260: 66 20 28 61 72 67 73 3a 61 6e 79 3f 20 22 2d 72 f (args:any? "-r
5270: 75 6e 22 20 22 2d 72 75 6e 61 6c 6c 22 20 22 2d un" "-runall" "-
5280: 72 65 6d 6f 76 65 2d 72 75 6e 73 22 20 22 2d 73 remove-runs" "-s
5290: 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 22 et-state-status"
52a0: 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 ). (debug:pri
52b0: 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
52c0: 67 2d 70 6f 72 74 2a 20 28 73 74 72 69 6e 67 2d g-port* (string-
52d0: 69 6e 74 65 72 73 70 65 72 73 65 20 28 61 72 67 intersperse (arg
52e0: 76 29 20 22 20 22 29 29 29 0a 0a 3b 3b 20 73 6f v) " ")))..;; so
52f0: 6d 65 20 73 77 69 74 63 68 65 73 20 69 6d 70 6c me switches impl
5300: 79 20 68 6f 6d 65 68 6f 73 74 2e 20 45 78 69 74 y homehost. Exit
5310: 20 68 65 72 65 20 69 66 20 6e 6f 74 20 6f 6e 20 here if not on
5320: 68 6f 6d 65 68 6f 73 74 0a 3b 3b 0a 28 6c 65 74 homehost.;;.(let
5330: 20 28 28 68 6f 6d 65 68 6f 73 74 2d 72 65 71 75 ((homehost-requ
5340: 69 72 65 64 20 20 28 6c 69 73 74 20 22 2d 63 6c ired (list "-cl
5350: 65 61 6e 75 70 2d 64 62 22 20 22 2d 73 65 72 76 eanup-db" "-serv
5360: 65 72 22 29 29 29 0a 20 20 28 69 66 20 28 61 70 er"))). (if (ap
5370: 70 6c 79 20 61 72 67 73 3a 61 6e 79 3f 20 68 6f ply args:any? ho
5380: 6d 65 68 6f 73 74 2d 72 65 71 75 69 72 65 64 29 mehost-required)
5390: 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 . (if (not
53a0: 28 63 6f 6d 6d 6f 6e 3a 6f 6e 2d 68 6f 6d 65 68 (common:on-homeh
53b0: 6f 73 74 3f 29 29 0a 09 20 20 28 66 6f 72 2d 65 ost?)).. (for-e
53c0: 61 63 68 0a 09 20 20 20 28 6c 61 6d 62 64 61 20 ach.. (lambda
53d0: 28 73 77 69 74 63 68 29 0a 09 20 20 20 20 20 28 (switch).. (
53e0: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
53f0: 20 73 77 69 74 63 68 29 0a 09 09 20 28 62 65 67 switch)... (beg
5400: 69 6e 0a 09 09 20 20 20 28 64 65 62 75 67 3a 70 in... (debug:p
5410: 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
5420: 6c 6f 67 2d 70 6f 72 74 2a 20 22 45 52 52 4f 52 log-port* "ERROR
5430: 3a 20 79 6f 75 20 6d 75 73 74 20 62 65 20 6f 6e : you must be on
5440: 20 74 68 65 20 68 6f 6d 65 68 6f 73 74 20 74 6f the homehost to
5450: 20 72 75 6e 20 77 69 74 68 20 22 20 73 77 69 74 run with " swit
5460: 63 68 0a 09 09 09 09 22 2c 20 79 6f 75 20 63 61 ch.....", you ca
5470: 6e 20 6d 6f 76 65 20 68 6f 6d 65 68 6f 73 74 20 n move homehost
5480: 62 79 20 72 65 6d 6f 76 69 6e 67 20 74 68 65 20 by removing the
5490: 2e 68 6f 6d 65 68 6f 73 74 20 66 69 6c 65 20 62 .homehost file b
54a0: 75 74 20 74 68 69 73 20 77 69 6c 6c 20 64 69 73 ut this will dis
54b0: 72 75 70 74 20 61 6e 79 20 72 75 6e 73 20 69 6e rupt any runs in
54c0: 20 70 72 6f 67 72 65 73 73 2e 22 29 0a 09 09 20 progress.")...
54d0: 20 20 28 65 78 69 74 20 31 29 29 29 29 0a 09 20 (exit 1))))..
54e0: 20 20 68 6f 6d 65 68 6f 73 74 2d 72 65 71 75 69 homehost-requi
54f0: 72 65 64 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d red))))..;;=====
5500: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5510: 3d 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 0a 3b 3b 20 4d 69 73 63 20 73 65 74 75 70 20 =.;; Misc setup
5550: 73 74 75 66 66 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d stuff.;;========
5560: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 0a ==============..
55a0: 28 64 65 62 75 67 3a 73 65 74 75 70 29 0a 0a 28 (debug:setup)..(
55b0: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
55c0: 20 22 2d 6c 6f 67 67 69 6e 67 22 29 28 73 65 74 "-logging")(set
55d0: 21 20 2a 6c 6f 67 67 69 6e 67 2a 20 23 74 29 29 ! *logging* #t))
55e0: 0a 0a 28 69 66 20 28 64 65 62 75 67 3a 64 65 62 ..(if (debug:deb
55f0: 75 67 2d 6d 6f 64 65 20 33 29 20 3b 3b 20 77 65 ug-mode 3) ;; we
5600: 20 61 72 65 20 6f 62 76 69 6f 75 73 6c 79 20 64 are obviously d
5610: 65 62 75 67 67 69 6e 67 0a 20 20 20 20 28 73 65 ebugging. (se
5620: 74 21 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 t! open-run-clos
5630: 65 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 e open-run-close
5640: 2d 6e 6f 2d 65 78 63 65 70 74 69 6f 6e 2d 68 61 -no-exception-ha
5650: 6e 64 6c 69 6e 67 29 29 0a 0a 28 69 66 20 28 61 ndling))..(if (a
5660: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 69 74 rgs:get-arg "-it
5670: 65 6d 70 61 74 74 22 29 0a 20 20 20 20 28 6c 65 empatt"). (le
5680: 74 20 28 28 6e 65 77 76 61 6c 20 28 63 6f 6e 63 t ((newval (conc
5690: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
56a0: 2d 74 65 73 74 70 61 74 74 22 29 20 22 2f 22 20 -testpatt") "/"
56b0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
56c0: 69 74 65 6d 70 61 74 74 22 29 29 29 29 0a 20 20 itempatt")))).
56d0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
56e0: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
56f0: 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 port* "WARNING:
5700: 2d 69 74 65 6d 70 61 74 74 20 68 61 73 20 62 65 -itempatt has be
5710: 65 6e 20 64 65 70 72 65 63 61 74 65 64 2c 20 70 en deprecated, p
5720: 6c 65 61 73 65 20 75 73 65 20 2d 74 65 73 74 70 lease use -testp
5730: 61 74 74 20 74 65 73 74 70 61 74 74 2f 69 74 65 att testpatt/ite
5740: 6d 70 61 74 74 20 6d 65 74 68 6f 64 2c 20 6e 65 mpatt method, ne
5750: 77 20 74 65 73 74 70 61 74 74 20 69 73 20 22 6e w testpatt is "n
5760: 65 77 76 61 6c 29 0a 20 20 20 20 20 20 28 68 61 ewval). (ha
5770: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 61 72 sh-table-set! ar
5780: 67 73 3a 61 72 67 2d 68 61 73 68 20 22 2d 74 65 gs:arg-hash "-te
5790: 73 74 70 61 74 74 22 20 6e 65 77 76 61 6c 29 0a stpatt" newval).
57a0: 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c (hash-tabl
57b0: 65 2d 64 65 6c 65 74 65 21 20 61 72 67 73 3a 61 e-delete! args:a
57c0: 72 67 2d 68 61 73 68 20 22 2d 69 74 65 6d 70 61 rg-hash "-itempa
57d0: 74 74 22 29 29 29 0a 0a 28 69 66 20 28 61 72 67 tt")))..(if (arg
57e0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 s:get-arg "-runt
57f0: 65 73 74 73 22 29 0a 20 20 20 20 28 64 65 62 75 ests"). (debu
5800: 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 g:print 0 *defau
5810: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 lt-log-port* "WA
5820: 52 4e 49 4e 47 3a 20 5c 22 2d 72 75 6e 74 65 73 RNING: \"-runtes
5830: 74 73 5c 22 20 69 73 20 64 65 70 72 65 63 61 74 ts\" is deprecat
5840: 65 64 2e 20 55 73 65 20 5c 22 2d 72 75 6e 5c 22 ed. Use \"-run\"
5850: 20 77 69 74 68 20 5c 22 2d 74 65 73 74 70 61 74 with \"-testpat
5860: 74 5c 22 20 69 6e 73 74 65 61 64 22 29 29 0a 0a t\" instead"))..
5870: 28 6f 6e 2d 65 78 69 74 20 73 74 64 2d 65 78 69 (on-exit std-exi
5880: 74 2d 70 72 6f 63 65 64 75 72 65 29 0a 0a 3b 3b t-procedure)..;;
5890: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
58a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
58b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
58c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
58d0: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4d 69 73 63 20 67 ======.;; Misc g
58e0: 65 6e 65 72 61 6c 20 63 61 6c 6c 73 0a 3b 3b 3d eneral calls.;;=
58f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 0a 28 69 66 20 28 61 6e 64 20 =====..(if (and
5940: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
5950: 63 61 63 68 65 2d 64 62 22 29 0a 20 20 20 20 20 cache-db").
5960: 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
5970: 67 20 22 2d 73 6f 75 72 63 65 2d 64 62 22 29 29 g "-source-db"))
5980: 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 74 65 6d . (let* ((tem
5990: 70 2d 64 69 72 20 28 6f 72 20 28 61 72 67 73 3a p-dir (or (args:
59a0: 67 65 74 2d 61 72 67 20 22 2d 74 61 72 67 65 74 get-arg "-target
59b0: 2d 64 62 22 29 20 28 63 72 65 61 74 65 2d 64 69 -db") (create-di
59c0: 72 65 63 74 6f 72 79 20 28 63 6f 6e 63 20 22 2f rectory (conc "/
59d0: 74 6d 70 2f 22 20 28 67 65 74 65 6e 76 20 22 55 tmp/" (getenv "U
59e0: 53 45 52 22 29 20 22 2f 22 20 28 73 74 72 69 6e SER") "/" (strin
59f0: 67 2d 74 72 61 6e 73 6c 61 74 65 20 28 63 75 72 g-translate (cur
5a00: 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 20 rent-directory)
5a10: 22 2f 22 20 22 5f 22 29 29 29 29 29 0a 20 20 20 "/" "_"))))).
5a20: 20 20 20 20 20 20 20 20 28 74 61 72 67 65 74 2d (target-
5a30: 64 62 20 28 63 6f 6e 63 20 74 65 6d 70 2d 64 69 db (conc temp-di
5a40: 72 20 22 2f 63 61 63 68 65 64 2e 64 62 22 29 29 r "/cached.db"))
5a50: 0a 20 20 20 20 20 20 20 20 20 20 20 28 73 6f 75 . (sou
5a60: 72 63 65 2d 64 62 20 28 61 72 67 73 3a 67 65 74 rce-db (args:get
5a70: 2d 61 72 67 20 22 2d 73 6f 75 72 63 65 2d 64 62 -arg "-source-db
5a80: 22 29 29 29 20 20 20 20 20 20 20 20 0a 20 20 20 "))) .
5a90: 20 20 20 28 64 62 3a 63 61 63 68 65 2d 66 6f 72 (db:cache-for
5aa0: 2d 72 65 61 64 2d 6f 6e 6c 79 20 73 6f 75 72 63 -read-only sourc
5ab0: 65 2d 64 62 20 74 61 72 67 65 74 2d 64 62 29 0a e-db target-db).
5ac0: 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 (set! *did
5ad0: 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 something* #t)))
5ae0: 0a 0a 3b 3b 20 68 61 6e 64 6c 65 20 61 20 63 6c ..;; handle a cl
5af0: 65 61 6e 2d 63 61 63 68 65 20 72 65 71 75 65 73 ean-cache reques
5b00: 74 20 61 73 20 65 61 72 6c 79 20 61 73 20 70 6f t as early as po
5b10: 73 73 69 62 6c 65 0a 3b 3b 0a 28 69 66 20 28 61 ssible.;;.(if (a
5b20: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 6c rgs:get-arg "-cl
5b30: 65 61 6e 2d 63 61 63 68 65 22 29 0a 20 20 20 20 ean-cache").
5b40: 28 6c 65 74 20 28 28 74 6f 70 70 61 74 68 20 20 (let ((toppath
5b50: 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 29 (launch:setup)))
5b60: 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 . (set! *di
5b70: 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 20 dsomething* #t)
5b80: 3b 3b 20 73 75 70 70 72 65 73 73 20 74 68 65 20 ;; suppress the
5b90: 68 65 6c 70 20 6f 75 74 70 75 74 2e 0a 20 20 20 help output..
5ba0: 20 20 20 28 72 75 6e 73 3a 63 6c 65 61 6e 2d 63 (runs:clean-c
5bb0: 61 63 68 65 20 28 6f 72 20 28 67 65 74 65 6e 76 ache (or (getenv
5bc0: 20 22 4d 54 5f 54 41 52 47 45 54 22 29 0a 09 09 "MT_TARGET")...
5bd0: 09 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 . (args:get-a
5be0: 72 67 20 22 2d 74 61 72 67 65 74 22 29 0a 09 09 rg "-target")...
5bf0: 09 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 . (args:get-a
5c00: 72 67 20 22 2d 72 65 6d 74 61 72 67 22 29 29 0a rg "-remtarg")).
5c10: 09 09 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 ...(args:get-arg
5c20: 20 22 2d 72 75 6e 6e 61 6d 65 22 29 0a 09 09 09 "-runname")....
5c30: 74 6f 70 70 61 74 68 29 29 29 0a 09 20 20 0a 28 toppath))).. .(
5c40: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
5c50: 20 22 2d 65 6e 76 32 66 69 6c 65 22 29 0a 20 20 "-env2file").
5c60: 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 (begin. (
5c70: 73 61 76 65 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 save-environment
5c80: 2d 61 73 2d 66 69 6c 65 73 20 28 61 72 67 73 3a -as-files (args:
5c90: 67 65 74 2d 61 72 67 20 22 2d 65 6e 76 32 66 69 get-arg "-env2fi
5ca0: 6c 65 22 29 29 0a 20 20 20 20 20 20 28 73 65 74 le")). (set
5cb0: 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
5cc0: 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 #t)))..(if (arg
5cd0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 s:get-arg "-list
5ce0: 2d 64 69 73 6b 73 22 29 0a 20 20 20 20 28 6c 65 -disks"). (le
5cf0: 74 20 28 28 74 6f 70 70 61 74 68 20 28 6c 61 75 t ((toppath (lau
5d00: 6e 63 68 3a 73 65 74 75 70 29 29 29 0a 20 20 20 nch:setup))).
5d10: 20 20 20 28 70 72 69 6e 74 20 0a 20 20 20 20 20 (print .
5d20: 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 (string-inters
5d30: 70 65 72 73 65 20 0a 09 28 6d 61 70 20 28 6c 61 perse ..(map (la
5d40: 6d 62 64 61 20 28 78 29 0a 09 20 20 20 20 20 20 mbda (x)..
5d50: 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
5d60: 65 72 73 65 20 0a 09 09 78 0a 09 09 22 20 3d 3e erse ...x..." =>
5d70: 20 22 29 29 0a 09 20 20 20 20 20 28 63 6f 6d 6d ")).. (comm
5d80: 6f 6e 3a 67 65 74 2d 64 69 73 6b 73 20 2a 63 6f on:get-disks *co
5d90: 6e 66 69 67 64 61 74 2a 29 29 0a 09 22 5c 6e 22 nfigdat*)).."\n"
5da0: 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a )). (set! *
5db0: 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
5dc0: 29 29 29 0a 0a 3b 3b 20 63 73 76 20 70 72 6f 63 )))..;; csv proc
5dd0: 65 73 73 69 6e 67 20 72 65 63 6f 72 64 0a 28 64 essing record.(d
5de0: 65 66 69 6e 65 20 28 6d 61 6b 65 2d 72 65 66 64 efine (make-refd
5df0: 62 3a 63 73 76 29 0a 20 20 28 76 65 63 74 6f 72 b:csv). (vector
5e00: 20 0a 20 20 20 28 6d 61 6b 65 2d 73 70 61 72 73 . (make-spars
5e10: 65 2d 61 72 72 61 79 29 0a 20 20 20 28 6d 61 6b e-array). (mak
5e20: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 0a 20 20 e-hash-table).
5e30: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
5e40: 65 29 0a 20 20 20 30 0a 20 20 20 30 29 29 0a 28 e). 0. 0)).(
5e50: 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 72 define-inline (r
5e60: 65 66 64 62 3a 63 73 76 2d 67 65 74 2d 73 76 65 efdb:csv-get-sve
5e70: 63 20 20 20 20 20 76 65 63 29 20 20 20 20 28 76 c vec) (v
5e80: 65 63 74 6f 72 2d 72 65 66 20 20 76 65 63 20 30 ector-ref vec 0
5e90: 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e )).(define-inlin
5ea0: 65 20 28 72 65 66 64 62 3a 63 73 76 2d 67 65 74 e (refdb:csv-get
5eb0: 2d 72 6f 77 73 20 20 20 20 20 76 65 63 29 20 20 -rows vec)
5ec0: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 20 76 (vector-ref v
5ed0: 65 63 20 31 29 29 0a 28 64 65 66 69 6e 65 2d 69 ec 1)).(define-i
5ee0: 6e 6c 69 6e 65 20 28 72 65 66 64 62 3a 63 73 76 nline (refdb:csv
5ef0: 2d 67 65 74 2d 63 6f 6c 73 20 20 20 20 20 76 65 -get-cols ve
5f00: 63 29 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 c) (vector-re
5f10: 66 20 20 76 65 63 20 32 29 29 0a 28 64 65 66 69 f vec 2)).(defi
5f20: 6e 65 2d 69 6e 6c 69 6e 65 20 28 72 65 66 64 62 ne-inline (refdb
5f30: 3a 63 73 76 2d 67 65 74 2d 6d 61 78 72 6f 77 20 :csv-get-maxrow
5f40: 20 20 76 65 63 29 20 20 20 20 28 76 65 63 74 6f vec) (vecto
5f50: 72 2d 72 65 66 20 20 76 65 63 20 33 29 29 0a 28 r-ref vec 3)).(
5f60: 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 72 define-inline (r
5f70: 65 66 64 62 3a 63 73 76 2d 67 65 74 2d 6d 61 78 efdb:csv-get-max
5f80: 63 6f 6c 20 20 20 76 65 63 29 20 20 20 20 28 76 col vec) (v
5f90: 65 63 74 6f 72 2d 72 65 66 20 20 76 65 63 20 34 ector-ref vec 4
5fa0: 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e )).(define-inlin
5fb0: 65 20 28 72 65 66 64 62 3a 63 73 76 2d 73 65 74 e (refdb:csv-set
5fc0: 2d 73 76 65 63 21 20 20 20 20 76 65 63 20 76 61 -svec! vec va
5fd0: 6c 29 28 76 65 63 74 6f 72 2d 73 65 74 21 20 76 l)(vector-set! v
5fe0: 65 63 20 30 20 76 61 6c 29 29 0a 28 64 65 66 69 ec 0 val)).(defi
5ff0: 6e 65 2d 69 6e 6c 69 6e 65 20 28 72 65 66 64 62 ne-inline (refdb
6000: 3a 63 73 76 2d 73 65 74 2d 72 6f 77 73 21 20 20 :csv-set-rows!
6010: 20 20 76 65 63 20 76 61 6c 29 28 76 65 63 74 6f vec val)(vecto
6020: 72 2d 73 65 74 21 20 76 65 63 20 31 20 76 61 6c r-set! vec 1 val
6030: 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e )).(define-inlin
6040: 65 20 28 72 65 66 64 62 3a 63 73 76 2d 73 65 74 e (refdb:csv-set
6050: 2d 63 6f 6c 73 21 20 20 20 20 76 65 63 20 76 61 -cols! vec va
6060: 6c 29 28 76 65 63 74 6f 72 2d 73 65 74 21 20 76 l)(vector-set! v
6070: 65 63 20 32 20 76 61 6c 29 29 0a 28 64 65 66 69 ec 2 val)).(defi
6080: 6e 65 2d 69 6e 6c 69 6e 65 20 28 72 65 66 64 62 ne-inline (refdb
6090: 3a 63 73 76 2d 73 65 74 2d 6d 61 78 72 6f 77 21 :csv-set-maxrow!
60a0: 20 20 76 65 63 20 76 61 6c 29 28 76 65 63 74 6f vec val)(vecto
60b0: 72 2d 73 65 74 21 20 76 65 63 20 33 20 76 61 6c r-set! vec 3 val
60c0: 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e )).(define-inlin
60d0: 65 20 28 72 65 66 64 62 3a 63 73 76 2d 73 65 74 e (refdb:csv-set
60e0: 2d 6d 61 78 63 6f 6c 21 20 20 76 65 63 20 76 61 -maxcol! vec va
60f0: 6c 29 28 76 65 63 74 6f 72 2d 73 65 74 21 20 76 l)(vector-set! v
6100: 65 63 20 34 20 76 61 6c 29 29 0a 0a 28 64 65 66 ec 4 val))..(def
6110: 69 6e 65 20 28 67 65 74 2d 64 61 74 20 72 65 73 ine (get-dat res
6120: 75 6c 74 73 20 73 68 65 65 74 6e 61 6d 65 29 0a ults sheetname).
6130: 20 20 28 6f 72 20 28 68 61 73 68 2d 74 61 62 6c (or (hash-tabl
6140: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 72 65 e-ref/default re
6150: 73 75 6c 74 73 20 73 68 65 65 74 6e 61 6d 65 20 sults sheetname
6160: 23 66 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28 #f). (let (
6170: 28 74 6d 70 2d 76 65 63 20 20 28 6d 61 6b 65 2d (tmp-vec (make-
6180: 72 65 66 64 62 3a 63 73 76 29 29 29 0a 09 28 68 refdb:csv)))..(h
6190: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 ash-table-set! r
61a0: 65 73 75 6c 74 73 20 73 68 65 65 74 6e 61 6d 65 esults sheetname
61b0: 20 74 6d 70 2d 76 65 63 29 0a 09 74 6d 70 2d 76 tmp-vec)..tmp-v
61c0: 65 63 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 ec)))..(if (args
61d0: 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 66 64 62 :get-arg "-refdb
61e0: 32 64 61 74 22 29 0a 20 20 20 20 28 6c 65 74 2a 2dat"). (let*
61f0: 20 28 28 69 6e 70 75 74 2d 64 62 20 28 61 72 67 ((input-db (arg
6200: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 66 64 s:get-arg "-refd
6210: 62 32 64 61 74 22 29 29 0a 09 20 20 20 28 6f 75 b2dat")).. (ou
6220: 74 2d 66 69 6c 65 20 28 61 72 67 73 3a 67 65 74 t-file (args:get
6230: 2d 61 72 67 20 22 2d 6f 22 29 29 0a 09 20 20 20 -arg "-o"))..
6240: 28 6f 75 74 2d 66 6d 74 20 20 28 6f 72 20 28 61 (out-fmt (or (a
6250: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 rgs:get-arg "-du
6260: 6d 70 6d 6f 64 65 22 29 20 22 73 63 68 65 6d 65 mpmode") "scheme
6270: 22 29 29 0a 09 20 20 20 28 6f 75 74 2d 70 6f 72 ")).. (out-por
6280: 74 20 28 69 66 20 28 61 6e 64 20 6f 75 74 2d 66 t (if (and out-f
6290: 69 6c 65 20 0a 09 09 09 20 20 20 20 20 20 28 6e ile .... (n
62a0: 6f 74 20 28 6d 65 6d 62 65 72 20 6f 75 74 2d 66 ot (member out-f
62b0: 6d 74 20 27 28 22 73 71 6c 69 74 65 33 22 20 22 mt '("sqlite3" "
62c0: 63 73 76 22 29 29 29 29 0a 09 09 09 20 28 6f 70 csv")))).... (op
62d0: 65 6e 2d 6f 75 74 70 75 74 2d 66 69 6c 65 20 6f en-output-file o
62e0: 75 74 2d 66 69 6c 65 29 0a 09 09 09 20 28 63 75 ut-file).... (cu
62f0: 72 72 65 6e 74 2d 6f 75 74 70 75 74 2d 70 6f 72 rrent-output-por
6300: 74 29 29 29 0a 09 20 20 20 28 72 65 73 2d 64 61 t))).. (res-da
6310: 74 61 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 ta (configf:read
6320: 2d 72 65 66 64 62 20 69 6e 70 75 74 2d 64 62 29 -refdb input-db)
6330: 29 0a 09 20 20 20 28 64 61 74 61 20 20 20 20 20 ).. (data
6340: 28 63 61 72 20 72 65 73 2d 64 61 74 61 29 29 0a (car res-data)).
6350: 09 20 20 20 28 6d 73 67 20 20 20 20 20 20 28 63 . (msg (c
6360: 61 64 72 20 72 65 73 2d 64 61 74 61 29 29 29 0a adr res-data))).
6370: 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 64 (if (not d
6380: 61 74 61 29 0a 09 20 20 28 64 65 62 75 67 3a 70 ata).. (debug:p
6390: 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
63a0: 6c 6f 67 2d 70 6f 72 74 2a 20 22 42 61 64 20 69 log-port* "Bad i
63b0: 6e 70 75 74 3f 20 64 61 74 61 3d 22 20 64 61 74 nput? data=" dat
63c0: 61 29 20 3b 3b 20 73 6f 6d 65 20 65 72 72 6f 72 a) ;; some error
63d0: 20 6f 63 63 75 72 72 65 64 0a 09 20 20 28 77 69 occurred.. (wi
63e0: 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 70 6f 72 th-output-to-por
63f0: 74 20 6f 75 74 2d 70 6f 72 74 0a 09 20 20 20 20 t out-port..
6400: 28 6c 61 6d 62 64 61 20 28 29 0a 09 20 20 20 20 (lambda ()..
6410: 20 20 28 63 61 73 65 20 28 73 74 72 69 6e 67 2d (case (string-
6420: 3e 73 79 6d 62 6f 6c 20 6f 75 74 2d 66 6d 74 29 >symbol out-fmt)
6430: 0a 09 09 28 28 73 63 68 65 6d 65 29 28 70 70 20 ...((scheme)(pp
6440: 64 61 74 61 29 29 0a 09 09 28 28 70 65 72 6c 29 data))...((perl)
6450: 0a 09 09 20 3b 3b 20 28 70 72 69 6e 74 20 22 25 ... ;; (print "%
6460: 68 61 73 68 20 3d 20 28 22 29 0a 09 09 20 3b 3b hash = (")... ;;
6470: 20 20 20 20 20 20 20 20 6b 65 79 31 20 3d 3e 20 key1 =>
6480: 27 76 61 6c 75 65 31 27 2c 0a 09 09 20 3b 3b 20 'value1',... ;;
6490: 20 20 20 20 20 20 20 6b 65 79 32 20 3d 3e 20 27 key2 => '
64a0: 76 61 6c 75 65 32 27 2c 0a 09 09 20 3b 3b 20 20 value2',... ;;
64b0: 20 20 20 20 20 20 6b 65 79 33 20 3d 3e 20 27 76 key3 => 'v
64c0: 61 6c 75 65 33 27 2c 0a 09 09 20 3b 3b 20 29 3b alue3',... ;; );
64d0: 0a 09 09 20 28 63 6f 6e 66 69 67 66 3a 6d 61 70 ... (configf:map
64e0: 2d 61 6c 6c 2d 68 69 65 72 2d 61 6c 69 73 74 20 -all-hier-alist
64f0: 0a 09 09 20 20 64 61 74 61 20 0a 09 09 20 20 28 ... data ... (
6500: 6c 61 6d 62 64 61 20 28 73 68 65 65 74 6e 61 6d lambda (sheetnam
6510: 65 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 76 61 e sectionname va
6520: 72 6e 61 6d 65 20 76 61 6c 29 0a 09 09 20 20 20 rname val)...
6530: 20 28 70 72 69 6e 74 20 22 24 64 61 74 61 7b 5c (print "$data{\
6540: 22 22 20 73 68 65 65 74 6e 61 6d 65 20 22 5c 22 "" sheetname "\"
6550: 7d 7b 5c 22 22 20 73 65 63 74 69 6f 6e 6e 61 6d }{\"" sectionnam
6560: 65 20 22 5c 22 7d 7b 5c 22 22 20 76 61 72 6e 61 e "\"}{\"" varna
6570: 6d 65 20 22 5c 22 7d 20 3d 20 5c 22 22 20 76 61 me "\"} = \"" va
6580: 6c 20 22 5c 22 3b 22 29 29 29 29 0a 09 09 28 28 l "\";"))))...((
6590: 70 79 74 68 6f 6e 20 72 75 62 79 29 0a 09 09 20 python ruby)...
65a0: 28 70 72 69 6e 74 20 22 64 61 74 61 3d 7b 7d 22 (print "data={}"
65b0: 29 0a 09 09 20 28 63 6f 6e 66 69 67 66 3a 6d 61 )... (configf:ma
65c0: 70 2d 61 6c 6c 2d 68 69 65 72 2d 61 6c 69 73 74 p-all-hier-alist
65d0: 0a 09 09 20 20 64 61 74 61 0a 09 09 20 20 28 6c ... data... (l
65e0: 61 6d 62 64 61 20 28 73 68 65 65 74 6e 61 6d 65 ambda (sheetname
65f0: 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 76 61 72 sectionname var
6600: 6e 61 6d 65 20 76 61 6c 29 0a 09 09 20 20 20 20 name val)...
6610: 28 70 72 69 6e 74 20 22 64 61 74 61 5b 5c 22 22 (print "data[\""
6620: 20 73 68 65 65 74 6e 61 6d 65 20 22 5c 22 5d 5b sheetname "\"][
6630: 5c 22 22 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 \"" sectionname
6640: 22 5c 22 5d 5b 5c 22 22 20 76 61 72 6e 61 6d 65 "\"][\"" varname
6650: 20 22 5c 22 5d 20 3d 20 5c 22 22 20 76 61 6c 20 "\"] = \"" val
6660: 22 5c 22 22 29 29 0a 09 09 20 20 69 6e 69 74 70 "\""))... initp
6670: 72 6f 63 31 3a 0a 09 09 20 20 28 6c 61 6d 62 64 roc1:... (lambd
6680: 61 20 28 73 68 65 65 74 6e 61 6d 65 29 0a 09 09 a (sheetname)...
6690: 20 20 20 20 28 70 72 69 6e 74 20 22 64 61 74 61 (print "data
66a0: 5b 5c 22 22 20 73 68 65 65 74 6e 61 6d 65 20 22 [\"" sheetname "
66b0: 5c 22 5d 20 3d 20 7b 7d 22 29 29 0a 09 09 20 20 \"] = {}"))...
66c0: 69 6e 69 74 70 72 6f 63 32 3a 0a 09 09 20 20 28 initproc2:... (
66d0: 6c 61 6d 62 64 61 20 28 73 68 65 65 74 6e 61 6d lambda (sheetnam
66e0: 65 20 73 65 63 74 69 6f 6e 6e 61 6d 65 29 0a 09 e sectionname)..
66f0: 09 20 20 20 20 28 70 72 69 6e 74 20 22 64 61 74 . (print "dat
6700: 61 5b 5c 22 22 20 73 68 65 65 74 6e 61 6d 65 20 a[\"" sheetname
6710: 22 5c 22 5d 5b 5c 22 22 20 73 65 63 74 69 6f 6e "\"][\"" section
6720: 6e 61 6d 65 20 22 5c 22 5d 20 3d 20 7b 7d 22 29 name "\"] = {}")
6730: 29 29 29 0a 09 09 28 28 63 73 76 29 0a 09 09 20 )))...((csv)...
6740: 28 6c 65 74 2a 20 28 28 72 65 73 75 6c 74 73 20 (let* ((results
6750: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
6760: 65 29 29 20 3b 3b 20 28 6d 61 6b 65 2d 73 70 61 e)) ;; (make-spa
6770: 72 73 65 2d 61 72 72 61 79 29 29 29 0a 09 09 09 rse-array)))....
6780: 28 72 6f 77 2d 63 6f 6c 73 20 28 6d 61 6b 65 2d (row-cols (make-
6790: 68 61 73 68 2d 74 61 62 6c 65 29 29 29 20 3b 3b hash-table))) ;;
67a0: 20 68 61 73 68 20 6f 66 20 68 61 73 68 65 73 20 hash of hashes
67b0: 77 68 65 72 65 20 73 65 63 74 69 6f 6e 20 3d 3e where section =>
67c0: 20 68 74 20 7b 20 72 6f 77 2d 3c 6e 61 6d 65 3e ht { row-<name>
67d0: 20 3d 3e 20 6e 75 6d 20 6f 72 20 63 6f 6c 2d 3c => num or col-<
67e0: 6e 61 6d 65 3e 20 3d 3e 20 6e 75 6d 0a 09 09 20 name> => num...
67f0: 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 64 61 74 ;; (print "dat
6800: 61 3d 22 29 0a 09 09 20 20 20 3b 3b 20 28 70 70 a=")... ;; (pp
6810: 20 64 61 74 61 29 0a 09 09 20 20 20 28 63 6f 6e data)... (con
6820: 66 69 67 66 3a 6d 61 70 2d 61 6c 6c 2d 68 69 65 figf:map-all-hie
6830: 72 2d 61 6c 69 73 74 0a 09 09 20 20 20 20 64 61 r-alist... da
6840: 74 61 0a 09 09 20 20 20 20 28 6c 61 6d 62 64 61 ta... (lambda
6850: 20 28 73 68 65 65 74 6e 61 6d 65 20 73 65 63 74 (sheetname sect
6860: 69 6f 6e 6e 61 6d 65 20 76 61 72 6e 61 6d 65 20 ionname varname
6870: 76 61 6c 29 0a 09 09 20 20 20 20 20 20 3b 3b 20 val)... ;;
6880: 28 70 72 69 6e 74 20 22 73 68 65 65 74 6e 61 6d (print "sheetnam
6890: 65 3a 20 22 20 73 68 65 65 74 6e 61 6d 65 20 22 e: " sheetname "
68a0: 2c 20 73 65 63 74 69 6f 6e 6e 61 6d 65 3a 20 22 , sectionname: "
68b0: 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 22 2c 20 sectionname ",
68c0: 76 61 72 6e 61 6d 65 3a 20 22 20 76 61 72 6e 61 varname: " varna
68d0: 6d 65 20 22 2c 20 76 61 6c 3a 20 22 20 76 61 6c me ", val: " val
68e0: 29 0a 09 09 20 20 20 20 20 20 28 6c 65 74 2a 20 )... (let*
68f0: 28 28 64 61 74 20 20 20 20 20 20 28 67 65 74 2d ((dat (get-
6900: 64 61 74 20 72 65 73 75 6c 74 73 20 73 68 65 65 dat results shee
6910: 74 6e 61 6d 65 29 29 0a 09 09 09 20 20 20 20 20 tname))....
6920: 28 76 65 63 20 20 20 20 20 20 28 72 65 66 64 62 (vec (refdb
6930: 3a 63 73 76 2d 67 65 74 2d 73 76 65 63 20 64 61 :csv-get-svec da
6940: 74 29 29 0a 09 09 09 20 20 20 20 20 28 72 6f 77 t)).... (row
6950: 6e 61 6d 65 73 20 28 72 65 66 64 62 3a 63 73 76 names (refdb:csv
6960: 2d 67 65 74 2d 72 6f 77 73 20 64 61 74 29 29 0a -get-rows dat)).
6970: 09 09 09 20 20 20 20 20 28 63 6f 6c 6e 61 6d 65 ... (colname
6980: 73 20 28 72 65 66 64 62 3a 63 73 76 2d 67 65 74 s (refdb:csv-get
6990: 2d 63 6f 6c 73 20 64 61 74 29 29 0a 09 09 09 20 -cols dat))....
69a0: 20 20 20 20 28 63 75 72 72 72 6f 77 6e 20 28 68 (currrown (h
69b0: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
69c0: 66 61 75 6c 74 20 72 6f 77 6e 61 6d 65 73 20 76 fault rownames v
69d0: 61 72 6e 61 6d 65 20 23 66 29 29 0a 09 09 09 20 arname #f))....
69e0: 20 20 20 20 28 63 75 72 72 63 6f 6c 6e 20 28 68 (currcoln (h
69f0: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
6a00: 66 61 75 6c 74 20 63 6f 6c 6e 61 6d 65 73 20 73 fault colnames s
6a10: 65 63 74 69 6f 6e 6e 61 6d 65 20 23 66 29 29 0a ectionname #f)).
6a20: 09 09 09 20 20 20 20 20 28 72 6f 77 6e 20 20 20 ... (rown
6a30: 20 20 28 6f 72 20 63 75 72 72 72 6f 77 6e 20 0a (or currrown .
6a40: 09 09 09 09 09 20 20 20 28 6c 65 74 2a 20 28 28 ..... (let* ((
6a50: 6c 61 73 74 6e 20 20 20 28 72 65 66 64 62 3a 63 lastn (refdb:c
6a60: 73 76 2d 67 65 74 2d 6d 61 78 72 6f 77 20 64 61 sv-get-maxrow da
6a70: 74 29 29 0a 09 09 09 09 09 09 20 20 28 6e 65 77 t))....... (new
6a80: 72 6f 77 6e 20 28 2b 20 6c 61 73 74 6e 20 31 29 rown (+ lastn 1)
6a90: 29 29 0a 09 09 09 09 09 20 20 20 20 20 28 72 65 ))...... (re
6aa0: 66 64 62 3a 63 73 76 2d 73 65 74 2d 6d 61 78 72 fdb:csv-set-maxr
6ab0: 6f 77 21 20 64 61 74 20 6e 65 77 72 6f 77 6e 29 ow! dat newrown)
6ac0: 0a 09 09 09 09 09 20 20 20 20 20 6e 65 77 72 6f ...... newro
6ad0: 77 6e 29 29 29 0a 09 09 09 20 20 20 20 20 28 63 wn))).... (c
6ae0: 6f 6c 6e 20 20 20 20 20 28 6f 72 20 63 75 72 72 oln (or curr
6af0: 63 6f 6c 6e 20 0a 09 09 09 09 09 20 20 20 28 6c coln ...... (l
6b00: 65 74 2a 20 28 28 6c 61 73 74 6e 20 20 20 28 72 et* ((lastn (r
6b10: 65 66 64 62 3a 63 73 76 2d 67 65 74 2d 6d 61 78 efdb:csv-get-max
6b20: 63 6f 6c 20 64 61 74 29 29 0a 09 09 09 09 09 09 col dat)).......
6b30: 20 20 28 6e 65 77 63 6f 6c 6e 20 28 2b 20 6c 61 (newcoln (+ la
6b40: 73 74 6e 20 31 29 29 29 0a 09 09 09 09 09 20 20 stn 1)))......
6b50: 20 20 20 28 72 65 66 64 62 3a 63 73 76 2d 73 65 (refdb:csv-se
6b60: 74 2d 6d 61 78 63 6f 6c 21 20 64 61 74 20 6e 65 t-maxcol! dat ne
6b70: 77 63 6f 6c 6e 29 0a 09 09 09 09 09 20 20 20 20 wcoln)......
6b80: 20 6e 65 77 63 6f 6c 6e 29 29 29 29 0a 09 09 09 newcoln))))....
6b90: 28 69 66 20 28 6e 6f 74 20 28 73 70 61 72 73 65 (if (not (sparse
6ba0: 2d 61 72 72 61 79 2d 72 65 66 20 76 65 63 20 30 -array-ref vec 0
6bb0: 20 63 6f 6c 6e 29 29 20 3b 3b 20 28 65 71 3f 20 coln)) ;; (eq?
6bc0: 72 6f 77 6e 20 30 29 0a 09 09 09 20 20 20 20 28 rown 0).... (
6bd0: 62 65 67 69 6e 0a 09 09 09 20 20 20 20 20 20 28 begin.... (
6be0: 73 70 61 72 73 65 2d 61 72 72 61 79 2d 73 65 74 sparse-array-set
6bf0: 21 20 76 65 63 20 30 20 63 6f 6c 6e 20 73 65 63 ! vec 0 coln sec
6c00: 74 69 6f 6e 6e 61 6d 65 29 0a 09 09 09 20 20 20 tionname)....
6c10: 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 73 70 ;; (print "sp
6c20: 61 72 73 65 2d 61 72 72 61 79 2d 72 65 66 20 22 arse-array-ref "
6c30: 20 30 20 22 2c 22 20 63 6f 6c 6e 20 22 3d 22 20 0 "," coln "="
6c40: 28 73 70 61 72 73 65 2d 61 72 72 61 79 2d 72 65 (sparse-array-re
6c50: 66 20 76 65 63 20 30 20 63 6f 6c 6e 29 29 0a 09 f vec 0 coln))..
6c60: 09 09 20 20 20 20 20 20 29 29 0a 09 09 09 28 69 .. ))....(i
6c70: 66 20 28 6e 6f 74 20 28 73 70 61 72 73 65 2d 61 f (not (sparse-a
6c80: 72 72 61 79 2d 72 65 66 20 76 65 63 20 72 6f 77 rray-ref vec row
6c90: 6e 20 30 29 29 20 3b 3b 20 28 65 71 3f 20 63 6f n 0)) ;; (eq? co
6ca0: 6c 6e 20 30 29 0a 09 09 09 20 20 20 20 28 62 65 ln 0).... (be
6cb0: 67 69 6e 0a 09 09 09 20 20 20 20 20 20 28 73 70 gin.... (sp
6cc0: 61 72 73 65 2d 61 72 72 61 79 2d 73 65 74 21 20 arse-array-set!
6cd0: 76 65 63 20 72 6f 77 6e 20 30 20 76 61 72 6e 61 vec rown 0 varna
6ce0: 6d 65 29 0a 09 09 09 20 20 20 20 20 20 3b 3b 20 me).... ;;
6cf0: 28 70 72 69 6e 74 20 22 73 70 61 72 73 65 2d 61 (print "sparse-a
6d00: 72 72 61 79 2d 72 65 66 20 22 20 72 6f 77 6e 20 rray-ref " rown
6d10: 22 2c 22 20 30 20 22 3d 22 20 28 73 70 61 72 73 "," 0 "=" (spars
6d20: 65 2d 61 72 72 61 79 2d 72 65 66 20 76 65 63 20 e-array-ref vec
6d30: 72 6f 77 6e 20 30 29 29 0a 09 09 09 20 20 20 20 rown 0))....
6d40: 20 20 29 29 0a 09 09 09 28 69 66 20 28 6e 6f 74 ))....(if (not
6d50: 20 63 75 72 72 72 6f 77 6e 29 28 68 61 73 68 2d currrown)(hash-
6d60: 74 61 62 6c 65 2d 73 65 74 21 20 72 6f 77 6e 61 table-set! rowna
6d70: 6d 65 73 20 76 61 72 6e 61 6d 65 20 72 6f 77 6e mes varname rown
6d80: 29 29 0a 09 09 09 28 69 66 20 28 6e 6f 74 20 63 ))....(if (not c
6d90: 75 72 72 63 6f 6c 6e 29 28 68 61 73 68 2d 74 61 urrcoln)(hash-ta
6da0: 62 6c 65 2d 73 65 74 21 20 63 6f 6c 6e 61 6d 65 ble-set! colname
6db0: 73 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 63 6f s sectionname co
6dc0: 6c 6e 29 29 0a 09 09 09 3b 3b 20 28 70 72 69 6e ln))....;; (prin
6dd0: 74 20 22 64 61 74 3d 22 20 64 61 74 20 22 2c 20 t "dat=" dat ",
6de0: 72 6f 77 6e 3d 22 20 72 6f 77 6e 20 22 2c 20 63 rown=" rown ", c
6df0: 6f 6c 6e 3d 22 20 63 6f 6c 6e 29 0a 09 09 09 28 oln=" coln)....(
6e00: 73 70 61 72 73 65 2d 61 72 72 61 79 2d 73 65 74 sparse-array-set
6e10: 21 20 76 65 63 20 72 6f 77 6e 20 63 6f 6c 6e 20 ! vec rown coln
6e20: 76 61 6c 29 0a 09 09 09 3b 3b 20 28 70 72 69 6e val)....;; (prin
6e30: 74 20 22 73 70 61 72 73 65 2d 61 72 72 61 79 2d t "sparse-array-
6e40: 72 65 66 20 22 20 72 6f 77 6e 20 22 2c 22 20 63 ref " rown "," c
6e50: 6f 6c 6e 20 22 3d 22 20 28 73 70 61 72 73 65 2d oln "=" (sparse-
6e60: 61 72 72 61 79 2d 72 65 66 20 76 65 63 20 72 6f array-ref vec ro
6e70: 77 6e 20 63 6f 6c 6e 29 29 0a 09 09 09 29 29 29 wn coln))....)))
6e80: 0a 09 09 20 20 20 28 66 6f 72 2d 65 61 63 68 0a ... (for-each.
6e90: 09 09 20 20 20 20 28 6c 61 6d 62 64 61 20 28 73 .. (lambda (s
6ea0: 68 65 65 74 6e 61 6d 65 29 0a 09 09 20 20 20 20 heetname)...
6eb0: 20 20 28 6c 65 74 2a 20 28 28 73 68 65 65 74 64 (let* ((sheetd
6ec0: 61 74 20 28 67 65 74 2d 64 61 74 20 72 65 73 75 at (get-dat resu
6ed0: 6c 74 73 20 73 68 65 65 74 6e 61 6d 65 29 29 0a lts sheetname)).
6ee0: 09 09 09 20 20 20 20 20 28 73 76 65 63 20 20 20 ... (svec
6ef0: 20 20 28 72 65 66 64 62 3a 63 73 76 2d 67 65 74 (refdb:csv-get
6f00: 2d 73 76 65 63 20 73 68 65 65 74 64 61 74 29 29 -svec sheetdat))
6f10: 0a 09 09 09 20 20 20 20 20 28 6d 61 78 72 6f 77 .... (maxrow
6f20: 20 20 20 28 72 65 66 64 62 3a 63 73 76 2d 67 65 (refdb:csv-ge
6f30: 74 2d 6d 61 78 72 6f 77 20 73 68 65 65 74 64 61 t-maxrow sheetda
6f40: 74 29 29 0a 09 09 09 20 20 20 20 20 28 6d 61 78 t)).... (max
6f50: 63 6f 6c 20 20 20 28 72 65 66 64 62 3a 63 73 76 col (refdb:csv
6f60: 2d 67 65 74 2d 6d 61 78 63 6f 6c 20 73 68 65 65 -get-maxcol shee
6f70: 74 64 61 74 29 29 0a 09 09 09 20 20 20 20 20 28 tdat)).... (
6f80: 66 6e 61 6d 65 20 20 20 20 28 69 66 20 6f 75 74 fname (if out
6f90: 2d 66 69 6c 65 20 0a 09 09 09 09 09 20 20 20 28 -file ...... (
6fa0: 73 74 72 69 6e 67 2d 73 75 62 73 74 69 74 75 74 string-substitut
6fb0: 65 20 22 25 73 22 20 73 68 65 65 74 6e 61 6d 65 e "%s" sheetname
6fc0: 20 6f 75 74 2d 66 69 6c 65 29 20 3b 3b 20 22 2f out-file) ;; "/
6fd0: 66 6f 6f 2f 62 61 72 2f 25 73 2e 63 73 76 22 29 foo/bar/%s.csv")
6fe0: 0a 09 09 09 09 09 20 20 20 28 63 6f 6e 63 20 73 ...... (conc s
6ff0: 68 65 65 74 6e 61 6d 65 20 22 2e 63 73 76 22 29 heetname ".csv")
7000: 29 29 29 0a 09 09 09 28 77 69 74 68 2d 6f 75 74 )))....(with-out
7010: 70 75 74 2d 74 6f 2d 66 69 6c 65 20 66 6e 61 6d put-to-file fnam
7020: 65 0a 09 09 09 20 20 28 6c 61 6d 62 64 61 20 28 e.... (lambda (
7030: 29 0a 09 09 09 20 20 20 20 3b 3b 20 28 70 72 69 ).... ;; (pri
7040: 6e 74 20 22 53 68 65 65 74 6e 61 6d 65 3a 20 22 nt "Sheetname: "
7050: 20 73 68 65 65 74 6e 61 6d 65 29 0a 09 09 09 20 sheetname)....
7060: 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 72 (let loop ((r
7070: 6f 77 20 20 20 20 20 20 20 30 29 0a 09 09 09 09 ow 0).....
7080: 20 20 20 20 20 20 20 28 63 6f 6c 20 20 20 20 20 (col
7090: 20 20 30 29 0a 09 09 09 09 20 20 20 20 20 20 20 0).....
70a0: 28 63 75 72 72 2d 72 6f 77 20 27 28 29 29 0a 09 (curr-row '())..
70b0: 09 09 09 20 20 20 20 20 20 20 28 72 65 73 75 6c ... (resul
70c0: 74 20 20 20 27 28 29 29 29 0a 09 09 09 20 20 20 t '()))....
70d0: 20 20 20 28 6c 65 74 2a 20 28 28 76 61 6c 20 28 (let* ((val (
70e0: 73 70 61 72 73 65 2d 61 72 72 61 79 2d 72 65 66 sparse-array-ref
70f0: 20 73 76 65 63 20 72 6f 77 20 63 6f 6c 29 29 0a svec row col)).
7100: 09 09 09 09 20 20 20 20 20 28 64 69 73 70 2d 76 .... (disp-v
7110: 61 6c 20 28 69 66 20 76 61 6c 0a 09 09 09 09 09 al (if val......
7120: 09 20 20 20 28 63 6f 6e 63 20 22 5c 22 22 20 76 . (conc "\"" v
7130: 61 6c 20 22 5c 22 22 29 0a 09 09 09 09 09 09 20 al "\"").......
7140: 20 20 22 22 29 29 29 0a 09 09 09 09 28 69 66 20 ""))).....(if
7150: 28 3e 20 63 6f 6c 20 30 29 28 64 69 73 70 6c 61 (> col 0)(displa
7160: 79 20 22 2c 22 29 29 0a 09 09 09 09 28 64 69 73 y ",")).....(dis
7170: 70 6c 61 79 20 64 69 73 70 2d 76 61 6c 29 0a 09 play disp-val)..
7180: 09 09 09 28 63 6f 6e 64 0a 09 09 09 09 20 28 28 ...(cond..... ((
7190: 3e 20 72 6f 77 20 6d 61 78 72 6f 77 29 28 64 69 > row maxrow)(di
71a0: 73 70 6c 61 79 20 22 5c 6e 22 29 20 72 65 73 75 splay "\n") resu
71b0: 6c 74 29 0a 09 09 09 09 20 28 28 3e 3d 20 63 6f lt)..... ((>= co
71c0: 6c 20 6d 61 78 63 6f 6c 29 0a 09 09 09 09 20 20 l maxcol).....
71d0: 28 64 69 73 70 6c 61 79 20 22 5c 6e 22 29 0a 09 (display "\n")..
71e0: 09 09 09 20 20 28 6c 6f 6f 70 20 28 2b 20 72 6f ... (loop (+ ro
71f0: 77 20 31 29 20 30 20 27 28 29 20 28 61 70 70 65 w 1) 0 '() (appe
7200: 6e 64 20 72 65 73 75 6c 74 20 28 6c 69 73 74 20 nd result (list
7210: 63 75 72 72 2d 72 6f 77 29 29 29 29 0a 09 09 09 curr-row))))....
7220: 09 20 28 65 6c 73 65 0a 09 09 09 09 20 20 28 6c . (else..... (l
7230: 6f 6f 70 20 72 6f 77 20 28 2b 20 63 6f 6c 20 31 oop row (+ col 1
7240: 29 20 28 61 70 70 65 6e 64 20 63 75 72 72 2d 72 ) (append curr-r
7250: 6f 77 20 28 6c 69 73 74 20 76 61 6c 29 29 20 72 ow (list val)) r
7260: 65 73 75 6c 74 29 29 29 29 29 29 29 29 29 0a 09 esult)))))))))..
7270: 09 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 . (hash-table
7280: 2d 6b 65 79 73 20 72 65 73 75 6c 74 73 29 29 29 -keys results)))
7290: 29 0a 09 09 28 28 73 71 6c 69 74 65 33 29 0a 09 )...((sqlite3)..
72a0: 09 20 28 6c 65 74 2a 20 28 28 64 62 2d 66 69 6c . (let* ((db-fil
72b0: 65 20 20 20 28 6f 72 20 6f 75 74 2d 66 69 6c 65 e (or out-file
72c0: 20 28 70 61 74 68 6e 61 6d 65 2d 66 69 6c 65 20 (pathname-file
72d0: 69 6e 70 75 74 2d 64 62 29 29 29 0a 09 09 09 28 input-db)))....(
72e0: 64 62 2d 65 78 69 73 74 73 20 28 63 6f 6d 6d 6f db-exists (commo
72f0: 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 64 n:file-exists? d
7300: 62 2d 66 69 6c 65 29 29 0a 09 09 09 28 64 62 20 b-file))....(db
7310: 20 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a (sqlite3:
7320: 6f 70 65 6e 2d 64 61 74 61 62 61 73 65 20 64 62 open-database db
7330: 2d 66 69 6c 65 29 29 29 0a 09 09 20 20 20 28 69 -file)))... (i
7340: 66 20 28 6e 6f 74 20 64 62 2d 65 78 69 73 74 73 f (not db-exists
7350: 29 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 )(sqlite3:execut
7360: 65 20 64 62 20 22 43 52 45 41 54 45 20 54 41 42 e db "CREATE TAB
7370: 4c 45 20 64 61 74 61 20 28 73 68 65 65 74 2c 73 LE data (sheet,s
7380: 65 63 74 69 6f 6e 2c 76 61 72 2c 76 61 6c 29 3b ection,var,val);
7390: 22 29 29 0a 09 09 20 20 20 28 63 6f 6e 66 69 67 "))... (config
73a0: 66 3a 6d 61 70 2d 61 6c 6c 2d 68 69 65 72 2d 61 f:map-all-hier-a
73b0: 6c 69 73 74 0a 09 09 20 20 20 20 64 61 74 61 0a list... data.
73c0: 09 09 20 20 20 20 28 6c 61 6d 62 64 61 20 28 73 .. (lambda (s
73d0: 68 65 65 74 6e 61 6d 65 20 73 65 63 74 69 6f 6e heetname section
73e0: 6e 61 6d 65 20 76 61 72 6e 61 6d 65 20 76 61 6c name varname val
73f0: 29 0a 09 09 20 20 20 20 20 20 28 73 71 6c 69 74 )... (sqlit
7400: 65 33 3a 65 78 65 63 75 74 65 20 64 62 0a 09 09 e3:execute db...
7410: 09 09 20 20 20 20 20 20 20 22 49 4e 53 45 52 54 .. "INSERT
7420: 20 4f 52 20 52 45 50 4c 41 43 45 20 49 4e 54 4f OR REPLACE INTO
7430: 20 64 61 74 61 20 28 73 68 65 65 74 2c 73 65 63 data (sheet,sec
7440: 74 69 6f 6e 2c 76 61 72 2c 76 61 6c 29 20 56 41 tion,var,val) VA
7450: 4c 55 45 53 20 28 3f 2c 3f 2c 3f 2c 3f 29 3b 22 LUES (?,?,?,?);"
7460: 0a 09 09 09 09 20 20 20 20 20 20 20 73 68 65 65 ..... shee
7470: 74 6e 61 6d 65 20 73 65 63 74 69 6f 6e 6e 61 6d tname sectionnam
7480: 65 20 76 61 72 6e 61 6d 65 20 76 61 6c 29 29 29 e varname val)))
7490: 0a 09 09 20 20 20 28 73 71 6c 69 74 65 33 3a 66 ... (sqlite3:f
74a0: 69 6e 61 6c 69 7a 65 21 20 64 62 29 29 29 0a 09 inalize! db)))..
74b0: 09 28 65 6c 73 65 0a 09 09 20 28 70 70 20 64 61 .(else... (pp da
74c0: 74 61 29 29 29 29 29 29 0a 20 20 20 20 20 20 28 ta)))))). (
74d0: 69 66 20 6f 75 74 2d 66 69 6c 65 20 28 63 6c 6f if out-file (clo
74e0: 73 65 2d 6f 75 74 70 75 74 2d 70 6f 72 74 20 6f se-output-port o
74f0: 75 74 2d 70 6f 72 74 29 29 0a 20 20 20 20 20 20 ut-port)).
7500: 28 65 78 69 74 29 20 3b 3b 20 79 65 73 2c 20 62 (exit) ;; yes, b
7510: 65 6e 64 69 6e 67 20 74 68 65 20 72 75 6c 65 73 ending the rules
7520: 20 68 65 72 65 20 2d 20 6e 65 65 64 20 74 6f 20 here - need to
7530: 65 78 69 74 20 73 69 6e 63 65 20 74 68 69 73 20 exit since this
7540: 69 73 20 61 20 75 74 69 6c 69 74 79 0a 20 20 20 is a utility.
7550: 20 20 20 29 29 0a 0a 28 69 66 20 28 61 72 67 73 ))..(if (args
7560: 3a 67 65 74 2d 61 72 67 20 22 2d 70 69 6e 67 22 :get-arg "-ping"
7570: 29 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 73 65 ). (let* ((se
7580: 72 76 65 72 2d 69 64 20 20 20 20 20 28 73 74 72 rver-id (str
7590: 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 61 72 67 ing->number (arg
75a0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 70 69 6e 67 s:get-arg "-ping
75b0: 22 29 29 29 20 3b 3b 20 65 78 74 72 61 63 74 20 "))) ;; extract
75c0: 72 75 6e 2d 69 64 20 28 69 2e 65 2e 20 6e 6f 20 run-id (i.e. no
75d0: 22 3a 22 0a 09 20 20 20 28 68 6f 73 74 3a 70 6f ":".. (host:po
75e0: 72 74 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 rt (args:get
75f0: 2d 61 72 67 20 22 2d 70 69 6e 67 22 29 29 29 0a -arg "-ping"))).
7600: 20 20 20 20 20 20 28 73 65 72 76 65 72 3a 70 69 (server:pi
7610: 6e 67 20 28 6f 72 20 73 65 72 76 65 72 2d 69 64 ng (or server-id
7620: 20 68 6f 73 74 3a 70 6f 72 74 29 20 64 6f 2d 65 host:port) do-e
7630: 78 69 74 3a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d xit: #t)))..;;==
7640: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7650: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7660: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7670: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7680: 3d 3d 3d 3d 0a 3b 3b 20 43 61 70 74 75 72 65 2c ====.;; Capture,
7690: 20 73 61 76 65 20 61 6e 64 20 6d 61 6e 69 70 75 save and manipu
76a0: 6c 61 74 65 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 late environment
76b0: 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d s.;;============
76c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
76d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
76e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
76f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 4e ==========..;; N
7700: 4f 54 45 3a 20 4b 65 65 70 20 74 68 65 73 65 20 OTE: Keep these
7710: 61 62 6f 76 65 20 74 68 65 20 73 65 63 74 69 6f above the sectio
7720: 6e 20 77 68 65 72 65 20 74 68 65 20 73 65 72 76 n where the serv
7730: 65 72 20 6f 72 20 63 6c 69 65 6e 74 20 63 6f 64 er or client cod
7740: 65 20 69 73 20 73 65 74 75 70 0a 0a 28 6c 65 74 e is setup..(let
7750: 20 28 28 65 6e 76 63 61 70 20 28 61 72 67 73 3a ((envcap (args:
7760: 67 65 74 2d 61 72 67 20 22 2d 65 6e 76 63 61 70 get-arg "-envcap
7770: 22 29 29 29 0a 20 20 28 69 66 20 65 6e 76 63 61 "))). (if envca
7780: 70 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 p. (let* ((
7790: 64 62 20 20 20 20 20 20 28 65 6e 76 3a 6f 70 65 db (env:ope
77a0: 6e 2d 64 62 20 28 69 66 20 28 6e 75 6c 6c 3f 20 n-db (if (null?
77b0: 72 65 6d 61 72 67 73 29 20 22 65 6e 76 64 61 74 remargs) "envdat
77c0: 2e 64 62 22 20 28 63 61 72 20 72 65 6d 61 72 67 .db" (car remarg
77d0: 73 29 29 29 29 29 0a 09 28 65 6e 76 3a 73 61 76 s)))))..(env:sav
77e0: 65 2d 65 6e 76 2d 76 61 72 73 20 64 62 20 65 6e e-env-vars db en
77f0: 76 63 61 70 29 0a 09 28 65 6e 76 3a 63 6c 6f 73 vcap)..(env:clos
7800: 65 2d 64 61 74 61 62 61 73 65 20 64 62 29 0a 09 e-database db)..
7810: 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
7820: 69 6e 67 2a 20 23 74 29 29 29 29 0a 0a 3b 3b 20 ing* #t))))..;;
7830: 64 65 6c 74 61 20 22 6c 61 6e 67 75 61 67 65 22 delta "language"
7840: 20 77 69 6c 6c 20 65 76 65 6e 74 75 61 6c 6c 79 will eventually
7850: 20 62 65 20 72 65 73 3d 61 2b 62 2d 63 20 62 75 be res=a+b-c bu
7860: 74 20 66 6f 72 20 6e 6f 77 20 69 74 20 69 73 20 t for now it is
7870: 6a 75 73 74 20 72 65 73 3d 61 2d 62 20 0a 3b 3b just res=a-b .;;
7880: 0a 28 6c 65 74 20 28 28 65 6e 76 64 65 6c 74 61 .(let ((envdelta
7890: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
78a0: 2d 65 6e 76 64 65 6c 74 61 22 29 29 29 0a 20 20 -envdelta"))).
78b0: 28 69 66 20 65 6e 76 64 65 6c 74 61 0a 20 20 20 (if envdelta.
78c0: 20 20 20 28 6c 65 74 20 28 28 6d 61 74 63 68 20 (let ((match
78d0: 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 65 6e (string-split en
78e0: 76 64 65 6c 74 61 20 22 2d 22 29 29 29 3b 3b 20 vdelta "-")));;
78f0: 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 22 28 (string-match "(
7900: 5b 61 2d 7a 30 2d 39 5f 5d 2b 29 3d 28 5b 61 2d [a-z0-9_]+)=([a-
7910: 7a 30 2d 39 5f 5c 5c 2d 2c 5d 2b 29 22 20 65 6e z0-9_\\-,]+)" en
7920: 76 64 65 6c 74 61 29 29 29 0a 09 28 69 66 20 28 vdelta)))..(if (
7930: 6e 6f 74 20 28 6e 75 6c 6c 3f 20 6d 61 74 63 68 not (null? match
7940: 29 29 0a 09 20 20 20 20 28 6c 65 74 2a 20 28 28 )).. (let* ((
7950: 64 62 20 20 20 20 20 20 20 20 28 65 6e 76 3a 6f db (env:o
7960: 70 65 6e 2d 64 62 20 28 69 66 20 28 6e 75 6c 6c pen-db (if (null
7970: 3f 20 72 65 6d 61 72 67 73 29 20 22 65 6e 76 64 ? remargs) "envd
7980: 61 74 2e 64 62 22 20 28 63 61 72 20 72 65 6d 61 at.db" (car rema
7990: 72 67 73 29 29 29 29 0a 09 09 20 20 20 3b 3b 20 rgs))))... ;;
79a0: 28 72 65 73 63 74 78 20 20 20 20 28 63 61 64 72 (resctx (cadr
79b0: 20 6d 61 74 63 68 29 29 0a 09 09 20 20 20 3b 3b match))... ;;
79c0: 20 28 65 71 75 6e 20 20 20 20 20 20 28 63 61 64 (equn (cad
79d0: 64 72 20 6d 61 74 63 68 29 29 0a 09 09 20 20 20 dr match))...
79e0: 28 70 61 72 74 73 20 20 20 20 20 6d 61 74 63 68 (parts match
79f0: 29 20 3b 3b 20 28 73 74 72 69 6e 67 2d 73 70 6c ) ;; (string-spl
7a00: 69 74 20 65 71 75 6e 20 22 2d 22 29 29 0a 09 09 it equn "-"))...
7a10: 20 20 20 28 6d 69 6e 75 65 6e 64 20 20 20 28 63 (minuend (c
7a20: 61 72 20 70 61 72 74 73 29 29 0a 09 09 20 20 20 ar parts))...
7a30: 28 73 75 62 74 72 61 65 6e 64 20 28 63 61 64 72 (subtraend (cadr
7a40: 20 70 61 72 74 73 29 29 0a 09 09 20 20 20 28 61 parts))... (a
7a50: 64 64 65 64 20 20 20 20 20 28 65 6e 76 3a 67 65 dded (env:ge
7a60: 74 2d 61 64 64 65 64 20 20 20 64 62 20 6d 69 6e t-added db min
7a70: 75 65 6e 64 20 73 75 62 74 72 61 65 6e 64 29 29 uend subtraend))
7a80: 0a 09 09 20 20 20 28 72 65 6d 6f 76 65 64 20 20 ... (removed
7a90: 20 28 65 6e 76 3a 67 65 74 2d 72 65 6d 6f 76 65 (env:get-remove
7aa0: 64 20 64 62 20 6d 69 6e 75 65 6e 64 20 73 75 62 d db minuend sub
7ab0: 74 72 61 65 6e 64 29 29 0a 09 09 20 20 20 28 63 traend))... (c
7ac0: 68 61 6e 67 65 64 20 20 20 28 65 6e 76 3a 67 65 hanged (env:ge
7ad0: 74 2d 63 68 61 6e 67 65 64 20 64 62 20 6d 69 6e t-changed db min
7ae0: 75 65 6e 64 20 73 75 62 74 72 61 65 6e 64 29 29 uend subtraend))
7af0: 29 0a 09 20 20 20 20 20 20 3b 3b 20 28 70 70 20 ).. ;; (pp
7b00: 28 68 61 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 (hash-table->ali
7b10: 73 74 20 61 64 64 65 64 29 29 0a 09 20 20 20 20 st added))..
7b20: 20 20 3b 3b 20 28 70 70 20 28 68 61 73 68 2d 74 ;; (pp (hash-t
7b30: 61 62 6c 65 2d 3e 61 6c 69 73 74 20 72 65 6d 6f able->alist remo
7b40: 76 65 64 29 29 0a 09 20 20 20 20 20 20 3b 3b 20 ved)).. ;;
7b50: 28 70 70 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (pp (hash-table-
7b60: 3e 61 6c 69 73 74 20 63 68 61 6e 67 65 64 29 29 >alist changed))
7b70: 0a 09 20 20 20 20 20 20 28 69 66 20 28 61 72 67 .. (if (arg
7b80: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6f 22 29 0a s:get-arg "-o").
7b90: 09 09 20 20 28 77 69 74 68 2d 6f 75 74 70 75 74 .. (with-output
7ba0: 2d 74 6f 2d 66 69 6c 65 0a 09 09 20 20 20 20 20 -to-file...
7bb0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
7bc0: 2d 6f 22 29 0a 09 09 20 20 20 20 28 6c 61 6d 62 -o")... (lamb
7bd0: 64 61 20 28 29 0a 09 09 20 20 20 20 20 20 28 65 da ()... (e
7be0: 6e 76 3a 70 72 69 6e 74 20 61 64 64 65 64 20 72 nv:print added r
7bf0: 65 6d 6f 76 65 64 20 63 68 61 6e 67 65 64 29 29 emoved changed))
7c00: 29 0a 09 09 20 20 28 65 6e 76 3a 70 72 69 6e 74 )... (env:print
7c10: 20 61 64 64 65 64 20 72 65 6d 6f 76 65 64 20 63 added removed c
7c20: 68 61 6e 67 65 64 29 29 0a 09 20 20 20 20 20 20 hanged))..
7c30: 28 65 6e 76 3a 63 6c 6f 73 65 2d 64 61 74 61 62 (env:close-datab
7c40: 61 73 65 20 64 62 29 0a 09 20 20 20 20 20 20 28 ase db).. (
7c50: 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
7c60: 6e 67 2a 20 23 74 29 29 0a 09 20 20 20 20 28 64 ng* #t)).. (d
7c70: 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 ebug:print-error
7c80: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
7c90: 70 6f 72 74 2a 20 22 50 61 72 61 6d 65 74 65 72 port* "Parameter
7ca0: 20 74 6f 20 2d 65 6e 76 64 65 6c 74 61 20 73 68 to -envdelta sh
7cb0: 6f 75 6c 64 20 62 65 20 6e 65 77 3d 73 74 61 72 ould be new=star
7cc0: 2d 65 6e 64 22 29 29 29 29 29 0a 0a 3b 3b 3d 3d -end")))))..;;==
7cd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7ce0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7cf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7d00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7d10: 3d 3d 3d 3d 0a 3b 3b 20 53 74 61 72 74 20 74 68 ====.;; Start th
7d20: 65 20 73 65 72 76 65 72 20 2d 20 63 61 6e 20 62 e server - can b
7d30: 65 20 64 6f 6e 65 20 69 6e 20 63 6f 6e 6a 75 6e e done in conjun
7d40: 63 74 69 6f 6e 20 77 69 74 68 20 2d 72 75 6e 61 ction with -runa
7d50: 6c 6c 20 6f 72 20 2d 72 75 6e 74 65 73 74 73 20 ll or -runtests
7d60: 28 6f 6e 65 20 64 61 79 2e 2e 2e 29 0a 3b 3b 20 (one day...).;;
7d70: 20 20 77 65 20 73 74 61 72 74 20 74 68 65 20 73 we start the s
7d80: 65 72 76 65 72 20 69 66 20 6e 6f 74 20 72 75 6e erver if not run
7d90: 6e 69 6e 67 20 65 6c 73 65 20 73 74 61 72 74 20 ning else start
7da0: 74 68 65 20 63 6c 69 65 6e 74 20 74 68 72 65 61 the client threa
7db0: 64 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d d.;;============
7dc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7dd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7de0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7df0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 53 ==========..;; S
7e00: 65 72 76 65 72 3f 20 53 74 61 72 74 20 75 70 20 erver? Start up
7e10: 68 65 72 65 2e 0a 3b 3b 0a 28 69 66 20 28 61 72 here..;;.(if (ar
7e20: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 72 gs:get-arg "-ser
7e30: 76 65 72 22 29 0a 20 20 20 20 28 6c 65 74 20 28 ver"). (let (
7e40: 28 74 6c 20 20 20 20 20 20 20 20 28 6c 61 75 6e (tl (laun
7e50: 63 68 3a 73 65 74 75 70 29 29 0a 20 20 20 20 20 ch:setup)).
7e60: 20 20 20 20 20 28 74 72 61 6e 73 70 6f 72 74 2d (transport-
7e70: 74 79 70 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 type (string->sy
7e80: 6d 62 6f 6c 20 28 6f 72 20 28 61 72 67 73 3a 67 mbol (or (args:g
7e90: 65 74 2d 61 72 67 20 22 2d 74 72 61 6e 73 70 6f et-arg "-transpo
7ea0: 72 74 22 29 20 22 68 74 74 70 22 29 29 29 29 0a rt") "http")))).
7eb0: 20 20 20 20 20 20 28 73 65 72 76 65 72 3a 6c 61 (server:la
7ec0: 75 6e 63 68 20 30 20 74 72 61 6e 73 70 6f 72 74 unch 0 transport
7ed0: 2d 74 79 70 65 29 0a 20 20 20 20 20 20 28 73 65 -type). (se
7ee0: 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
7ef0: 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 28 6f 72 * #t)))..(if (or
7f00: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
7f10: 2d 6c 69 73 74 2d 73 65 72 76 65 72 73 22 29 0a -list-servers").
7f20: 20 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 (args:ge
7f30: 74 2d 61 72 67 20 22 2d 6b 69 6c 6c 2d 73 65 72 t-arg "-kill-ser
7f40: 76 65 72 73 22 29 29 0a 20 20 20 20 28 6c 65 74 vers")). (let
7f50: 20 28 28 74 6c 20 28 6c 61 75 6e 63 68 3a 73 65 ((tl (launch:se
7f60: 74 75 70 29 29 29 0a 20 20 20 20 20 20 28 69 66 tup))). (if
7f70: 20 74 6c 20 3b 3b 20 61 6c 6c 20 72 6f 61 64 73 tl ;; all roads
7f80: 20 66 72 6f 6d 20 68 65 72 65 20 65 78 69 74 0a from here exit.
7f90: 09 20 20 28 6c 65 74 2a 20 28 28 73 65 72 76 65 . (let* ((serve
7fa0: 72 73 20 28 73 65 72 76 65 72 3a 67 65 74 2d 6c rs (server:get-l
7fb0: 69 73 74 20 2a 74 6f 70 70 61 74 68 2a 29 29 0a ist *toppath*)).
7fc0: 09 09 20 28 66 6d 74 73 74 72 20 20 22 7e 38 61 .. (fmtstr "~8a
7fd0: 7e 32 32 61 7e 32 30 61 7e 32 30 61 7e 38 61 5c ~22a~20a~20a~8a\
7fe0: 6e 22 29 29 0a 09 20 20 20 20 28 66 6f 72 6d 61 n")).. (forma
7ff0: 74 20 23 74 20 66 6d 74 73 74 72 20 22 70 69 64 t #t fmtstr "pid
8000: 22 20 22 49 6e 74 65 72 66 61 63 65 3a 70 6f 72 " "Interface:por
8010: 74 22 20 22 61 67 65 20 28 68 6d 73 29 22 20 22 t" "age (hms)" "
8020: 4c 61 73 74 20 6d 6f 64 22 20 22 53 74 61 74 65 Last mod" "State
8030: 22 29 0a 09 20 20 20 20 28 66 6f 72 6d 61 74 20 ").. (format
8040: 23 74 20 66 6d 74 73 74 72 20 22 3d 3d 3d 22 20 #t fmtstr "==="
8050: 22 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 22 "=============="
8060: 20 22 3d 3d 3d 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d "=========" "==
8070: 3d 3d 3d 3d 3d 3d 22 20 22 3d 3d 3d 3d 3d 22 29 ======" "=====")
8080: 0a 09 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 .. (for-each
8090: 3b 3b 20 20 28 20 6d 6f 64 2d 74 69 6d 65 20 68 ;; ( mod-time h
80a0: 6f 73 74 20 70 6f 72 74 20 73 74 61 72 74 2d 74 ost port start-t
80b0: 69 6d 65 20 70 69 64 20 29 0a 09 20 20 20 20 20 ime pid )..
80c0: 28 6c 61 6d 62 64 61 20 28 73 65 72 76 65 72 29 (lambda (server)
80d0: 0a 09 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 .. (let* (
80e0: 28 6d 74 6d 20 28 61 6e 79 2d 3e 6e 75 6d 62 65 (mtm (any->numbe
80f0: 72 20 28 63 61 72 20 73 65 72 76 65 72 29 29 29 r (car server)))
8100: 0a 09 09 20 20 20 20 20 20 28 6d 6f 64 20 28 69 ... (mod (i
8110: 66 20 6d 74 6d 20 28 2d 20 28 63 75 72 72 65 6e f mtm (- (curren
8120: 74 2d 73 65 63 6f 6e 64 73 29 20 6d 74 6d 29 20 t-seconds) mtm)
8130: 22 75 6e 6b 22 29 29 0a 09 09 20 20 20 20 20 20 "unk"))...
8140: 28 61 67 65 20 28 2d 20 28 63 75 72 72 65 6e 74 (age (- (current
8150: 2d 73 65 63 6f 6e 64 73 29 28 6f 72 20 28 61 6e -seconds)(or (an
8160: 79 2d 3e 6e 75 6d 62 65 72 20 28 6c 69 73 74 2d y->number (list-
8170: 72 65 66 20 73 65 72 76 65 72 20 33 29 29 20 28 ref server 3)) (
8180: 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 current-seconds)
8190: 29 29 29 0a 09 09 20 20 20 20 20 20 28 75 72 6c )))... (url
81a0: 20 28 63 6f 6e 63 20 28 63 61 64 72 20 73 65 72 (conc (cadr ser
81b0: 76 65 72 29 20 22 3a 22 20 28 63 61 64 64 72 20 ver) ":" (caddr
81c0: 73 65 72 76 65 72 29 29 29 0a 09 09 20 20 20 20 server)))...
81d0: 20 20 28 70 69 64 20 28 6c 69 73 74 2d 72 65 66 (pid (list-ref
81e0: 20 73 65 72 76 65 72 20 34 29 29 0a 09 09 20 20 server 4))...
81f0: 20 20 20 20 28 61 6c 76 20 28 69 66 20 28 6e 75 (alv (if (nu
8200: 6d 62 65 72 3f 20 6d 6f 64 29 28 3c 20 6d 6f 64 mber? mod)(< mod
8210: 20 31 30 29 20 23 66 29 29 29 0a 09 09 20 28 66 10) #f)))... (f
8220: 6f 72 6d 61 74 20 23 74 0a 09 09 09 20 66 6d 74 ormat #t.... fmt
8230: 73 74 72 0a 09 09 09 20 70 69 64 0a 09 09 09 20 str.... pid....
8240: 75 72 6c 0a 09 09 09 20 28 73 65 63 6f 6e 64 73 url.... (seconds
8250: 2d 3e 68 72 2d 6d 69 6e 2d 73 65 63 20 61 67 65 ->hr-min-sec age
8260: 29 0a 09 09 09 20 28 73 65 63 6f 6e 64 73 2d 3e ).... (seconds->
8270: 68 72 2d 6d 69 6e 2d 73 65 63 20 6d 6f 64 29 0a hr-min-sec mod).
8280: 09 09 09 20 28 69 66 20 61 6c 76 20 22 61 6c 69 ... (if alv "ali
8290: 76 65 22 20 22 64 65 61 64 22 29 29 0a 09 09 20 ve" "dead"))...
82a0: 28 69 66 20 28 61 6e 64 20 61 6c 76 0a 09 09 09 (if (and alv....
82b0: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
82c0: 22 2d 6b 69 6c 6c 2d 73 65 72 76 65 72 73 22 29 "-kill-servers")
82d0: 29 0a 09 09 20 20 20 20 20 28 62 65 67 69 6e 0a )... (begin.
82e0: 09 09 20 20 20 20 20 20 20 28 64 65 62 75 67 3a .. (debug:
82f0: 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 print-info 0 *de
8300: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
8310: 22 41 74 74 65 6d 70 74 69 6e 67 20 74 6f 20 6b "Attempting to k
8320: 69 6c 6c 20 73 65 72 76 65 72 20 77 69 74 68 20 ill server with
8330: 70 69 64 20 22 20 70 69 64 29 0a 09 09 20 20 20 pid " pid)...
8340: 20 20 20 20 28 73 65 72 76 65 72 3a 6b 69 6c 6c (server:kill
8350: 20 73 65 72 76 65 72 29 29 29 29 29 0a 09 20 20 server)))))..
8360: 20 20 20 28 73 6f 72 74 20 73 65 72 76 65 72 73 (sort servers
8370: 20 28 6c 61 6d 62 64 61 20 28 61 20 62 29 0a 09 (lambda (a b)..
8380: 09 09 20 20 20 20 20 28 6c 65 74 20 28 28 6d 61 .. (let ((ma
8390: 20 28 6f 72 20 28 61 6e 79 2d 3e 6e 75 6d 62 65 (or (any->numbe
83a0: 72 20 28 63 61 72 20 61 29 29 20 39 65 39 29 29 r (car a)) 9e9))
83b0: 0a 09 09 09 09 20 20 20 28 6d 62 20 28 6f 72 20 ..... (mb (or
83c0: 28 61 6e 79 2d 3e 6e 75 6d 62 65 72 20 28 63 61 (any->number (ca
83d0: 72 20 62 29 29 20 39 65 39 29 29 29 0a 09 09 09 r b)) 9e9)))....
83e0: 20 20 20 20 20 20 20 28 3e 20 6d 61 20 6d 62 29 (> ma mb)
83f0: 29 29 29 29 0a 09 20 20 20 20 3b 3b 20 28 64 65 )))).. ;; (de
8400: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 bug:print-info 1
8410: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
8420: 72 74 2a 20 22 44 6f 6e 65 20 77 69 74 68 20 6c rt* "Done with l
8430: 69 73 74 73 65 72 76 65 72 73 22 29 0a 09 20 20 istservers")..
8440: 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
8450: 74 68 69 6e 67 2a 20 23 74 29 0a 09 20 20 20 20 thing* #t)..
8460: 28 65 78 69 74 29 29 0a 09 20 20 28 65 78 69 74 (exit)).. (exit
8470: 29 29 29 29 0a 20 20 20 20 20 20 3b 3b 20 6d 75 )))). ;; mu
8480: 73 74 20 64 6f 2c 20 77 6f 75 6c 64 20 68 61 76 st do, would hav
8490: 65 20 74 6f 20 61 64 64 20 63 68 65 63 6b 73 20 e to add checks
84a0: 74 6f 20 6d 61 6e 79 2f 61 6c 6c 20 63 61 6c 6c to many/all call
84b0: 73 20 62 65 6c 6f 77 0a 0a 3b 3b 3d 3d 3d 3d 3d s below..;;=====
84c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
84d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
84e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
84f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8500: 3d 0a 3b 3b 20 57 65 69 72 64 20 73 70 65 63 69 =.;; Weird speci
8510: 61 6c 20 63 61 6c 6c 73 20 74 68 61 74 20 6e 65 al calls that ne
8520: 65 64 20 74 6f 20 72 75 6e 20 2a 61 66 74 65 72 ed to run *after
8530: 2a 20 74 68 65 20 73 65 72 76 65 72 20 68 61 73 * the server has
8540: 20 73 74 61 72 74 65 64 3f 0a 3b 3b 3d 3d 3d 3d started?.;;====
8550: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8560: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8570: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8580: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8590: 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 ==..(if (args:ge
85a0: 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d 74 61 72 t-arg "-list-tar
85b0: 67 65 74 73 22 29 0a 20 20 20 20 28 69 66 20 28 gets"). (if (
85c0: 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 0a 20 20 launch:setup).
85d0: 20 20 20 20 20 20 28 6c 65 74 20 28 28 74 61 72 (let ((tar
85e0: 67 65 74 73 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 gets (common:get
85f0: 2d 72 75 6e 63 6f 6e 66 69 67 2d 74 61 72 67 65 -runconfig-targe
8600: 74 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ts))).
8610: 3b 3b 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 ;; (debug:print
8620: 31 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 1 *default-log-p
8630: 6f 72 74 2a 20 22 46 6f 75 6e 64 20 22 28 6c 65 ort* "Found "(le
8640: 6e 67 74 68 20 74 61 72 67 65 74 73 29 20 22 20 ngth targets) "
8650: 74 61 72 67 65 74 73 22 29 0a 20 20 20 20 20 20 targets").
8660: 20 20 20 20 28 63 61 73 65 20 28 73 74 72 69 6e (case (strin
8670: 67 2d 3e 73 79 6d 62 6f 6c 20 28 6f 72 20 28 61 g->symbol (or (a
8680: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 rgs:get-arg "-du
8690: 6d 70 6d 6f 64 65 22 29 20 22 61 6c 69 73 74 22 mpmode") "alist"
86a0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 )). (
86b0: 28 61 6c 69 73 74 29 0a 20 20 20 20 20 20 20 20 (alist).
86c0: 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 (for-each (
86d0: 6c 61 6d 62 64 61 20 28 78 29 0a 20 20 20 20 20 lambda (x).
86e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
86f0: 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 5b ;; (print "[
8700: 22 20 78 20 22 5d 22 29 29 0a 20 20 20 20 20 20 " x "]")).
8710: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8720: 20 20 20 28 70 72 69 6e 74 20 78 29 29 0a 20 20 (print x)).
8730: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8740: 20 20 20 20 20 74 61 72 67 65 74 73 29 29 0a 20 targets)).
8750: 20 20 20 20 20 20 20 20 20 20 20 28 28 6a 73 6f ((jso
8760: 6e 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 n).
8770: 28 6a 73 6f 6e 2d 77 72 69 74 65 20 74 61 72 67 (json-write targ
8780: 65 74 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 ets)).
8790: 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 20 20 (else.
87a0: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
87b0: 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 t-error 0 *defau
87c0: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 64 75 lt-log-port* "du
87d0: 6d 70 20 6f 75 74 70 75 74 20 66 6f 72 6d 61 74 mp output format
87e0: 20 22 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 " (args:get-arg
87f0: 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 20 "-dumpmode") "
8800: 6e 6f 74 20 73 75 70 70 6f 72 74 65 64 20 66 6f not supported fo
8810: 72 20 2d 6c 69 73 74 2d 74 61 72 67 65 74 73 22 r -list-targets"
8820: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 73 ))). (s
8830: 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
8840: 67 2a 20 23 74 29 29 29 29 0a 0a 3b 3b 20 63 61 g* #t))))..;; ca
8850: 63 68 65 20 74 68 65 20 72 75 6e 63 6f 6e 66 69 che the runconfi
8860: 67 73 20 69 6e 20 24 4d 54 5f 4c 49 4e 4b 54 52 gs in $MT_LINKTR
8870: 45 45 2f 24 4d 54 5f 54 41 52 47 45 54 2f 24 4d EE/$MT_TARGET/$M
8880: 54 5f 52 55 4e 4e 41 4d 45 2f 2e 72 75 6e 63 6f T_RUNNAME/.runco
8890: 6e 66 69 67 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 nfig.;;.(define
88a0: 28 66 75 6c 6c 2d 72 75 6e 63 6f 6e 66 69 67 73 (full-runconfigs
88b0: 2d 72 65 61 64 29 0a 3b 3b 20 69 6e 20 74 68 65 -read).;; in the
88c0: 20 65 6e 76 70 72 6f 63 65 73 73 69 6e 67 20 62 envprocessing b
88d0: 72 61 6e 63 68 20 74 68 65 20 62 65 6c 6f 77 20 ranch the below
88e0: 63 6f 64 65 20 72 65 70 6c 61 63 65 73 20 74 68 code replaces th
88f0: 65 20 66 75 72 74 68 65 72 20 62 65 6c 6f 77 20 e further below
8900: 63 6f 64 65 0a 3b 3b 20 20 28 69 66 20 28 65 71 code.;; (if (eq
8910: 3f 20 2a 63 6f 6e 66 69 67 73 74 61 74 75 73 2a ? *configstatus*
8920: 20 27 66 75 6c 6c 64 61 74 61 29 0a 3b 3b 20 20 'fulldata).;;
8930: 20 20 20 20 2a 72 75 6e 63 6f 6e 66 69 67 64 61 *runconfigda
8940: 74 2a 0a 3b 3b 20 20 20 20 20 20 28 62 65 67 69 t*.;; (begi
8950: 6e 0a 3b 3b 09 28 6c 61 75 6e 63 68 3a 73 65 74 n.;;.(launch:set
8960: 75 70 29 0a 3b 3b 09 2a 72 75 6e 63 6f 6e 66 69 up).;;.*runconfi
8970: 67 64 61 74 2a 29 29 29 0a 0a 20 20 28 6c 65 74 gdat*))).. (let
8980: 2a 20 28 28 72 75 6e 64 69 72 20 28 69 66 20 28 * ((rundir (if (
8990: 61 6e 64 20 28 67 65 74 65 6e 76 20 22 4d 54 5f and (getenv "MT_
89a0: 4c 49 4e 4b 54 52 45 45 22 29 28 67 65 74 65 6e LINKTREE")(geten
89b0: 76 20 22 4d 54 5f 54 41 52 47 45 54 22 29 28 67 v "MT_TARGET")(g
89c0: 65 74 65 6e 76 20 22 4d 54 5f 52 55 4e 4e 41 4d etenv "MT_RUNNAM
89d0: 45 22 29 29 0a 09 09 20 20 20 20 20 28 63 6f 6e E"))... (con
89e0: 63 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 4c 49 c (getenv "MT_LI
89f0: 4e 4b 54 52 45 45 22 29 20 22 2f 22 20 28 67 65 NKTREE") "/" (ge
8a00: 74 65 6e 76 20 22 4d 54 5f 54 41 52 47 45 54 22 tenv "MT_TARGET"
8a10: 29 20 22 2f 22 20 28 67 65 74 65 6e 76 20 22 4d ) "/" (getenv "M
8a20: 54 5f 52 55 4e 4e 41 4d 45 22 29 29 0a 09 09 20 T_RUNNAME"))...
8a30: 20 20 20 20 23 66 29 29 0a 09 20 28 63 66 67 66 #f)).. (cfgf
8a40: 20 20 20 28 69 66 20 72 75 6e 64 69 72 20 28 63 (if rundir (c
8a50: 6f 6e 63 20 72 75 6e 64 69 72 20 22 2f 2e 72 75 onc rundir "/.ru
8a60: 6e 63 6f 6e 66 69 67 2e 22 20 6d 65 67 61 74 65 nconfig." megate
8a70: 73 74 2d 76 65 72 73 69 6f 6e 20 22 2d 22 20 6d st-version "-" m
8a80: 65 67 61 74 65 73 74 2d 66 6f 73 73 69 6c 2d 68 egatest-fossil-h
8a90: 61 73 68 29 20 23 66 29 29 29 0a 20 20 20 20 28 ash) #f))). (
8aa0: 69 66 20 28 61 6e 64 20 63 66 67 66 0a 09 20 20 if (and cfgf..
8ab0: 20 20 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d (common:file-
8ac0: 65 78 69 73 74 73 3f 20 63 66 67 66 29 0a 09 20 exists? cfgf)..
8ad0: 20 20 20 20 28 66 69 6c 65 2d 77 72 69 74 65 2d (file-write-
8ae0: 61 63 63 65 73 73 3f 20 63 66 67 66 29 0a 09 20 access? cfgf)..
8af0: 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 75 73 65 2d (common:use-
8b00: 63 61 63 68 65 3f 29 29 0a 09 28 63 6f 6e 66 69 cache?))..(confi
8b10: 67 66 3a 72 65 61 64 2d 61 6c 69 73 74 20 63 66 gf:read-alist cf
8b20: 67 66 29 0a 09 28 6c 65 74 2a 20 28 28 6b 65 79 gf)..(let* ((key
8b30: 73 20 20 20 28 72 6d 74 3a 67 65 74 2d 6b 65 79 s (rmt:get-key
8b40: 73 29 29 0a 09 20 20 20 20 20 20 20 28 74 61 72 s)).. (tar
8b50: 67 65 74 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 get (common:args
8b60: 2d 67 65 74 2d 74 61 72 67 65 74 29 29 0a 09 20 -get-target))..
8b70: 20 20 20 20 20 20 28 6b 65 79 2d 76 61 6c 73 20 (key-vals
8b80: 28 69 66 20 74 61 72 67 65 74 20 28 6b 65 79 73 (if target (keys
8b90: 3a 74 61 72 67 65 74 2d 3e 6b 65 79 76 61 6c 20 :target->keyval
8ba0: 6b 65 79 73 20 74 61 72 67 65 74 29 20 23 66 29 keys target) #f)
8bb0: 29 0a 09 20 20 20 20 20 20 20 28 73 65 63 74 69 ).. (secti
8bc0: 6f 6e 73 20 28 69 66 20 74 61 72 67 65 74 20 28 ons (if target (
8bd0: 6c 69 73 74 20 22 64 65 66 61 75 6c 74 22 20 74 list "default" t
8be0: 61 72 67 65 74 29 20 23 66 29 29 0a 09 20 20 20 arget) #f))..
8bf0: 20 20 20 20 28 64 61 74 61 20 20 20 20 20 28 62 (data (b
8c00: 65 67 69 6e 0a 09 09 09 20 20 20 28 73 65 74 65 egin.... (sete
8c10: 6e 76 20 22 4d 54 5f 52 55 4e 5f 41 52 45 41 5f nv "MT_RUN_AREA_
8c20: 48 4f 4d 45 22 20 2a 74 6f 70 70 61 74 68 2a 29 HOME" *toppath*)
8c30: 0a 09 09 09 20 20 20 28 69 66 20 6b 65 79 2d 76 .... (if key-v
8c40: 61 6c 73 0a 09 09 09 20 20 20 20 20 20 20 28 66 als.... (f
8c50: 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 or-each (lambda
8c60: 28 6b 74 29 0a 09 09 09 09 09 20 20 20 28 73 65 (kt)...... (se
8c70: 74 65 6e 76 20 28 63 61 72 20 6b 74 29 20 28 63 tenv (car kt) (c
8c80: 61 64 72 20 6b 74 29 29 29 0a 09 09 09 09 09 20 adr kt)))......
8c90: 6b 65 79 2d 76 61 6c 73 29 29 0a 09 09 09 20 20 key-vals))....
8ca0: 20 3b 3b 20 28 72 65 61 64 2d 63 6f 6e 66 69 67 ;; (read-config
8cb0: 20 28 63 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a (conc *toppath*
8cc0: 20 22 2f 72 75 6e 63 6f 6e 66 69 67 73 2e 63 6f "/runconfigs.co
8cd0: 6e 66 69 67 22 29 20 23 66 20 23 74 20 73 65 63 nfig") #f #t sec
8ce0: 74 69 6f 6e 73 3a 20 73 65 63 74 69 6f 6e 73 29 tions: sections)
8cf0: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
8d00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
8d10: 72 75 6e 63 6f 6e 66 69 67 3a 72 65 61 64 20 28 runconfig:read (
8d20: 63 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 conc *toppath* "
8d30: 2f 72 75 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 /runconfigs.conf
8d40: 69 67 22 29 20 74 61 72 67 65 74 20 23 66 29 29 ig") target #f))
8d50: 29 29 0a 09 20 20 28 69 66 20 28 61 6e 64 20 72 )).. (if (and r
8d60: 75 6e 64 69 72 20 3b 3b 20 68 61 76 65 20 61 6c undir ;; have al
8d70: 6c 20 6e 65 65 64 65 64 20 76 61 72 69 61 62 6c l needed variabl
8d80: 65 73 73 0a 09 09 20 20 20 28 64 69 72 65 63 74 ess... (direct
8d90: 6f 72 79 2d 65 78 69 73 74 73 3f 20 72 75 6e 64 ory-exists? rund
8da0: 69 72 29 0a 09 09 20 20 20 28 66 69 6c 65 2d 77 ir)... (file-w
8db0: 72 69 74 65 2d 61 63 63 65 73 73 3f 20 72 75 6e rite-access? run
8dc0: 64 69 72 29 29 0a 09 20 20 20 20 20 20 28 62 65 dir)).. (be
8dd0: 67 69 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 gin.
8de0: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 63 6f (if (not (co
8df0: 6d 6d 6f 6e 3a 69 6e 2d 72 75 6e 6e 69 6e 67 2d mmon:in-running-
8e00: 74 65 73 74 3f 29 29 0a 20 20 20 20 20 20 20 20 test?)).
8e10: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e (con
8e20: 66 69 67 66 3a 77 72 69 74 65 2d 61 6c 69 73 74 figf:write-alist
8e30: 20 64 61 74 61 20 63 66 67 66 29 29 0a 09 09 3b data cfgf))...;
8e40: 3b 20 66 6f 72 63 65 20 72 65 2d 72 65 61 64 20 ; force re-read
8e50: 6f 66 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 of megatest.conf
8e60: 69 67 20 2d 20 74 68 69 73 20 72 65 73 6f 6c 76 ig - this resolv
8e70: 65 73 20 63 69 72 63 75 6c 61 72 20 72 65 66 65 es circular refe
8e80: 72 65 6e 63 65 73 20 62 65 74 77 65 65 6e 20 6d rences between m
8e90: 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 0a 09 egatest.config..
8ea0: 09 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 20 66 .(launch:setup f
8eb0: 6f 72 63 65 2d 72 65 72 65 61 64 3a 20 23 74 29 orce-reread: #t)
8ec0: 0a 09 09 3b 3b 20 28 6c 61 75 6e 63 68 3a 63 61 ...;; (launch:ca
8ed0: 63 68 65 2d 63 6f 6e 66 69 67 29 20 3b 3b 20 74 che-config) ;; t
8ee0: 68 65 72 65 20 61 72 65 20 74 77 6f 20 69 6e 64 here are two ind
8ef0: 65 70 65 6e 64 65 6e 74 20 63 6f 6e 66 69 67 20 ependent config
8f00: 63 61 63 68 65 20 6c 6f 63 61 74 69 6f 6e 73 2c cache locations,
8f10: 20 74 75 72 6e 69 6e 67 20 74 68 69 73 20 6f 6e turning this on
8f20: 65 20 6f 66 66 20 66 6f 72 20 6e 6f 77 2e 20 4d e off for now. M
8f30: 52 57 2e 0a 09 09 29 29 20 3b 3b 20 77 65 20 63 RW....)) ;; we c
8f40: 61 6e 20 73 61 66 65 6c 79 20 63 61 63 68 65 20 an safely cache
8f50: 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 20 megatest.config
8f60: 73 69 6e 63 65 20 77 65 20 68 61 76 65 20 61 20 since we have a
8f70: 76 61 6c 69 64 20 72 75 6e 63 6f 6e 66 69 67 0a valid runconfig.
8f80: 09 20 20 64 61 74 61 29 29 29 29 0a 0a 28 69 66 . data))))..(if
8f90: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
8fa0: 2d 73 68 6f 77 2d 72 75 6e 63 6f 6e 66 69 67 22 -show-runconfig"
8fb0: 29 0a 20 20 20 20 28 6c 65 74 20 28 28 74 6c 20 ). (let ((tl
8fc0: 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 29 (launch:setup)))
8fd0: 0a 20 20 20 20 20 20 28 70 75 73 68 2d 64 69 72 . (push-dir
8fe0: 65 63 74 6f 72 79 20 2a 74 6f 70 70 61 74 68 2a ectory *toppath*
8ff0: 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 64 ). (let ((d
9000: 61 74 61 20 28 66 75 6c 6c 2d 72 75 6e 63 6f 6e ata (full-runcon
9010: 66 69 67 73 2d 72 65 61 64 29 29 29 0a 09 3b 3b figs-read)))..;;
9020: 20 6b 65 65 70 20 74 68 69 73 20 6f 6e 65 20 6c keep this one l
9030: 6f 63 61 6c 0a 09 28 63 6f 6e 64 0a 09 20 28 28 ocal..(cond.. ((
9040: 61 6e 64 20 28 61 72 67 73 3a 67 65 74 2d 61 72 and (args:get-ar
9050: 67 20 22 2d 73 65 63 74 69 6f 6e 22 29 0a 09 20 g "-section")..
9060: 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d (args:get-
9070: 61 72 67 20 22 2d 76 61 72 22 29 29 0a 09 20 20 arg "-var"))..
9080: 28 6c 65 74 20 28 28 76 61 6c 20 28 6f 72 20 28 (let ((val (or (
9090: 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 64 configf:lookup d
90a0: 61 74 61 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ata (args:get-ar
90b0: 67 20 22 2d 73 65 63 74 69 6f 6e 22 29 28 61 72 g "-section")(ar
90c0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 76 61 72 gs:get-arg "-var
90d0: 22 29 29 0a 09 09 09 20 28 63 6f 6e 66 69 67 66 ")).... (configf
90e0: 3a 6c 6f 6f 6b 75 70 20 64 61 74 61 20 22 64 65 :lookup data "de
90f0: 66 61 75 6c 74 22 20 28 61 72 67 73 3a 67 65 74 fault" (args:get
9100: 2d 61 72 67 20 22 2d 76 61 72 22 29 29 29 29 29 -arg "-var")))))
9110: 0a 09 20 20 20 20 28 69 66 20 76 61 6c 20 28 70 .. (if val (p
9120: 72 69 6e 74 20 76 61 6c 29 29 29 29 0a 09 20 28 rint val)))).. (
9130: 28 6f 72 20 28 6e 6f 74 20 28 61 72 67 73 3a 67 (or (not (args:g
9140: 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 et-arg "-dumpmod
9150: 65 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 e")).
9160: 20 20 20 28 73 74 72 69 6e 67 3d 3f 20 28 61 72 (string=? (ar
9170: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d gs:get-arg "-dum
9180: 70 6d 6f 64 65 22 29 20 22 69 6e 69 22 29 29 0a pmode") "ini")).
9190: 09 20 20 28 63 6f 6e 66 69 67 66 3a 63 6f 6e 66 . (configf:conf
91a0: 69 67 2d 3e 69 6e 69 20 64 61 74 61 29 29 0a 09 ig->ini data))..
91b0: 20 28 28 73 74 72 69 6e 67 3d 3f 20 28 61 72 67 ((string=? (arg
91c0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 s:get-arg "-dump
91d0: 6d 6f 64 65 22 29 20 22 73 65 78 70 22 29 0a 09 mode") "sexp")..
91e0: 20 20 28 70 70 20 28 68 61 73 68 2d 74 61 62 6c (pp (hash-tabl
91f0: 65 2d 3e 61 6c 69 73 74 20 64 61 74 61 29 29 29 e->alist data)))
9200: 0a 09 20 28 28 73 74 72 69 6e 67 3d 3f 20 28 61 .. ((string=? (a
9210: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 rgs:get-arg "-du
9220: 6d 70 6d 6f 64 65 22 29 20 22 6a 73 6f 6e 22 29 mpmode") "json")
9230: 0a 09 20 20 28 6a 73 6f 6e 2d 77 72 69 74 65 20 .. (json-write
9240: 64 61 74 61 29 29 0a 09 20 28 65 6c 73 65 0a 09 data)).. (else..
9250: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 (debug:print-e
9260: 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d rror 0 *default-
9270: 6c 6f 67 2d 70 6f 72 74 2a 20 22 2d 64 75 6d 70 log-port* "-dump
9280: 6d 6f 64 65 20 6f 66 20 22 20 28 61 72 67 73 3a mode of " (args:
9290: 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f get-arg "-dumpmo
92a0: 64 65 22 29 20 22 20 6e 6f 74 20 72 65 63 6f 67 de") " not recog
92b0: 6e 69 73 65 64 22 29 29 29 0a 09 28 73 65 74 21 nised")))..(set!
92c0: 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 *didsomething*
92d0: 23 74 29 29 0a 20 20 20 20 20 20 28 70 6f 70 2d #t)). (pop-
92e0: 64 69 72 65 63 74 6f 72 79 29 29 29 0a 0a 28 69 directory)))..(i
92f0: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
9300: 22 2d 73 68 6f 77 2d 63 6f 6e 66 69 67 22 29 0a "-show-config").
9310: 20 20 20 20 28 6c 65 74 20 28 28 74 6c 20 20 20 (let ((tl
9320: 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 0a (launch:setup)).
9330: 09 20 20 28 64 61 74 61 20 2a 63 6f 6e 66 69 67 . (data *config
9340: 64 61 74 2a 29 29 20 3b 3b 20 28 72 65 61 64 2d dat*)) ;; (read-
9350: 63 6f 6e 66 69 67 20 22 6d 65 67 61 74 65 73 74 config "megatest
9360: 2e 63 6f 6e 66 69 67 22 20 23 66 20 23 74 29 29 .config" #f #t))
9370: 29 0a 20 20 20 20 20 20 28 70 75 73 68 2d 64 69 ). (push-di
9380: 72 65 63 74 6f 72 79 20 2a 74 6f 70 70 61 74 68 rectory *toppath
9390: 2a 29 0a 20 20 20 20 20 20 3b 3b 20 6b 65 65 70 *). ;; keep
93a0: 20 74 68 69 73 20 6f 6e 65 20 6c 6f 63 61 6c 0a this one local.
93b0: 20 20 20 20 20 20 28 63 6f 6e 64 20 0a 20 20 20 (cond .
93c0: 20 20 20 20 28 28 61 6e 64 20 28 61 72 67 73 3a ((and (args:
93d0: 67 65 74 2d 61 72 67 20 22 2d 73 65 63 74 69 6f get-arg "-sectio
93e0: 6e 22 29 0a 09 20 20 20 20 20 28 61 72 67 73 3a n").. (args:
93f0: 67 65 74 2d 61 72 67 20 22 2d 76 61 72 22 29 29 get-arg "-var"))
9400: 0a 09 28 6c 65 74 20 28 28 76 61 6c 20 28 63 6f ..(let ((val (co
9410: 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 64 61 74 nfigf:lookup dat
9420: 61 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 a (args:get-arg
9430: 22 2d 73 65 63 74 69 6f 6e 22 29 28 61 72 67 73 "-section")(args
9440: 3a 67 65 74 2d 61 72 67 20 22 2d 76 61 72 22 29 :get-arg "-var")
9450: 29 29 29 0a 09 20 20 28 69 66 20 76 61 6c 20 28 ))).. (if val (
9460: 70 72 69 6e 74 20 76 61 6c 29 29 29 29 0a 0a 20 print val))))..
9470: 20 20 20 20 20 20 3b 3b 20 70 72 69 6e 74 20 6a ;; print j
9480: 75 73 74 20 61 20 73 65 63 74 69 6f 6e 20 69 66 ust a section if
9490: 20 6f 6e 6c 79 20 2d 73 65 63 74 69 6f 6e 0a 0a only -section..
94a0: 20 20 20 20 20 20 20 28 28 6e 6f 74 20 28 61 72 ((not (ar
94b0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d gs:get-arg "-dum
94c0: 70 6d 6f 64 65 22 29 29 0a 09 28 70 70 20 28 68 pmode"))..(pp (h
94d0: 61 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 ash-table->alist
94e0: 20 64 61 74 61 29 29 29 0a 20 20 20 20 20 20 20 data))).
94f0: 28 28 73 74 72 69 6e 67 3d 3f 20 28 61 72 67 73 ((string=? (args
9500: 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d :get-arg "-dumpm
9510: 6f 64 65 22 29 20 22 6a 73 6f 6e 22 29 0a 09 28 ode") "json")..(
9520: 6a 73 6f 6e 2d 77 72 69 74 65 20 64 61 74 61 29 json-write data)
9530: 29 0a 20 20 20 20 20 20 20 28 28 73 74 72 69 6e ). ((strin
9540: 67 3d 3f 20 28 61 72 67 73 3a 67 65 74 2d 61 72 g=? (args:get-ar
9550: 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 g "-dumpmode") "
9560: 69 6e 69 22 29 0a 09 28 63 6f 6e 66 69 67 66 3a ini")..(configf:
9570: 63 6f 6e 66 69 67 2d 3e 69 6e 69 20 64 61 74 61 config->ini data
9580: 29 29 0a 20 20 20 20 20 20 20 28 65 6c 73 65 0a )). (else.
9590: 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 .(debug:print-er
95a0: 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
95b0: 6f 67 2d 70 6f 72 74 2a 20 22 2d 64 75 6d 70 6d og-port* "-dumpm
95c0: 6f 64 65 20 6f 66 20 22 20 28 61 72 67 73 3a 67 ode of " (args:g
95d0: 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 et-arg "-dumpmod
95e0: 65 22 29 20 22 20 6e 6f 74 20 72 65 63 6f 67 6e e") " not recogn
95f0: 69 73 65 64 22 29 29 29 0a 20 20 20 20 20 20 28 ised"))). (
9600: 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
9610: 6e 67 2a 20 23 74 29 0a 20 20 20 20 20 20 28 70 ng* #t). (p
9620: 6f 70 2d 64 69 72 65 63 74 6f 72 79 29 0a 20 20 op-directory).
9630: 20 20 20 20 28 73 65 74 21 20 2a 74 69 6d 65 2d (set! *time-
9640: 74 6f 2d 65 78 69 74 2a 20 23 74 29 29 29 0a 0a to-exit* #t)))..
9650: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
9660: 67 20 22 2d 73 68 6f 77 2d 63 6d 64 69 6e 66 6f g "-show-cmdinfo
9670: 22 29 0a 20 20 20 20 28 69 66 20 28 6f 72 20 28 "). (if (or (
9680: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 76 args:get-arg ":v
9690: 61 6c 75 65 22 29 28 67 65 74 65 6e 76 20 22 4d alue")(getenv "M
96a0: 54 5f 43 4d 44 49 4e 46 4f 22 29 29 0a 09 28 6c T_CMDINFO"))..(l
96b0: 65 74 20 28 28 64 61 74 61 20 28 63 6f 6d 6d 6f et ((data (commo
96c0: 6e 3a 72 65 61 64 2d 65 6e 63 6f 64 65 64 2d 73 n:read-encoded-s
96d0: 74 72 69 6e 67 20 28 6f 72 20 28 61 72 67 73 3a tring (or (args:
96e0: 67 65 74 2d 61 72 67 20 22 3a 76 61 6c 75 65 22 get-arg ":value"
96f0: 29 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 )(getenv "MT_CMD
9700: 49 4e 46 4f 22 29 29 29 29 29 0a 09 20 20 28 69 INFO"))))).. (i
9710: 66 20 28 65 71 75 61 6c 3f 20 28 61 72 67 73 3a f (equal? (args:
9720: 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f get-arg "-dumpmo
9730: 64 65 22 29 20 22 6a 73 6f 6e 22 29 0a 09 20 20 de") "json")..
9740: 20 20 20 20 28 6a 73 6f 6e 2d 77 72 69 74 65 20 (json-write
9750: 64 61 74 61 29 0a 09 20 20 20 20 20 20 28 70 70 data).. (pp
9760: 20 64 61 74 61 29 29 0a 09 20 20 28 73 65 74 21 data)).. (set!
9770: 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 *didsomething*
9780: 23 74 29 29 0a 09 28 64 65 62 75 67 3a 70 72 69 #t))..(debug:pri
9790: 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 nt-info 0 *defau
97a0: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 65 6e lt-log-port* "en
97b0: 76 69 72 6f 6e 6d 65 6e 74 20 76 61 72 69 61 62 vironment variab
97c0: 6c 65 20 4d 54 5f 43 4d 44 49 4e 46 4f 20 69 73 le MT_CMDINFO is
97d0: 20 6e 6f 74 20 73 65 74 22 29 29 29 0a 0a 3b 3b not set")))..;;
97e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
97f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9800: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9810: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9820: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 52 65 6d 6f 76 65 ======.;; Remove
9830: 20 6f 6c 64 20 72 75 6e 28 73 29 0a 3b 3b 3d 3d old run(s).;;==
9840: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9850: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9860: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9870: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9880: 3d 3d 3d 3d 0a 0a 3b 3b 20 73 69 6e 63 65 20 73 ====..;; since s
9890: 65 76 65 72 61 6c 20 61 63 74 69 6f 6e 73 20 63 everal actions c
98a0: 61 6e 20 62 65 20 73 70 65 63 69 66 69 65 64 20 an be specified
98b0: 6f 6e 20 74 68 65 20 63 6f 6d 6d 61 6e 64 20 6c on the command l
98c0: 69 6e 65 20 74 68 65 20 72 65 6d 6f 76 61 6c 0a ine the removal.
98d0: 3b 3b 20 69 73 20 64 6f 6e 65 20 66 69 72 73 74 ;; is done first
98e0: 0a 28 64 65 66 69 6e 65 20 28 6f 70 65 72 61 74 .(define (operat
98f0: 65 2d 6f 6e 20 61 63 74 69 6f 6e 20 23 21 6b 65 e-on action #!ke
9900: 79 20 28 6d 6f 64 65 20 23 66 29 29 20 3b 3b 20 y (mode #f)) ;;
9910: 23 66 20 69 73 20 22 75 73 65 20 64 65 66 61 75 #f is "use defau
9920: 6c 74 22 0a 20 20 28 6c 65 74 2a 20 28 28 72 75 lt". (let* ((ru
9930: 6e 72 65 63 20 28 72 75 6e 73 3a 72 75 6e 72 65 nrec (runs:runre
9940: 63 2d 6d 61 6b 65 2d 72 65 63 6f 72 64 29 29 0a c-make-record)).
9950: 09 20 28 74 61 72 67 65 74 20 28 63 6f 6d 6d 6f . (target (commo
9960: 6e 3a 61 72 67 73 2d 67 65 74 2d 74 61 72 67 65 n:args-get-targe
9970: 74 29 29 29 0a 20 20 20 20 28 63 6f 6e 64 0a 20 t))). (cond.
9980: 20 20 20 20 28 28 6e 6f 74 20 74 61 72 67 65 74 ((not target
9990: 29 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 ). (debug:p
99a0: 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 rint-error 0 *de
99b0: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
99c0: 22 4d 69 73 73 69 6e 67 20 72 65 71 75 69 72 65 "Missing require
99d0: 64 20 70 61 72 61 6d 65 74 65 72 20 66 6f 72 20 d parameter for
99e0: 22 20 61 63 74 69 6f 6e 20 22 2c 20 79 6f 75 20 " action ", you
99f0: 6d 75 73 74 20 73 70 65 63 69 66 79 20 2d 74 61 must specify -ta
9a00: 72 67 65 74 20 6f 72 20 2d 72 65 71 74 61 72 67 rget or -reqtarg
9a10: 22 29 0a 20 20 20 20 20 20 28 65 78 69 74 20 31 "). (exit 1
9a20: 29 29 0a 20 20 20 20 20 28 28 6e 6f 74 20 28 6f )). ((not (o
9a30: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
9a40: 22 3a 72 75 6e 6e 61 6d 65 22 29 0a 09 20 20 20 ":runname")..
9a50: 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
9a60: 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 29 29 0a g "-runname"))).
9a70: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
9a80: 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 nt-error 0 *defa
9a90: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4d ult-log-port* "M
9aa0: 69 73 73 69 6e 67 20 72 65 71 75 69 72 65 64 20 issing required
9ab0: 70 61 72 61 6d 65 74 65 72 20 66 6f 72 20 22 20 parameter for "
9ac0: 61 63 74 69 6f 6e 20 22 2c 20 79 6f 75 20 6d 75 action ", you mu
9ad0: 73 74 20 73 70 65 63 69 66 79 20 74 68 65 20 72 st specify the r
9ae0: 75 6e 20 6e 61 6d 65 20 70 61 74 74 65 72 6e 20 un name pattern
9af0: 77 69 74 68 20 2d 72 75 6e 6e 61 6d 65 20 70 61 with -runname pa
9b00: 74 74 22 29 0a 20 20 20 20 20 20 28 65 78 69 74 tt"). (exit
9b10: 20 32 29 29 0a 20 20 20 20 20 28 28 6e 6f 74 20 2)). ((not
9b20: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
9b30: 74 65 73 74 70 61 74 74 22 29 29 0a 20 20 20 20 testpatt")).
9b40: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 (debug:print-e
9b50: 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d rror 0 *default-
9b60: 6c 6f 67 2d 70 6f 72 74 2a 20 22 4d 69 73 73 69 log-port* "Missi
9b70: 6e 67 20 72 65 71 75 69 72 65 64 20 70 61 72 61 ng required para
9b80: 6d 65 74 65 72 20 66 6f 72 20 22 20 61 63 74 69 meter for " acti
9b90: 6f 6e 20 22 2c 20 79 6f 75 20 6d 75 73 74 20 73 on ", you must s
9ba0: 70 65 63 69 66 79 20 74 68 65 20 74 65 73 74 20 pecify the test
9bb0: 70 61 74 74 65 72 6e 20 77 69 74 68 20 2d 74 65 pattern with -te
9bc0: 73 74 70 61 74 74 22 29 0a 20 20 20 20 20 20 28 stpatt"). (
9bd0: 65 78 69 74 20 33 29 29 0a 20 20 20 20 20 28 65 exit 3)). (e
9be0: 6c 73 65 0a 20 20 20 20 20 20 28 69 66 20 28 6e lse. (if (n
9bf0: 6f 74 20 28 63 61 72 20 2a 63 6f 6e 66 69 67 69 ot (car *configi
9c00: 6e 66 6f 2a 29 29 0a 09 20 20 28 62 65 67 69 6e nfo*)).. (begin
9c10: 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 .. (debug:pri
9c20: 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 nt-error 0 *defa
9c30: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 41 ult-log-port* "A
9c40: 74 74 65 6d 70 74 65 64 20 22 20 61 63 74 69 6f ttempted " actio
9c50: 6e 20 22 6f 6e 20 74 65 73 74 28 73 29 20 62 75 n "on test(s) bu
9c60: 74 20 72 75 6e 20 61 72 65 61 20 63 6f 6e 66 69 t run area confi
9c70: 67 20 66 69 6c 65 20 6e 6f 74 20 66 6f 75 6e 64 g file not found
9c80: 22 29 0a 09 20 20 20 20 28 65 78 69 74 20 31 29 ").. (exit 1)
9c90: 29 0a 09 20 20 3b 3b 20 70 75 74 20 74 65 73 74 ).. ;; put test
9ca0: 20 70 61 72 61 6d 65 74 65 72 73 20 69 6e 74 6f parameters into
9cb0: 20 63 6f 6e 76 65 6e 69 65 6e 74 20 76 61 72 69 convenient vari
9cc0: 61 62 6c 65 73 0a 09 20 20 28 62 65 67 69 6e 0a ables.. (begin.
9cd0: 09 20 20 20 20 3b 3b 20 63 68 65 63 6b 20 66 6f . ;; check fo
9ce0: 72 20 63 6f 72 72 65 63 74 20 76 65 72 73 69 6f r correct versio
9cf0: 6e 2c 20 65 78 69 74 20 77 69 74 68 20 6d 65 73 n, exit with mes
9d00: 73 61 67 65 20 69 66 20 6e 6f 74 20 63 6f 72 72 sage if not corr
9d10: 65 63 74 0a 09 20 20 20 20 28 63 6f 6d 6d 6f 6e ect.. (common
9d20: 3a 65 78 69 74 2d 6f 6e 2d 76 65 72 73 69 6f 6e :exit-on-version
9d30: 2d 63 68 61 6e 67 65 64 29 0a 09 20 20 20 20 28 -changed).. (
9d40: 72 75 6e 73 3a 6f 70 65 72 61 74 65 2d 6f 6e 20 runs:operate-on
9d50: 20 61 63 74 69 6f 6e 0a 09 09 09 20 20 20 20 20 action....
9d60: 20 74 61 72 67 65 74 0a 09 09 09 20 20 20 20 20 target....
9d70: 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 (common:args-ge
9d80: 74 2d 72 75 6e 6e 61 6d 65 29 20 20 3b 3b 20 28 t-runname) ;; (
9d90: 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 or (args:get-arg
9da0: 20 22 2d 72 75 6e 6e 61 6d 65 22 29 28 61 72 67 "-runname")(arg
9db0: 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e s:get-arg ":runn
9dc0: 61 6d 65 22 29 29 0a 09 09 09 20 20 20 20 20 20 ame"))....
9dd0: 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 (common:args-get
9de0: 2d 74 65 73 74 70 61 74 74 20 23 66 29 20 3b 3b -testpatt #f) ;;
9df0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
9e00: 2d 74 65 73 74 70 61 74 74 22 29 0a 09 09 09 20 -testpatt")....
9e10: 20 20 20 20 20 73 74 61 74 65 3a 20 28 63 6f 6d state: (com
9e20: 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 73 74 61 mon:args-get-sta
9e30: 74 65 29 0a 09 09 09 20 20 20 20 20 20 73 74 61 te).... sta
9e40: 74 75 73 3a 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 tus: (common:arg
9e50: 73 2d 67 65 74 2d 73 74 61 74 75 73 29 0a 09 09 s-get-status)...
9e60: 09 20 20 20 20 20 20 6e 65 77 2d 73 74 61 74 65 . new-state
9e70: 2d 73 74 61 74 75 73 3a 20 28 61 72 67 73 3a 67 -status: (args:g
9e80: 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 73 74 61 et-arg "-set-sta
9e90: 74 65 2d 73 74 61 74 75 73 22 29 0a 20 20 20 20 te-status").
9ea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9eb0: 20 20 20 20 20 20 20 20 20 20 6d 6f 64 65 3a 20 mode:
9ec0: 6d 6f 64 65 29 29 29 0a 20 20 20 20 20 20 28 73 mode))). (s
9ed0: 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
9ee0: 67 2a 20 23 74 29 29 29 29 29 0a 0a 28 69 66 20 g* #t)))))..(if
9ef0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
9f00: 72 65 6d 6f 76 65 2d 72 75 6e 73 22 29 0a 20 20 remove-runs").
9f10: 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 (general-run-c
9f20: 61 6c 6c 20 0a 20 20 20 20 20 22 2d 72 65 6d 6f all . "-remo
9f30: 76 65 2d 72 75 6e 73 22 0a 20 20 20 20 20 22 72 ve-runs". "r
9f40: 65 6d 6f 76 65 20 72 75 6e 73 22 0a 20 20 20 20 emove runs".
9f50: 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 (lambda (target
9f60: 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 runname keys ke
9f70: 79 76 61 6c 73 29 0a 20 20 20 20 20 20 20 28 6f yvals). (o
9f80: 70 65 72 61 74 65 2d 6f 6e 20 27 72 65 6d 6f 76 perate-on 'remov
9f90: 65 2d 72 75 6e 73 20 6d 6f 64 65 3a 20 28 69 66 e-runs mode: (if
9fa0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
9fb0: 2d 6b 65 65 70 2d 72 65 63 6f 72 64 73 22 29 0a -keep-records").
9fc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9fd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9fe0: 20 20 20 20 20 20 20 20 20 20 27 72 65 6d 6f 76 'remov
9ff0: 65 2d 64 61 74 61 2d 6f 6e 6c 79 0a 20 20 20 20 e-data-only.
a000: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a010: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a020: 20 20 20 20 20 20 27 72 65 6d 6f 76 65 2d 61 6c 'remove-al
a030: 6c 29 29 29 29 29 0a 0a 28 69 66 20 28 61 72 67 l)))))..(if (arg
a040: 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 2d s:get-arg "-set-
a050: 73 74 61 74 65 2d 73 74 61 74 75 73 22 29 0a 20 state-status").
a060: 20 20 20 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d (general-run-
a070: 63 61 6c 6c 20 0a 20 20 20 20 20 22 2d 73 65 74 call . "-set
a080: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 22 0a 20 -state-status".
a090: 20 20 20 20 22 73 65 74 20 73 74 61 74 65 20 61 "set state a
a0a0: 6e 64 20 73 74 61 74 75 73 22 0a 20 20 20 20 20 nd status".
a0b0: 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 (lambda (target
a0c0: 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 runname keys key
a0d0: 76 61 6c 73 29 0a 20 20 20 20 20 20 20 28 6f 70 vals). (op
a0e0: 65 72 61 74 65 2d 6f 6e 20 27 73 65 74 2d 73 74 erate-on 'set-st
a0f0: 61 74 65 2d 73 74 61 74 75 73 29 29 29 29 0a 0a ate-status))))..
a100: 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 (if (or (args:ge
a110: 74 2d 61 72 67 20 22 2d 73 65 74 2d 72 75 6e 2d t-arg "-set-run-
a120: 73 74 61 74 75 73 22 29 0a 09 28 61 72 67 73 3a status")..(args:
a130: 67 65 74 2d 61 72 67 20 22 2d 67 65 74 2d 72 75 get-arg "-get-ru
a140: 6e 2d 73 74 61 74 75 73 22 29 29 0a 20 20 20 20 n-status")).
a150: 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c (general-run-cal
a160: 6c 0a 20 20 20 20 20 22 2d 73 65 74 2d 72 75 6e l. "-set-run
a170: 2d 73 74 61 74 75 73 22 0a 20 20 20 20 20 22 73 -status". "s
a180: 65 74 20 72 75 6e 20 73 74 61 74 75 73 22 0a 20 et run status".
a190: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 72 (lambda (tar
a1a0: 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 get runname keys
a1b0: 20 6b 65 79 76 61 6c 73 29 0a 20 20 20 20 20 20 keyvals).
a1c0: 20 28 6c 65 74 2a 20 28 28 72 75 6e 73 64 61 74 (let* ((runsdat
a1d0: 20 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e 73 2d (rmt:get-runs-
a1e0: 62 79 2d 70 61 74 74 20 6b 65 79 73 20 72 75 6e by-patt keys run
a1f0: 6e 61 6d 65 20 0a 09 09 09 09 09 28 63 6f 6d 6d name ......(comm
a200: 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 61 72 67 on:args-get-targ
a210: 65 74 29 0a 09 09 09 09 09 23 66 20 23 66 20 23 et)......#f #f #
a220: 66 20 23 66 29 29 0a 09 20 20 20 20 20 20 28 68 f #f)).. (h
a230: 65 61 64 65 72 20 20 20 28 76 65 63 74 6f 72 2d eader (vector-
a240: 72 65 66 20 72 75 6e 73 64 61 74 20 30 29 29 0a ref runsdat 0)).
a250: 09 20 20 20 20 20 20 28 72 6f 77 73 20 20 20 20 . (rows
a260: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 75 6e (vector-ref run
a270: 73 64 61 74 20 31 29 29 29 0a 09 20 28 69 66 20 sdat 1))).. (if
a280: 28 6e 75 6c 6c 3f 20 72 6f 77 73 29 0a 09 20 20 (null? rows)..
a290: 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 (begin..
a2a0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
a2b0: 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c nfo 0 *default-l
a2c0: 6f 67 2d 70 6f 72 74 2a 20 22 4e 6f 20 6d 61 74 og-port* "No mat
a2d0: 63 68 69 6e 67 20 72 75 6e 20 66 6f 75 6e 64 2e ching run found.
a2e0: 22 29 0a 09 20 20 20 20 20 20 20 28 65 78 69 74 ").. (exit
a2f0: 20 31 29 29 0a 09 20 20 20 20 20 28 6c 65 74 2a 1)).. (let*
a300: 20 28 28 72 6f 77 20 20 20 20 20 20 28 63 61 72 ((row (car
a310: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 75 6e (vector-ref run
a320: 73 64 61 74 20 31 29 29 29 0a 09 09 20 20 20 20 sdat 1)))...
a330: 28 72 75 6e 2d 69 64 20 20 20 28 64 62 3a 67 65 (run-id (db:ge
a340: 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 t-value-by-heade
a350: 72 20 72 6f 77 20 68 65 61 64 65 72 20 22 69 64 r row header "id
a360: 22 29 29 29 0a 09 20 20 20 20 20 20 20 28 69 66 "))).. (if
a370: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
a380: 2d 73 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 22 -set-run-status"
a390: 29 0a 09 09 20 20 20 28 72 6d 74 3a 73 65 74 2d )... (rmt:set-
a3a0: 72 75 6e 2d 73 74 61 74 75 73 20 72 75 6e 2d 69 run-status run-i
a3b0: 64 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 d (args:get-arg
a3c0: 22 2d 73 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 "-set-run-status
a3d0: 22 29 20 6d 73 67 3a 20 28 61 72 67 73 3a 67 65 ") msg: (args:ge
a3e0: 74 2d 61 72 67 20 22 2d 6d 22 29 29 0a 09 09 20 t-arg "-m"))...
a3f0: 20 20 28 70 72 69 6e 74 20 28 72 6d 74 3a 67 65 (print (rmt:ge
a400: 74 2d 72 75 6e 2d 73 74 61 74 75 73 20 72 75 6e t-run-status run
a410: 2d 69 64 29 29 0a 09 09 20 20 20 29 29 29 29 29 -id))... )))))
a420: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
a430: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a440: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a450: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a460: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
a470: 51 75 65 72 79 20 72 75 6e 73 0a 3b 3b 3d 3d 3d Query runs.;;===
a480: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a490: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a4a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a4b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a4c0: 3d 3d 3d 0a 0a 3b 3b 20 2d 66 69 65 6c 64 73 20 ===..;; -fields
a4d0: 72 75 6e 73 3a 69 64 2c 74 61 72 67 65 74 2c 72 runs:id,target,r
a4e0: 75 6e 6e 61 6d 65 2c 63 6f 6d 6d 65 6e 74 2b 74 unname,comment+t
a4f0: 65 73 74 73 3a 69 64 2c 74 65 73 74 6e 61 6d 65 ests:id,testname
a500: 2c 69 74 65 6d 5f 70 61 74 68 2b 73 74 65 70 73 ,item_path+steps
a510: 0a 3b 3b 0a 3b 3b 20 63 73 69 3e 20 28 65 78 74 .;;.;; csi> (ext
a520: 72 61 63 74 2d 66 69 65 6c 64 73 2d 63 6f 6e 73 ract-fields-cons
a530: 74 72 61 69 6e 74 73 20 22 72 75 6e 73 3a 69 64 traints "runs:id
a540: 2c 74 61 72 67 65 74 2c 72 75 6e 6e 61 6d 65 2c ,target,runname,
a550: 63 6f 6d 6d 65 6e 74 2b 74 65 73 74 73 3a 69 64 comment+tests:id
a560: 2c 74 65 73 74 6e 61 6d 65 2c 69 74 65 6d 5f 70 ,testname,item_p
a570: 61 74 68 2b 73 74 65 70 73 22 29 0a 3b 3b 20 20 ath+steps").;;
a580: 20 20 20 20 20 20 20 3d 3e 20 28 28 22 72 75 6e => (("run
a590: 73 22 20 22 69 64 22 20 22 74 61 72 67 65 74 22 s" "id" "target"
a5a0: 20 22 72 75 6e 6e 61 6d 65 22 20 22 63 6f 6d 6d "runname" "comm
a5b0: 65 6e 74 22 29 20 28 22 74 65 73 74 73 22 20 22 ent") ("tests" "
a5c0: 69 64 22 20 22 74 65 73 74 6e 61 6d 65 22 20 22 id" "testname" "
a5d0: 69 74 65 6d 5f 70 61 74 68 22 29 20 28 22 73 74 item_path") ("st
a5e0: 65 70 73 22 29 29 0a 3b 3b 0a 3b 3b 20 20 20 4e eps")).;;.;; N
a5f0: 4f 54 45 3a 20 72 65 6d 65 6d 62 65 72 20 74 68 OTE: remember th
a600: 61 74 20 74 68 65 20 63 64 72 20 77 69 6c 6c 20 at the cdr will
a610: 62 65 20 74 68 65 20 6c 69 73 74 20 79 6f 75 20 be the list you
a620: 65 78 70 65 63 74 20 28 63 64 72 20 28 22 72 75 expect (cdr ("ru
a630: 6e 73 22 20 22 69 64 22 20 22 74 61 72 67 65 74 ns" "id" "target
a640: 22 20 22 72 75 6e 6e 61 6d 65 22 20 22 63 6f 6d " "runname" "com
a650: 6d 65 6e 74 22 29 29 20 3d 3e 20 28 22 69 64 22 ment")) => ("id"
a660: 20 22 74 61 72 67 65 74 22 20 22 72 75 6e 6e 61 "target" "runna
a670: 6d 65 22 20 22 63 6f 6d 6d 65 6e 74 22 29 0a 3b me" "comment").;
a680: 3b 20 20 20 20 20 20 20 20 20 61 6e 64 20 73 6f ; and so
a690: 20 61 6c 69 73 74 2d 72 65 66 20 77 69 6c 6c 20 alist-ref will
a6a0: 79 69 65 6c 64 20 77 68 61 74 20 79 6f 75 20 65 yield what you e
a6b0: 78 70 65 63 74 0a 3b 3b 0a 28 64 65 66 69 6e 65 xpect.;;.(define
a6c0: 20 28 65 78 74 72 61 63 74 2d 66 69 65 6c 64 73 (extract-fields
a6d0: 2d 63 6f 6e 73 74 72 61 69 6e 74 73 20 66 69 65 -constraints fie
a6e0: 6c 64 73 2d 73 70 65 63 29 0a 20 20 28 6d 61 70 lds-spec). (map
a6f0: 20 28 6c 61 6d 62 64 61 20 28 74 61 62 6c 65 2d (lambda (table-
a700: 73 70 65 63 29 20 3b 3b 20 72 75 6e 73 3a 69 64 spec) ;; runs:id
a710: 2c 74 61 72 67 65 74 2c 72 75 6e 6e 61 6d 65 0a ,target,runname.
a720: 09 20 28 6c 65 74 20 28 28 64 61 74 20 28 73 74 . (let ((dat (st
a730: 72 69 6e 67 2d 73 70 6c 69 74 20 74 61 62 6c 65 ring-split table
a740: 2d 73 70 65 63 20 22 3a 22 29 29 29 20 3b 3b 20 -spec ":"))) ;;
a750: 28 22 72 75 6e 73 22 20 22 69 64 2c 74 61 72 67 ("runs" "id,targ
a760: 65 74 2c 72 75 6e 6e 61 6d 65 22 29 0a 09 20 20 et,runname")..
a770: 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 (if (> (length
a780: 64 61 74 29 20 31 29 0a 09 20 20 20 20 20 20 20 dat) 1)..
a790: 28 63 6f 6e 73 20 28 63 61 72 20 64 61 74 29 28 (cons (car dat)(
a7a0: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 63 61 string-split (ca
a7b0: 64 72 20 64 61 74 29 20 22 2c 22 29 29 20 3b 3b dr dat) ",")) ;;
a7c0: 20 22 69 64 2c 74 61 72 67 65 74 2c 72 75 6e 6e "id,target,runn
a7d0: 61 6d 65 22 0a 09 20 20 20 20 20 20 20 64 61 74 ame".. dat
a7e0: 29 29 29 0a 20 20 20 20 20 20 20 28 73 74 72 69 ))). (stri
a7f0: 6e 67 2d 73 70 6c 69 74 20 66 69 65 6c 64 73 2d ng-split fields-
a800: 73 70 65 63 20 22 2b 22 29 29 29 0a 0a 28 64 65 spec "+")))..(de
a810: 66 69 6e 65 20 28 67 65 74 2d 76 61 6c 75 65 2d fine (get-value-
a820: 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 64 61 74 by-fieldname dat
a830: 61 76 65 63 20 74 65 73 74 2d 66 69 65 6c 64 2d avec test-field-
a840: 69 6e 64 65 78 20 66 69 65 6c 64 6e 61 6d 65 29 index fieldname)
a850: 0a 20 20 28 6c 65 74 20 28 28 69 6e 64 78 20 28 . (let ((indx (
a860: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
a870: 65 66 61 75 6c 74 20 74 65 73 74 2d 66 69 65 6c efault test-fiel
a880: 64 2d 69 6e 64 65 78 20 66 69 65 6c 64 6e 61 6d d-index fieldnam
a890: 65 20 23 66 29 29 29 0a 20 20 20 20 28 69 66 20 e #f))). (if
a8a0: 69 6e 64 78 0a 09 28 69 66 20 28 3e 3d 20 69 6e indx..(if (>= in
a8b0: 64 78 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74 dx (vector-lengt
a8c0: 68 20 64 61 74 61 76 65 63 29 29 0a 09 20 20 20 h datavec))..
a8d0: 20 23 66 20 3b 3b 20 69 6e 64 65 78 20 74 6f 6f #f ;; index too
a8e0: 20 68 69 67 68 2c 20 73 68 6f 75 6c 64 20 72 61 high, should ra
a8f0: 69 73 65 20 61 6e 20 65 72 72 6f 72 20 49 20 73 ise an error I s
a900: 75 70 70 6f 73 65 0a 09 20 20 20 20 28 76 65 63 uppose.. (vec
a910: 74 6f 72 2d 72 65 66 20 64 61 74 61 76 65 63 20 tor-ref datavec
a920: 69 6e 64 78 29 29 0a 09 23 66 29 29 29 0a 0a 0a indx))..#f)))...
a930: 0a 0a 0a 28 77 68 65 6e 20 28 61 72 67 73 3a 67 ...(when (args:g
a940: 65 74 2d 61 72 67 20 22 2d 74 65 73 74 64 61 74 et-arg "-testdat
a950: 61 2d 63 73 76 22 29 0a 20 20 28 69 66 20 28 6c a-csv"). (if (l
a960: 61 75 6e 63 68 3a 73 65 74 75 70 29 0a 20 20 20 aunch:setup).
a970: 20 20 20 28 6c 65 74 2a 20 28 28 6b 65 79 73 20 (let* ((keys
a980: 20 20 20 20 20 20 20 28 72 6d 74 3a 67 65 74 2d (rmt:get-
a990: 6b 65 79 73 29 29 20 3b 3b 20 28 64 62 3a 67 65 keys)) ;; (db:ge
a9a0: 74 2d 6b 65 79 73 20 64 62 73 74 72 75 63 74 29 t-keys dbstruct)
a9b0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ). (
a9c0: 72 75 6e 70 61 74 74 20 20 20 20 20 28 6f 72 20 runpatt (or
a9d0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
a9e0: 72 75 6e 6e 61 6d 65 22 29 20 22 25 22 29 29 0a runname") "%")).
a9f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 74 65 (te
aa00: 73 74 70 61 74 74 20 20 20 20 28 63 6f 6d 6d 6f stpatt (commo
aa10: 6e 3a 61 72 67 73 2d 67 65 74 2d 74 65 73 74 70 n:args-get-testp
aa20: 61 74 74 20 23 66 29 29 0a 20 20 20 20 20 20 20 att #f)).
aa30: 20 20 20 20 20 20 28 64 61 74 61 70 61 74 74 20 (datapatt
aa40: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
aa50: 20 22 2d 74 65 73 74 64 61 74 61 2d 63 73 76 22 "-testdata-csv"
aa60: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
aa70: 28 6d 61 74 63 68 2d 64 61 74 61 20 20 28 73 74 (match-data (st
aa80: 72 69 6e 67 2d 6d 61 74 63 68 20 22 5e 28 5b 5e ring-match "^([^
aa90: 2f 5d 2b 29 2f 28 2e 2a 29 22 20 28 61 72 67 73 /]+)/(.*)" (args
aaa0: 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 64 :get-arg "-testd
aab0: 61 74 61 2d 63 73 76 22 29 29 29 0a 20 20 20 20 ata-csv"))).
aac0: 20 20 20 20 20 20 20 20 20 28 63 61 74 65 67 6f (catego
aad0: 72 79 70 61 74 74 20 28 69 66 20 6d 61 74 63 68 rypatt (if match
aae0: 2d 64 61 74 61 20 28 6c 69 73 74 2d 72 65 66 20 -data (list-ref
aaf0: 6d 61 74 63 68 2d 64 61 74 61 20 31 29 20 22 25 match-data 1) "%
ab00: 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ")).
ab10: 20 28 73 65 74 76 61 72 70 61 74 74 20 20 28 69 (setvarpatt (i
ab20: 66 20 6d 61 74 63 68 2d 64 61 74 61 0a 20 20 20 f match-data.
ab30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ab40: 20 20 20 20 20 20 20 20 20 20 20 28 6c 69 73 74 (list
ab50: 2d 72 65 66 20 6d 61 74 63 68 2d 64 61 74 61 20 -ref match-data
ab60: 32 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 2).
ab70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ab80: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
ab90: 2d 74 65 73 74 64 61 74 61 2d 63 73 76 22 29 29 -testdata-csv"))
aba0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ). (
abb0: 72 75 6e 73 64 61 74 20 20 20 20 20 28 72 6d 74 runsdat (rmt
abc0: 3a 67 65 74 2d 72 75 6e 73 2d 62 79 2d 70 61 74 :get-runs-by-pat
abd0: 74 20 6b 65 79 73 20 28 6f 72 20 72 75 6e 70 61 t keys (or runpa
abe0: 74 74 20 22 25 22 29 20 0a 20 20 20 20 20 20 20 tt "%") .
abf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ac00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ac10: 20 20 20 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e (common
ac20: 3a 61 72 67 73 2d 67 65 74 2d 74 61 72 67 65 74 :args-get-target
ac30: 29 20 23 66 20 23 66 20 27 28 22 69 64 22 20 22 ) #f #f '("id" "
ac40: 72 75 6e 6e 61 6d 65 22 20 22 73 74 61 74 65 22 runname" "state"
ac50: 20 22 73 74 61 74 75 73 22 20 22 6f 77 6e 65 72 "status" "owner
ac60: 22 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 20 22 " "event_time" "
ac70: 63 6f 6d 6d 65 6e 74 22 29 20 30 29 29 0a 20 20 comment") 0)).
ac80: 20 20 20 20 20 20 20 20 20 20 20 28 68 65 61 64 (head
ac90: 65 72 20 20 20 20 20 20 28 64 62 3a 67 65 74 2d er (db:get-
aca0: 68 65 61 64 65 72 20 72 75 6e 73 64 61 74 29 29 header runsdat))
acb0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 . (a
acc0: 63 63 65 73 73 2d 6d 6f 64 65 20 28 64 62 3a 67 ccess-mode (db:g
acd0: 65 74 2d 61 63 63 65 73 73 2d 6d 6f 64 65 29 29 et-access-mode))
ace0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 74 . (t
acf0: 65 73 74 70 61 74 74 20 20 20 20 28 63 6f 6d 6d estpatt (comm
ad00: 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 65 73 74 on:args-get-test
ad10: 70 61 74 74 20 23 66 29 29 0a 20 20 20 20 20 20 patt #f)).
ad20: 20 20 20 20 20 20 20 28 66 69 65 6c 64 73 2d 73 (fields-s
ad30: 70 65 63 20 28 69 66 20 28 61 72 67 73 3a 67 65 pec (if (args:ge
ad40: 74 2d 61 72 67 20 22 2d 66 69 65 6c 64 73 22 29 t-arg "-fields")
ad50: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
ad60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
ad70: 65 78 74 72 61 63 74 2d 66 69 65 6c 64 73 2d 63 extract-fields-c
ad80: 6f 6e 73 74 72 61 69 6e 74 73 20 28 61 72 67 73 onstraints (args
ad90: 3a 67 65 74 2d 61 72 67 20 22 2d 66 69 65 6c 64 :get-arg "-field
ada0: 73 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 s")).
adb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
adc0: 20 20 20 28 6c 69 73 74 20 28 63 6f 6e 73 20 22 (list (cons "
add0: 72 75 6e 73 22 20 28 61 70 70 65 6e 64 20 6b 65 runs" (append ke
ade0: 79 73 20 28 6c 69 73 74 20 22 69 64 22 20 22 72 ys (list "id" "r
adf0: 75 6e 6e 61 6d 65 22 20 22 73 74 61 74 65 22 20 unname" "state"
ae00: 22 73 74 61 74 75 73 22 20 22 6f 77 6e 65 72 22 "status" "owner"
ae10: 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 20 22 63 "event_time" "c
ae20: 6f 6d 6d 65 6e 74 22 20 22 66 61 69 6c 5f 63 6f omment" "fail_co
ae30: 75 6e 74 22 20 22 70 61 73 73 5f 63 6f 75 6e 74 unt" "pass_count
ae40: 22 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 "))).
ae50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ae60: 20 20 20 20 20 20 20 20 20 28 63 6f 6e 73 20 22 (cons "
ae70: 74 65 73 74 73 22 20 20 64 62 3a 74 65 73 74 2d tests" db:test-
ae80: 72 65 63 6f 72 64 2d 66 69 65 6c 64 73 29 20 3b record-fields) ;
ae90: 3b 20 22 69 64 22 20 22 74 65 73 74 6e 61 6d 65 ; "id" "testname
aea0: 22 20 22 74 65 73 74 5f 70 61 74 68 22 29 0a 20 " "test_path").
aeb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
aec0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
aed0: 20 20 20 28 6c 69 73 74 20 22 73 74 65 70 73 22 (list "steps"
aee0: 20 22 69 64 22 20 22 73 74 65 70 6e 61 6d 65 22 "id" "stepname"
aef0: 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 )))).
af00: 20 20 28 74 65 73 74 73 2d 73 70 65 63 20 20 28 (tests-spec (
af10: 6c 65 74 20 28 28 74 20 28 61 6c 69 73 74 2d 72 let ((t (alist-r
af20: 65 66 20 22 74 65 73 74 73 22 20 66 69 65 6c 64 ef "tests" field
af30: 73 2d 73 70 65 63 20 65 71 75 61 6c 3f 29 29 29 s-spec equal?)))
af40: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
af50: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 (if
af60: 20 28 61 6e 64 20 74 20 28 6e 75 6c 6c 3f 20 74 (and t (null? t
af70: 29 29 20 3b 3b 20 61 6c 6c 20 66 69 65 6c 64 73 )) ;; all fields
af80: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
af90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
afa0: 20 64 62 3a 74 65 73 74 2d 72 65 63 6f 72 64 2d db:test-record-
afb0: 66 69 65 6c 64 73 0a 20 20 20 20 20 20 20 20 20 fields.
afc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
afd0: 20 20 20 20 20 20 20 74 29 29 29 0a 20 20 20 20 t))).
afe0: 20 20 20 20 20 20 20 20 20 28 61 64 6a 2d 74 65 (adj-te
aff0: 73 74 73 2d 73 70 65 63 20 28 64 65 6c 65 74 65 sts-spec (delete
b000: 2d 64 75 70 6c 69 63 61 74 65 73 20 28 69 66 20 -duplicates (if
b010: 74 65 73 74 73 2d 73 70 65 63 20 28 63 6f 6e 73 tests-spec (cons
b020: 20 22 69 64 22 20 74 65 73 74 73 2d 73 70 65 63 "id" tests-spec
b030: 29 20 64 62 3a 74 65 73 74 2d 72 65 63 6f 72 64 ) db:test-record
b040: 2d 66 69 65 6c 64 73 29 29 29 20 0a 20 20 20 20 -fields))) .
b050: 20 20 20 20 20 20 20 20 20 28 74 65 73 74 2d 66 (test-f
b060: 69 65 6c 64 2d 69 6e 64 65 78 20 28 6d 61 6b 65 ield-index (make
b070: 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 20 20 -hash-table)).
b080: 20 20 20 20 20 20 20 20 20 20 20 28 72 75 6e 73 (runs
b090: 20 28 64 62 3a 67 65 74 2d 72 6f 77 73 20 72 75 (db:get-rows ru
b0a0: 6e 73 64 61 74 29 29 0a 20 20 20 20 20 20 20 20 nsdat)).
b0b0: 20 20 20 20 20 29 0a 20 20 20 20 20 20 20 20 28 ). (
b0c0: 69 66 20 28 61 6e 64 20 74 65 73 74 73 2d 73 70 if (and tests-sp
b0d0: 65 63 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 ec (not (null? t
b0e0: 65 73 74 73 2d 73 70 65 63 29 29 29 20 3b 3b 20 ests-spec))) ;;
b0f0: 64 6f 20 73 6f 6d 65 20 76 61 6c 69 64 61 74 69 do some validati
b100: 6f 6e 20 61 6e 64 20 70 72 6f 63 65 73 73 69 6e on and processin
b110: 67 20 6f 66 20 74 68 65 20 74 65 73 74 2d 73 70 g of the test-sp
b120: 65 63 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 ec. (
b130: 6c 65 74 20 28 28 69 6e 76 61 6c 69 64 2d 74 65 let ((invalid-te
b140: 73 74 73 2d 73 70 65 63 20 28 66 69 6c 74 65 72 sts-spec (filter
b150: 20 28 6c 61 6d 62 64 61 20 28 78 29 28 6e 6f 74 (lambda (x)(not
b160: 20 28 6d 65 6d 62 65 72 20 78 20 64 62 3a 74 65 (member x db:te
b170: 73 74 2d 72 65 63 6f 72 64 2d 66 69 65 6c 64 73 st-record-fields
b180: 29 29 29 20 74 65 73 74 73 2d 73 70 65 63 29 29 ))) tests-spec))
b190: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
b1a0: 28 69 66 20 28 6e 75 6c 6c 3f 20 69 6e 76 61 6c (if (null? inval
b1b0: 69 64 2d 74 65 73 74 73 2d 73 70 65 63 29 0a 20 id-tests-spec).
b1c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b1d0: 20 3b 3b 20 67 65 6e 65 72 61 74 65 20 74 68 65 ;; generate the
b1e0: 20 6c 6f 6f 6b 75 70 20 6d 61 70 20 74 65 73 74 lookup map test
b1f0: 2d 66 69 65 6c 64 2d 6e 61 6d 65 20 3d 3e 20 69 -field-name => i
b200: 6e 64 65 78 2d 6e 75 6d 62 65 72 0a 20 20 20 20 ndex-number.
b210: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
b220: 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 20 28 63 et loop ((hed (c
b230: 61 72 20 61 64 6a 2d 74 65 73 74 73 2d 73 70 65 ar adj-tests-spe
b240: 63 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 c)).
b250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b260: 20 28 74 61 6c 20 28 63 64 72 20 61 64 6a 2d 74 (tal (cdr adj-t
b270: 65 73 74 73 2d 73 70 65 63 29 29 0a 20 20 20 20 ests-spec)).
b280: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b290: 20 20 20 20 20 20 20 20 20 28 69 64 78 20 30 29 (idx 0)
b2a0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
b2b0: 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c (hash-tabl
b2c0: 65 2d 73 65 74 21 20 74 65 73 74 2d 66 69 65 6c e-set! test-fiel
b2d0: 64 2d 69 6e 64 65 78 20 68 65 64 20 69 64 78 29 d-index hed idx)
b2e0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
b2f0: 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6e (if (not (n
b300: 75 6c 6c 3f 20 74 61 6c 29 29 28 6c 6f 6f 70 20 ull? tal))(loop
b310: 28 63 61 72 20 74 61 6c 29 28 63 64 72 20 74 61 (car tal)(cdr ta
b320: 6c 29 28 2b 20 69 64 78 20 31 29 29 29 29 0a 20 l)(+ idx 1)))).
b330: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b340: 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 (begin.
b350: 20 20 20 20 20 20 20 20 20 20 20 20 28 64 65 62 (deb
b360: 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 ug:print-error 0
b370: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
b380: 72 74 2a 20 22 49 6e 76 61 6c 69 64 20 74 65 73 rt* "Invalid tes
b390: 74 20 66 69 65 6c 64 73 20 73 70 65 63 69 66 69 t fields specifi
b3a0: 65 64 3a 20 22 20 28 73 74 72 69 6e 67 2d 69 6e ed: " (string-in
b3b0: 74 65 72 73 70 65 72 73 65 20 69 6e 76 61 6c 69 tersperse invali
b3c0: 64 2d 74 65 73 74 73 2d 73 70 65 63 20 22 2c 20 d-tests-spec ",
b3d0: 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ")).
b3e0: 20 20 20 20 20 20 20 20 28 65 78 69 74 29 29 29 (exit)))
b3f0: 29 29 0a 20 20 20 20 20 20 20 20 28 6c 65 74 2a )). (let*
b400: 20 28 28 74 61 62 6c 65 2d 68 65 61 64 65 72 20 ((table-header
b410: 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 22 74 (string-split "t
b420: 61 72 67 65 74 2c 72 75 6e 2c 74 65 73 74 2c 69 arget,run,test,i
b430: 74 65 6d 70 61 74 68 2c 63 61 74 65 67 6f 72 79 tempath,category
b440: 2c 76 61 72 2c 76 61 6c 75 65 2c 63 6f 6d 6d 65 ,var,value,comme
b450: 6e 74 22 20 22 2c 22 29 29 0a 20 20 20 20 20 20 nt" ",")).
b460: 20 20 20 20 20 20 20 20 20 28 74 61 62 6c 65 2d (table-
b470: 72 6f 77 73 0a 20 20 20 20 20 20 20 20 20 20 20 rows.
b480: 20 20 20 20 20 28 61 70 70 6c 79 20 61 70 70 65 (apply appe
b490: 6e 64 20 28 6d 61 70 20 20 0a 20 20 20 20 20 20 nd (map .
b4a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b4b0: 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 (lambda
b4c0: 20 28 72 75 6e 29 0a 20 20 20 20 20 20 20 20 20 (run).
b4d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b4e0: 20 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 (let* ((
b4f0: 74 61 72 67 65 74 20 28 73 74 72 69 6e 67 2d 69 target (string-i
b500: 6e 74 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 ntersperse (map
b510: 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 09 (lambda (x).....
b520: 09 09 09 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 ... (db:get-valu
b530: 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 e-by-header run
b540: 68 65 61 64 65 72 20 78 29 29 0a 09 09 09 09 09 header x))......
b550: 09 20 20 20 20 20 20 20 6b 65 79 73 29 20 22 2f . keys) "/
b560: 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ")).
b570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b580: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 74 61 (sta
b590: 74 75 73 65 73 20 28 73 74 72 69 6e 67 2d 73 70 tuses (string-sp
b5a0: 6c 69 74 20 28 6f 72 20 28 61 72 67 73 3a 67 65 lit (or (args:ge
b5b0: 74 2d 61 72 67 20 22 2d 73 74 61 74 75 73 22 29 t-arg "-status")
b5c0: 20 22 22 29 20 22 2c 22 29 29 0a 20 20 20 20 20 "") ",")).
b5d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b5e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b5f0: 20 20 20 28 72 75 6e 2d 69 64 20 20 28 64 62 3a (run-id (db:
b600: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 get-value-by-hea
b610: 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 22 der run header "
b620: 69 64 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 id")).
b630: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b640: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 (r
b650: 75 6e 6e 61 6d 65 20 28 64 62 3a 67 65 74 2d 76 unname (db:get-v
b660: 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 alue-by-header r
b670: 75 6e 20 68 65 61 64 65 72 20 22 72 75 6e 6e 61 un header "runna
b680: 6d 65 22 29 29 20 0a 20 20 20 20 20 20 20 20 20 me")) .
b690: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b6a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
b6b0: 73 74 61 74 65 73 20 20 28 73 74 72 69 6e 67 2d states (string-
b6c0: 73 70 6c 69 74 20 28 6f 72 20 28 61 72 67 73 3a split (or (args:
b6d0: 67 65 74 2d 61 72 67 20 22 2d 73 74 61 74 65 22 get-arg "-state"
b6e0: 29 20 22 22 29 20 22 2c 22 29 29 0a 20 20 20 20 ) "") ",")).
b6f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b700: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b710: 20 20 20 20 28 74 65 73 74 73 20 20 20 28 69 66 (tests (if
b720: 20 74 65 73 74 73 2d 73 70 65 63 0a 20 20 20 20 tests-spec.
b730: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b740: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b750: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b760: 20 28 64 62 3a 64 69 73 70 61 74 63 68 2d 71 75 (db:dispatch-qu
b770: 65 72 79 20 61 63 63 65 73 73 2d 6d 6f 64 65 20 ery access-mode
b780: 72 6d 74 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f rmt:get-tests-fo
b790: 72 2d 72 75 6e 20 64 62 3a 67 65 74 2d 74 65 73 r-run db:get-tes
b7a0: 74 73 2d 66 6f 72 2d 72 75 6e 20 72 75 6e 2d 69 ts-for-run run-i
b7b0: 64 20 74 65 73 74 70 61 74 74 20 73 74 61 74 65 d testpatt state
b7c0: 73 20 73 74 61 74 75 73 65 73 20 23 66 20 23 66 s statuses #f #f
b7d0: 20 23 66 20 27 74 65 73 74 6e 61 6d 65 20 27 61 #f 'testname 'a
b7e0: 73 63 20 3b 3b 20 28 64 62 3a 67 65 74 2d 74 65 sc ;; (db:get-te
b7f0: 73 74 73 2d 66 6f 72 2d 72 75 6e 20 64 62 73 74 sts-for-run dbst
b800: 72 75 63 74 20 72 75 6e 2d 69 64 20 74 65 73 74 ruct run-id test
b810: 70 61 74 74 20 27 28 29 20 27 28 29 20 23 66 20 patt '() '() #f
b820: 23 66 20 23 66 20 27 74 65 73 74 6e 61 6d 65 20 #f #f 'testname
b830: 27 61 73 63 20 0a 20 20 20 20 20 20 20 20 20 20 'asc .
b840: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b850: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b860: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b870: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b ;;
b880: 20 75 73 65 20 71 72 79 76 61 6c 73 20 69 66 20 use qryvals if
b890: 74 65 73 74 2d 73 70 65 63 20 70 72 6f 76 69 64 test-spec provid
b8a0: 65 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ed.
b8b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b8c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b8d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b8e0: 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 74 (if t
b8f0: 65 73 74 73 2d 73 70 65 63 0a 20 20 20 20 20 20 ests-spec.
b900: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b910: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b920: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b930: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b940: 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 69 6e (string-in
b950: 74 65 72 73 70 65 72 73 65 20 61 64 6a 2d 74 65 tersperse adj-te
b960: 73 74 73 2d 73 70 65 63 20 22 2c 22 29 0a 20 20 sts-spec ",").
b970: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b980: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b990: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b9a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b9b0: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 64 62 3a ;; db:
b9c0: 74 65 73 74 2d 72 65 63 6f 72 64 2d 66 69 65 6c test-record-fiel
b9d0: 64 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ds.
b9e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b9f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ba00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ba10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 23 #
ba20: 66 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 f).
ba30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ba40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ba50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ba60: 20 20 20 20 20 20 20 20 20 20 20 23 66 0a 20 20 #f.
ba70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ba80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ba90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
baa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bab0: 20 20 20 20 20 20 27 6e 6f 72 6d 61 6c 29 0a 20 'normal).
bac0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bad0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
baf0: 20 20 20 20 27 28 29 29 29 29 0a 20 20 20 20 20 '()))).
bb00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bb10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 (a
bb20: 70 70 6c 79 20 61 70 70 65 6e 64 0a 20 20 20 20 pply append.
bb30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bb40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bb50: 20 20 20 20 20 20 28 6d 61 70 0a 20 20 20 20 20 (map.
bb60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bb70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bb80: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 (lambda (t
bb90: 65 73 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 est).
bba0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bbb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bbc0: 20 20 28 6c 65 74 2a 20 28 0a 20 20 20 20 20 20 (let* (.
bbd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bbe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bbf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 74 (t
bc00: 65 73 74 2d 69 64 20 20 20 20 20 20 28 69 66 20 est-id (if
bc10: 28 6d 65 6d 62 65 72 20 22 69 64 22 20 20 20 20 (member "id"
bc20: 20 20 20 20 20 20 20 74 65 73 74 73 2d 73 70 65 tests-spe
bc30: 63 29 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d c)(get-value-by-
bc40: 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 fieldname test t
bc50: 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 est-field-index
bc60: 22 69 64 22 20 20 20 20 20 20 20 20 20 20 29 20 "id" )
bc70: 23 66 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 #f)) ;; (db:test
bc80: 2d 67 65 74 2d 69 64 20 20 20 20 20 20 20 20 20 -get-id
bc90: 74 65 73 74 29 29 0a 20 20 20 20 20 20 20 20 20 test)).
bca0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bcb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bcc0: 20 20 20 20 20 20 20 20 20 20 20 28 74 65 73 74 (test
bcd0: 6e 61 6d 65 20 20 20 20 20 28 69 66 20 28 6d 65 name (if (me
bce0: 6d 62 65 72 20 22 74 65 73 74 6e 61 6d 65 22 20 mber "testname"
bcf0: 20 20 20 20 74 65 73 74 73 2d 73 70 65 63 29 28 tests-spec)(
bd00: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 get-value-by-fie
bd10: 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 ldname test test
bd20: 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 74 65 -field-index "te
bd30: 73 74 6e 61 6d 65 22 20 20 20 20 29 20 23 66 29 stname" ) #f)
bd40: 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 ) ;; (db:test-ge
bd50: 74 2d 74 65 73 74 6e 61 6d 65 20 20 20 74 65 73 t-testname tes
bd60: 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 t)).
bd70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bd80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bd90: 20 20 20 20 20 20 20 20 28 69 74 65 6d 70 61 74 (itempat
bda0: 68 20 20 20 20 20 28 69 66 20 28 6d 65 6d 62 65 h (if (membe
bdb0: 72 20 22 69 74 65 6d 5f 70 61 74 68 22 20 20 20 r "item_path"
bdc0: 20 74 65 73 74 73 2d 73 70 65 63 29 28 67 65 74 tests-spec)(get
bdd0: 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e -value-by-fieldn
bde0: 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 ame test test-fi
bdf0: 65 6c 64 2d 69 6e 64 65 78 20 22 69 74 65 6d 5f eld-index "item_
be00: 70 61 74 68 22 20 20 20 29 20 23 66 29 29 20 3b path" ) #f)) ;
be10: 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 ; (db:test-get-i
be20: 74 65 6d 2d 70 61 74 68 20 20 74 65 73 74 29 29 tem-path test))
be30: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
be40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
be50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
be60: 20 20 20 20 20 28 66 75 6c 6c 6e 61 6d 65 20 20 (fullname
be70: 20 20 20 28 63 6f 6e 63 20 74 65 73 74 6e 61 6d (conc testnam
be80: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 e.
be90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
beb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bec0: 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 65 (if (e
bed0: 71 75 61 6c 3f 20 69 74 65 6d 70 61 74 68 20 22 qual? itempath "
bee0: 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ").
bef0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bf00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bf10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bf20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 22 "
bf30: 22 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 " .
bf40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bf50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bf60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bf70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
bf80: 63 6f 6e 63 20 22 2f 22 20 69 74 65 6d 70 61 74 conc "/" itempat
bf90: 68 20 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 h )))).
bfa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bfb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bfc0: 20 20 20 20 20 20 20 20 20 20 20 28 74 65 73 74 (test
bfd0: 64 61 74 2d 72 61 77 20 28 6d 61 70 20 76 65 63 dat-raw (map vec
bfe0: 74 6f 72 2d 3e 6c 69 73 74 20 28 72 6d 74 3a 72 tor->list (rmt:r
bff0: 65 61 64 2d 74 65 73 74 2d 64 61 74 61 2a 20 72 ead-test-data* r
c000: 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 63 61 un-id test-id ca
c010: 74 65 67 6f 72 79 70 61 74 74 20 73 65 74 76 61 tegorypatt setva
c020: 72 70 61 74 74 29 29 29 0a 20 20 20 20 20 20 20 rpatt))).
c030: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c040: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c050: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 74 65 (te
c060: 73 74 64 61 74 20 28 66 69 6c 74 65 72 0a 20 20 stdat (filter.
c070: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c080: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c090: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c0a0: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d (lam
c0b0: 62 64 61 20 28 78 29 0a 20 20 20 20 20 20 20 20 bda (x).
c0c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c0d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c0e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c0f0: 20 20 20 20 20 20 20 20 28 6e 6f 74 20 28 65 71 (not (eq
c100: 75 61 6c 3f 20 22 6c 6f 67 70 72 6f 22 0a 20 20 ual? "logpro".
c110: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c120: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c130: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c140: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c150: 20 20 20 20 20 20 20 20 20 20 20 28 6c 69 73 74 (list
c160: 2d 72 65 66 20 78 20 31 30 29 29 29 29 0a 20 20 -ref x 10)))).
c170: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c180: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c190: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c1a0: 20 20 20 20 20 20 20 20 20 20 20 20 74 65 73 74 test
c1b0: 64 61 74 2d 72 61 77 29 29 29 0a 20 20 20 20 20 dat-raw))).
c1c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c1d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c1e0: 20 20 20 20 20 20 20 20 20 20 28 6d 61 70 20 0a (map .
c1f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c200: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c210: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c220: 28 6c 61 6d 62 64 61 20 28 69 74 65 6d 29 0a 20 (lambda (item).
c230: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c260: 20 28 72 65 63 65 69 76 65 20 28 69 64 20 74 65 (receive (id te
c270: 73 74 5f 69 64 20 63 61 74 65 67 6f 72 79 0a 20 st_id category.
c280: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c2a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c2b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 76 61 va
c2c0: 72 69 61 62 6c 65 20 76 61 6c 75 65 20 65 78 70 riable value exp
c2d0: 65 63 74 65 64 0a 20 20 20 20 20 20 20 20 20 20 ected.
c2e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c2f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c300: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c310: 20 20 20 20 20 74 6f 6c 20 75 6e 69 74 73 20 63 tol units c
c320: 6f 6d 6d 65 6e 74 20 73 74 61 74 75 73 20 74 79 omment status ty
c330: 70 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 pe).
c340: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c350: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c360: 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 (apply
c370: 20 76 61 6c 75 65 73 20 69 74 65 6d 29 0a 20 20 values item).
c380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c3a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c3b0: 20 20 28 6c 69 73 74 20 74 61 72 67 65 74 20 72 (list target r
c3c0: 75 6e 6e 61 6d 65 20 74 65 73 74 6e 61 6d 65 20 unname testname
c3d0: 69 74 65 6d 70 61 74 68 20 63 61 74 65 67 6f 72 itempath categor
c3e0: 79 20 76 61 72 69 61 62 6c 65 20 76 61 6c 75 65 y variable value
c3f0: 20 63 6f 6d 6d 65 6e 74 29 29 29 0a 20 20 20 20 comment))).
c400: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c410: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c420: 20 20 20 20 20 20 20 20 20 20 20 20 74 65 73 74 test
c430: 64 61 74 29 29 29 0a 20 20 20 20 20 20 20 20 20 dat))).
c440: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c450: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c460: 20 20 74 65 73 74 73 29 29 29 29 0a 20 20 20 20 tests)))).
c470: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c480: 20 20 20 20 20 20 20 20 20 20 20 72 75 6e 73 29 runs)
c490: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 70 ))). (p
c4a0: 72 69 6e 74 20 28 73 74 72 69 6e 67 2d 6a 6f 69 rint (string-joi
c4b0: 6e 20 74 61 62 6c 65 2d 68 65 61 64 65 72 20 22 n table-header "
c4c0: 2c 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 ,")). (
c4d0: 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 for-each (lambda
c4e0: 28 74 61 62 6c 65 2d 72 6f 77 29 0a 20 20 20 20 (table-row).
c4f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c500: 20 20 28 70 72 69 6e 74 20 28 73 74 72 69 6e 67 (print (string
c510: 2d 6a 6f 69 6e 20 28 6d 61 70 20 2d 3e 73 74 72 -join (map ->str
c520: 69 6e 67 20 74 61 62 6c 65 2d 72 6f 77 29 20 22 ing table-row) "
c530: 2c 22 29 29 29 0a 0a 20 20 20 20 20 20 20 20 20 ,")))..
c540: 20 20 20 20 20 20 20 20 20 20 20 0a 20 20 20 20 .
c550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c560: 20 20 20 20 20 20 20 20 74 61 62 6c 65 2d 72 6f table-ro
c570: 77 73 29 29 29 29 0a 20 20 28 73 65 74 21 20 2a ws)))). (set! *
c580: 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
c590: 29 0a 20 20 28 73 65 74 21 20 2a 74 69 6d 65 2d ). (set! *time-
c5a0: 74 6f 2d 65 78 69 74 2a 20 23 74 29 29 0a 0a 0a to-exit* #t))...
c5b0: 0a 3b 3b 20 4e 4f 54 45 3a 20 6c 69 73 74 2d 72 .;; NOTE: list-r
c5c0: 75 6e 73 20 61 6e 64 20 6c 69 73 74 2d 64 62 2d uns and list-db-
c5d0: 74 61 72 67 65 74 73 20 6f 70 65 72 61 74 65 20 targets operate
c5e0: 6f 6e 20 6c 6f 63 61 6c 20 64 62 21 21 21 0a 3b on local db!!!.;
c5f0: 3b 0a 3b 3b 20 49 44 45 41 3a 20 6d 65 67 61 74 ;.;; IDEA: megat
c600: 65 73 74 20 6c 69 73 74 20 2d 72 75 6e 6e 61 6d est list -runnam
c610: 65 20 62 6c 61 68 25 20 2e 2e 2e 0a 3b 3b 0a 28 e blah% ....;;.(
c620: 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 if (or (args:get
c630: 2d 61 72 67 20 22 2d 6c 69 73 74 2d 72 75 6e 73 -arg "-list-runs
c640: 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 ")..(args:get-ar
c650: 67 20 22 2d 6c 69 73 74 2d 64 62 2d 74 61 72 67 g "-list-db-targ
c660: 65 74 73 22 29 29 0a 20 20 20 20 28 69 66 20 28 ets")). (if (
c670: 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 0a 09 28 launch:setup)..(
c680: 6c 65 74 2a 20 28 3b 3b 20 28 64 62 73 74 72 75 let* (;; (dbstru
c690: 63 74 20 20 20 20 28 6d 61 6b 65 2d 64 62 72 3a ct (make-dbr:
c6a0: 64 62 73 74 72 75 63 74 20 70 61 74 68 3a 20 2a dbstruct path: *
c6b0: 74 6f 70 70 61 74 68 2a 20 6c 6f 63 61 6c 3a 20 toppath* local:
c6c0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
c6d0: 6c 6f 63 61 6c 22 29 29 29 0a 09 20 20 20 20 20 local")))..
c6e0: 20 20 28 72 75 6e 70 61 74 74 20 20 20 20 20 28 (runpatt (
c6f0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c args:get-arg "-l
c700: 69 73 74 2d 72 75 6e 73 22 29 29 0a 20 20 20 20 ist-runs")).
c710: 20 20 20 20 20 20 20 20 20 20 20 28 61 63 63 65 (acce
c720: 73 73 2d 6d 6f 64 65 20 28 64 62 3a 67 65 74 2d ss-mode (db:get-
c730: 61 63 63 65 73 73 2d 6d 6f 64 65 29 29 0a 09 20 access-mode))..
c740: 20 20 20 20 20 20 28 74 65 73 74 70 61 74 74 20 (testpatt
c750: 20 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d (common:args-
c760: 67 65 74 2d 74 65 73 74 70 61 74 74 20 23 66 29 get-testpatt #f)
c770: 29 0a 09 20 20 20 20 20 20 20 3b 3b 20 28 69 66 ).. ;; (if
c780: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
c790: 2d 74 65 73 74 70 61 74 74 22 29 20 0a 09 20 20 -testpatt") ..
c7a0: 20 20 20 20 20 3b 3b 20 20 09 20 20 20 20 20 20 ;; .
c7b0: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
c7c0: 22 2d 74 65 73 74 70 61 74 74 22 29 20 0a 09 20 "-testpatt") ..
c7d0: 20 20 20 20 20 20 3b 3b 20 20 09 20 20 20 20 20 ;; .
c7e0: 20 20 20 22 25 22 29 29 0a 09 20 20 20 20 20 20 "%"))..
c7f0: 20 28 6b 65 79 73 20 20 20 20 20 20 20 20 28 72 (keys (r
c800: 6d 74 3a 67 65 74 2d 6b 65 79 73 29 29 20 3b 3b mt:get-keys)) ;;
c810: 20 28 64 62 3a 67 65 74 2d 6b 65 79 73 20 64 62 (db:get-keys db
c820: 73 74 72 75 63 74 29 29 0a 09 20 20 20 20 20 20 struct))..
c830: 20 3b 3b 20 28 72 75 6e 73 64 61 74 20 20 28 64 ;; (runsdat (d
c840: 62 3a 67 65 74 2d 72 75 6e 73 20 64 62 73 74 72 b:get-runs dbstr
c850: 75 63 74 20 72 75 6e 70 61 74 74 20 23 66 20 23 uct runpatt #f #
c860: 66 20 27 28 29 29 29 0a 09 3b 3b 20 28 72 75 6e f '()))..;; (run
c870: 73 64 61 74 20 20 20 20 20 28 72 6d 74 3a 67 65 sdat (rmt:ge
c880: 74 2d 72 75 6e 73 2d 62 79 2d 70 61 74 74 20 6b t-runs-by-patt k
c890: 65 79 73 20 28 6f 72 20 72 75 6e 70 61 74 74 20 eys (or runpatt
c8a0: 22 25 22 29 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 "%") (common:arg
c8b0: 73 2d 67 65 74 2d 74 61 72 67 65 74 29 20 3b 3b s-get-target) ;;
c8c0: 20 28 64 62 3a 67 65 74 2d 72 75 6e 73 2d 62 79 (db:get-runs-by
c8d0: 2d 70 61 74 74 20 64 62 73 74 72 75 63 74 20 6b -patt dbstruct k
c8e0: 65 79 73 20 28 6f 72 20 72 75 6e 70 61 74 74 20 eys (or runpatt
c8f0: 22 25 22 29 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 "%") (common:arg
c900: 73 2d 67 65 74 2d 74 61 72 67 65 74 29 0a 09 3b s-get-target)..;
c910: 3b 20 09 09 20 20 20 20 20 20 20 20 20 20 20 09 ; .. .
c920: 20 23 66 20 23 66 20 27 28 22 69 64 22 20 22 72 #f #f '("id" "r
c930: 75 6e 6e 61 6d 65 22 20 22 73 74 61 74 65 22 20 unname" "state"
c940: 22 73 74 61 74 75 73 22 20 22 6f 77 6e 65 72 22 "status" "owner"
c950: 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 20 22 63 "event_time" "c
c960: 6f 6d 6d 65 6e 74 22 29 20 30 29 29 0a 09 20 20 omment") 0))..
c970: 20 20 20 20 20 28 72 75 6e 73 64 61 74 20 20 20 (runsdat
c980: 20 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e 73 2d (rmt:get-runs-
c990: 62 79 2d 70 61 74 74 20 6b 65 79 73 20 28 6f 72 by-patt keys (or
c9a0: 20 72 75 6e 70 61 74 74 20 22 25 22 29 20 0a 20 runpatt "%") .
c9b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c9c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c9d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c9e0: 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 (common:args-ge
c9f0: 74 2d 74 61 72 67 65 74 29 20 23 66 20 23 66 20 t-target) #f #f
ca00: 27 28 22 69 64 22 20 22 72 75 6e 6e 61 6d 65 22 '("id" "runname"
ca10: 20 22 73 74 61 74 65 22 20 22 73 74 61 74 75 73 "state" "status
ca20: 22 20 22 6f 77 6e 65 72 22 20 22 65 76 65 6e 74 " "owner" "event
ca30: 5f 74 69 6d 65 22 20 22 63 6f 6d 6d 65 6e 74 22 _time" "comment"
ca40: 29 20 30 29 29 0a 09 20 20 20 20 20 20 20 28 72 ) 0)).. (r
ca50: 75 6e 73 74 6d 70 20 20 20 20 20 28 64 62 3a 67 unstmp (db:g
ca60: 65 74 2d 72 6f 77 73 20 72 75 6e 73 64 61 74 29 et-rows runsdat)
ca70: 29 0a 09 20 20 20 20 20 20 20 28 68 65 61 64 65 ).. (heade
ca80: 72 20 20 20 20 20 20 28 64 62 3a 67 65 74 2d 68 r (db:get-h
ca90: 65 61 64 65 72 20 72 75 6e 73 64 61 74 29 29 0a eader runsdat)).
caa0: 09 20 20 20 20 20 20 20 3b 3b 20 74 68 69 73 20 . ;; this
cab0: 69 73 20 22 2d 73 69 6e 63 65 22 20 73 75 70 70 is "-since" supp
cac0: 6f 72 74 2e 20 54 68 69 73 20 6c 6f 6f 6b 73 20 ort. This looks
cad0: 61 74 20 6c 61 73 74 20 6d 6f 64 20 74 69 6d 65 at last mod time
cae0: 73 20 6f 66 20 3c 72 75 6e 2d 69 64 3e 2e 64 62 s of <run-id>.db
caf0: 20 66 69 6c 65 73 0a 09 20 20 20 20 20 20 20 3b files.. ;
cb00: 3b 20 61 6e 64 20 63 6f 6c 6c 65 63 74 73 20 74 ; and collects t
cb10: 68 6f 73 65 20 6d 6f 64 69 66 69 65 64 20 73 69 hose modified si
cb20: 6e 63 65 20 74 68 65 20 2d 73 69 6e 63 65 20 74 nce the -since t
cb30: 69 6d 65 2e 0a 09 20 20 20 20 20 20 20 28 72 75 ime... (ru
cb40: 6e 73 20 20 20 20 20 20 20 20 72 75 6e 73 74 6d ns runstm
cb50: 70 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 p).
cb60: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 28 69 ;; (i
cb70: 66 20 28 61 6e 64 20 28 6e 6f 74 20 28 6e 75 6c f (and (not (nul
cb80: 6c 3f 20 72 75 6e 73 74 6d 70 29 29 0a 09 09 09 l? runstmp))....
cb90: 3b 3b 20 20 20 20 20 20 20 20 28 61 72 67 73 3a ;; (args:
cba0: 67 65 74 2d 61 72 67 20 22 2d 73 69 6e 63 65 22 get-arg "-since"
cbb0: 29 29 0a 09 09 09 3b 3b 20 20 20 28 6c 65 74 20 ))....;; (let
cbc0: 28 28 63 68 61 6e 67 65 64 2d 69 64 73 20 28 64 ((changed-ids (d
cbd0: 62 3a 67 65 74 2d 63 68 61 6e 67 65 64 2d 72 75 b:get-changed-ru
cbe0: 6e 2d 69 64 73 20 28 73 74 72 69 6e 67 2d 3e 6e n-ids (string->n
cbf0: 75 6d 62 65 72 20 28 61 72 67 73 3a 67 65 74 2d umber (args:get-
cc00: 61 72 67 20 22 2d 73 69 6e 63 65 22 29 29 29 29 arg "-since"))))
cc10: 29 0a 09 09 09 3b 3b 20 20 20 20 20 28 6c 65 74 )....;; (let
cc20: 20 6c 6f 6f 70 20 28 28 68 65 64 20 28 63 61 72 loop ((hed (car
cc30: 20 72 75 6e 73 74 6d 70 29 29 0a 09 09 09 3b 3b runstmp))....;;
cc40: 20 20 20 09 20 20 20 20 20 28 74 61 6c 20 28 63 . (tal (c
cc50: 64 72 20 72 75 6e 73 74 6d 70 29 29 0a 09 09 09 dr runstmp))....
cc60: 3b 3b 20 20 20 09 20 20 20 20 20 28 72 65 73 20 ;; . (res
cc70: 27 28 29 29 29 0a 09 09 09 3b 3b 20 20 20 20 20 '()))....;;
cc80: 20 20 28 6c 65 74 20 28 28 6e 65 77 2d 72 65 73 (let ((new-res
cc90: 20 28 69 66 20 28 6d 65 6d 62 65 72 20 28 64 62 (if (member (db
cca0: 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 :get-value-by-he
ccb0: 61 64 65 72 20 68 65 64 20 68 65 61 64 65 72 20 ader hed header
ccc0: 22 69 64 22 29 20 63 68 61 6e 67 65 64 2d 69 64 "id") changed-id
ccd0: 73 29 0a 09 09 09 3b 3b 20 20 20 09 09 20 20 20 s)....;; ..
cce0: 20 20 20 20 28 63 6f 6e 73 20 68 65 64 20 72 65 (cons hed re
ccf0: 73 29 0a 09 09 09 3b 3b 20 20 20 09 09 20 20 20 s)....;; ..
cd00: 20 20 20 20 72 65 73 29 29 29 0a 09 09 09 3b 3b res)))....;;
cd10: 20 20 20 20 20 20 20 20 20 28 69 66 20 28 6e 75 (if (nu
cd20: 6c 6c 3f 20 74 61 6c 29 0a 09 09 09 3b 3b 20 20 ll? tal)....;;
cd30: 20 09 20 20 28 72 65 76 65 72 73 65 20 6e 65 77 . (reverse new
cd40: 2d 72 65 73 29 0a 09 09 09 3b 3b 20 20 20 09 20 -res)....;; .
cd50: 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 (loop (car tal)
cd60: 28 63 64 72 20 74 61 6c 29 20 6e 65 77 2d 72 65 (cdr tal) new-re
cd70: 73 29 29 29 29 29 0a 09 09 09 3b 3b 20 20 20 72 s)))))....;; r
cd80: 75 6e 73 74 6d 70 29 29 0a 09 20 20 20 20 20 20 unstmp))..
cd90: 20 28 64 62 2d 74 61 72 67 65 74 73 20 20 28 61 (db-targets (a
cda0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 69 rgs:get-arg "-li
cdb0: 73 74 2d 64 62 2d 74 61 72 67 65 74 73 22 29 29 st-db-targets"))
cdc0: 0a 09 20 20 20 20 20 20 20 28 73 65 65 6e 20 20 .. (seen
cdd0: 20 20 20 20 20 20 28 6d 61 6b 65 2d 68 61 73 68 (make-hash
cde0: 2d 74 61 62 6c 65 29 29 0a 09 20 20 20 20 20 20 -table))..
cdf0: 20 28 64 6d 6f 64 65 20 20 20 20 20 20 20 28 6c (dmode (l
ce00: 65 74 20 28 28 64 20 28 61 72 67 73 3a 67 65 74 et ((d (args:get
ce10: 2d 61 72 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 -arg "-dumpmode"
ce20: 29 29 29 20 3b 3b 20 6a 73 6f 6e 2c 20 73 65 78 ))) ;; json, sex
ce30: 70 72 0a 09 09 09 20 20 20 20 20 20 28 69 66 20 pr.... (if
ce40: 64 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f d (string->symbo
ce50: 6c 20 64 29 20 23 66 29 29 29 0a 09 20 20 20 20 l d) #f)))..
ce60: 20 20 20 28 64 61 74 61 20 20 20 20 20 20 20 20 (data
ce70: 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 (make-hash-table
ce80: 29 29 0a 09 20 20 20 20 20 20 20 28 66 69 65 6c )).. (fiel
ce90: 64 73 2d 73 70 65 63 20 28 69 66 20 28 61 72 67 ds-spec (if (arg
cea0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 66 69 65 6c s:get-arg "-fiel
ceb0: 64 73 22 29 0a 09 09 09 09 28 65 78 74 72 61 63 ds").....(extrac
cec0: 74 2d 66 69 65 6c 64 73 2d 63 6f 6e 73 74 72 61 t-fields-constra
ced0: 69 6e 74 73 20 28 61 72 67 73 3a 67 65 74 2d 61 ints (args:get-a
cee0: 72 67 20 22 2d 66 69 65 6c 64 73 22 29 29 0a 09 rg "-fields"))..
cef0: 09 09 09 28 6c 69 73 74 20 28 63 6f 6e 73 20 22 ...(list (cons "
cf00: 72 75 6e 73 22 20 28 61 70 70 65 6e 64 20 6b 65 runs" (append ke
cf10: 79 73 20 28 6c 69 73 74 20 22 69 64 22 20 22 72 ys (list "id" "r
cf20: 75 6e 6e 61 6d 65 22 20 22 73 74 61 74 65 22 20 unname" "state"
cf30: 22 73 74 61 74 75 73 22 20 22 6f 77 6e 65 72 22 "status" "owner"
cf40: 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 20 22 63 "event_time" "c
cf50: 6f 6d 6d 65 6e 74 22 20 22 66 61 69 6c 5f 63 6f omment" "fail_co
cf60: 75 6e 74 22 20 22 70 61 73 73 5f 63 6f 75 6e 74 unt" "pass_count
cf70: 22 29 29 29 0a 09 09 09 09 20 20 20 20 20 20 28 ")))..... (
cf80: 63 6f 6e 73 20 22 74 65 73 74 73 22 20 20 64 62 cons "tests" db
cf90: 3a 74 65 73 74 2d 72 65 63 6f 72 64 2d 66 69 65 :test-record-fie
cfa0: 6c 64 73 29 20 3b 3b 20 22 69 64 22 20 22 74 65 lds) ;; "id" "te
cfb0: 73 74 6e 61 6d 65 22 20 22 74 65 73 74 5f 70 61 stname" "test_pa
cfc0: 74 68 22 29 0a 09 09 09 09 20 20 20 20 20 20 28 th")..... (
cfd0: 6c 69 73 74 20 22 73 74 65 70 73 22 20 22 69 64 list "steps" "id
cfe0: 22 20 22 73 74 65 70 6e 61 6d 65 22 29 29 29 29 " "stepname"))))
cff0: 0a 09 20 20 20 20 20 20 20 28 72 75 6e 73 2d 73 .. (runs-s
d000: 70 65 63 20 20 20 28 6c 65 74 20 28 28 72 20 28 pec (let ((r (
d010: 61 6c 69 73 74 2d 72 65 66 20 22 72 75 6e 73 22 alist-ref "runs"
d020: 20 20 66 69 65 6c 64 73 2d 73 70 65 63 20 65 71 fields-spec eq
d030: 75 61 6c 3f 29 29 29 20 3b 3b 20 74 68 65 20 63 ual?))) ;; the c
d040: 68 65 63 6b 20 69 73 20 6e 6f 77 20 75 6e 6e 65 heck is now unne
d050: 63 65 73 73 61 72 79 0a 09 09 09 20 20 20 20 20 cessary....
d060: 20 28 69 66 20 28 61 6e 64 20 72 20 28 6e 6f 74 (if (and r (not
d070: 20 28 6e 75 6c 6c 3f 20 72 29 29 29 20 72 20 28 (null? r))) r (
d080: 6c 69 73 74 20 22 69 64 22 20 29 29 29 29 0a 09 list "id" ))))..
d090: 20 20 20 20 20 20 20 28 74 65 73 74 73 2d 73 70 (tests-sp
d0a0: 65 63 20 20 28 6c 65 74 20 28 28 74 20 28 61 6c ec (let ((t (al
d0b0: 69 73 74 2d 72 65 66 20 22 74 65 73 74 73 22 20 ist-ref "tests"
d0c0: 66 69 65 6c 64 73 2d 73 70 65 63 20 65 71 75 61 fields-spec equa
d0d0: 6c 3f 29 29 29 0a 09 09 09 20 20 20 20 20 20 28 l?))).... (
d0e0: 69 66 20 28 61 6e 64 20 74 20 28 6e 75 6c 6c 3f if (and t (null?
d0f0: 20 74 29 29 20 3b 3b 20 61 6c 6c 20 66 69 65 6c t)) ;; all fiel
d100: 64 73 0a 09 09 09 09 20 20 64 62 3a 74 65 73 74 ds..... db:test
d110: 2d 72 65 63 6f 72 64 2d 66 69 65 6c 64 73 0a 09 -record-fields..
d120: 09 09 09 20 20 74 29 29 29 0a 09 20 20 20 20 20 ... t)))..
d130: 20 20 28 61 64 6a 2d 74 65 73 74 73 2d 73 70 65 (adj-tests-spe
d140: 63 20 28 64 65 6c 65 74 65 2d 64 75 70 6c 69 63 c (delete-duplic
d150: 61 74 65 73 20 28 69 66 20 74 65 73 74 73 2d 73 ates (if tests-s
d160: 70 65 63 20 28 63 6f 6e 73 20 22 69 64 22 20 74 pec (cons "id" t
d170: 65 73 74 73 2d 73 70 65 63 29 20 64 62 3a 74 65 ests-spec) db:te
d180: 73 74 2d 72 65 63 6f 72 64 2d 66 69 65 6c 64 73 st-record-fields
d190: 29 29 29 20 3b 3b 20 27 28 22 69 64 22 29 29 29 ))) ;; '("id")))
d1a0: 29 0a 09 20 20 20 20 20 20 20 28 73 74 65 70 73 ).. (steps
d1b0: 2d 73 70 65 63 20 20 28 61 6c 69 73 74 2d 72 65 -spec (alist-re
d1c0: 66 20 22 73 74 65 70 73 22 20 66 69 65 6c 64 73 f "steps" fields
d1d0: 2d 73 70 65 63 20 65 71 75 61 6c 3f 29 29 0a 09 -spec equal?))..
d1e0: 20 20 20 20 20 20 20 28 74 65 73 74 2d 66 69 65 (test-fie
d1f0: 6c 64 2d 69 6e 64 65 78 20 28 6d 61 6b 65 2d 68 ld-index (make-h
d200: 61 73 68 2d 74 61 62 6c 65 29 29 29 0a 09 20 20 ash-table)))..
d210: 28 69 66 20 28 61 6e 64 20 74 65 73 74 73 2d 73 (if (and tests-s
d220: 70 65 63 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 pec (not (null?
d230: 74 65 73 74 73 2d 73 70 65 63 29 29 29 20 3b 3b tests-spec))) ;;
d240: 20 64 6f 20 73 6f 6d 65 20 76 61 6c 69 64 61 74 do some validat
d250: 69 6f 6e 20 61 6e 64 20 70 72 6f 63 65 73 73 69 ion and processi
d260: 6e 67 20 6f 66 20 74 68 65 20 74 65 73 74 2d 73 ng of the test-s
d270: 70 65 63 0a 09 20 20 20 20 20 20 28 6c 65 74 20 pec.. (let
d280: 28 28 69 6e 76 61 6c 69 64 2d 74 65 73 74 73 2d ((invalid-tests-
d290: 73 70 65 63 20 28 66 69 6c 74 65 72 20 28 6c 61 spec (filter (la
d2a0: 6d 62 64 61 20 28 78 29 28 6e 6f 74 20 28 6d 65 mbda (x)(not (me
d2b0: 6d 62 65 72 20 78 20 64 62 3a 74 65 73 74 2d 72 mber x db:test-r
d2c0: 65 63 6f 72 64 2d 66 69 65 6c 64 73 29 29 29 20 ecord-fields)))
d2d0: 74 65 73 74 73 2d 73 70 65 63 29 29 29 0a 09 09 tests-spec)))...
d2e0: 28 69 66 20 28 6e 75 6c 6c 3f 20 69 6e 76 61 6c (if (null? inval
d2f0: 69 64 2d 74 65 73 74 73 2d 73 70 65 63 29 0a 09 id-tests-spec)..
d300: 09 20 20 20 20 3b 3b 20 67 65 6e 65 72 61 74 65 . ;; generate
d310: 20 74 68 65 20 6c 6f 6f 6b 75 70 20 6d 61 70 20 the lookup map
d320: 74 65 73 74 2d 66 69 65 6c 64 2d 6e 61 6d 65 20 test-field-name
d330: 3d 3e 20 69 6e 64 65 78 2d 6e 75 6d 62 65 72 0a => index-number.
d340: 09 09 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 .. (let loop
d350: 28 28 68 65 64 20 28 63 61 72 20 61 64 6a 2d 74 ((hed (car adj-t
d360: 65 73 74 73 2d 73 70 65 63 29 29 0a 09 09 09 20 ests-spec))....
d370: 20 20 20 20 20 20 28 74 61 6c 20 28 63 64 72 20 (tal (cdr
d380: 61 64 6a 2d 74 65 73 74 73 2d 73 70 65 63 29 29 adj-tests-spec))
d390: 0a 09 09 09 20 20 20 20 20 20 20 28 69 64 78 20 .... (idx
d3a0: 30 29 29 0a 09 09 20 20 20 20 20 20 28 68 61 73 0))... (has
d3b0: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 74 65 73 h-table-set! tes
d3c0: 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 68 65 t-field-index he
d3d0: 64 20 69 64 78 29 0a 09 09 20 20 20 20 20 20 28 d idx)... (
d3e0: 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 if (not (null? t
d3f0: 61 6c 29 29 28 6c 6f 6f 70 20 28 63 61 72 20 74 al))(loop (car t
d400: 61 6c 29 28 63 64 72 20 74 61 6c 29 28 2b 20 69 al)(cdr tal)(+ i
d410: 64 78 20 31 29 29 29 29 0a 09 09 20 20 20 20 28 dx 1))))... (
d420: 62 65 67 69 6e 0a 09 09 20 20 20 20 20 20 28 64 begin... (d
d430: 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 ebug:print-error
d440: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
d450: 70 6f 72 74 2a 20 22 49 6e 76 61 6c 69 64 20 74 port* "Invalid t
d460: 65 73 74 20 66 69 65 6c 64 73 20 73 70 65 63 69 est fields speci
d470: 66 69 65 64 3a 20 22 20 28 73 74 72 69 6e 67 2d fied: " (string-
d480: 69 6e 74 65 72 73 70 65 72 73 65 20 69 6e 76 61 intersperse inva
d490: 6c 69 64 2d 74 65 73 74 73 2d 73 70 65 63 20 22 lid-tests-spec "
d4a0: 2c 20 22 29 29 0a 09 09 20 20 20 20 20 20 28 65 , "))... (e
d4b0: 78 69 74 29 29 29 29 29 0a 09 20 20 3b 3b 20 45 xit))))).. ;; E
d4c0: 61 63 68 20 72 75 6e 0a 09 20 20 28 66 6f 72 2d ach run.. (for-
d4d0: 65 61 63 68 20 0a 09 20 20 20 28 6c 61 6d 62 64 each .. (lambd
d4e0: 61 20 28 72 75 6e 29 0a 09 20 20 20 20 20 28 6c a (run).. (l
d4f0: 65 74 20 28 28 74 61 72 67 65 74 73 74 72 20 28 et ((targetstr (
d500: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
d510: 73 65 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 se (map (lambda
d520: 28 78 29 0a 09 09 09 09 09 09 09 20 28 64 62 3a (x)........ (db:
d530: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 get-value-by-hea
d540: 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 78 der run header x
d550: 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 )).......
d560: 6b 65 79 73 29 20 22 2f 22 29 29 29 0a 09 20 20 keys) "/")))..
d570: 20 20 20 20 20 28 69 66 20 64 62 2d 74 61 72 67 (if db-targ
d580: 65 74 73 0a 09 09 20 20 20 28 69 66 20 28 6e 6f ets... (if (no
d590: 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 t (hash-table-re
d5a0: 66 2f 64 65 66 61 75 6c 74 20 73 65 65 6e 20 74 f/default seen t
d5b0: 61 72 67 65 74 73 74 72 20 23 66 29 29 0a 09 09 argetstr #f))...
d5c0: 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 (begin...
d5d0: 09 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 . (hash-table-se
d5e0: 74 21 20 73 65 65 6e 20 74 61 72 67 65 74 73 74 t! seen targetst
d5f0: 72 20 23 74 29 0a 09 09 09 20 3b 3b 20 28 70 72 r #t).... ;; (pr
d600: 69 6e 74 20 22 5b 22 20 74 61 72 67 65 74 73 74 int "[" targetst
d610: 72 20 22 5d 22 29 29 29 29 0a 09 09 09 20 28 69 r "]")))).... (i
d620: 66 20 28 6e 6f 74 20 64 6d 6f 64 65 29 0a 09 09 f (not dmode)...
d630: 09 20 20 20 20 20 28 70 72 69 6e 74 20 74 61 72 . (print tar
d640: 67 65 74 73 74 72 29 0a 09 09 09 20 20 20 20 20 getstr)....
d650: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set!
d660: 20 64 61 74 61 20 22 74 61 72 67 65 74 73 22 20 data "targets"
d670: 28 63 6f 6e 73 20 74 61 72 67 65 74 73 74 72 20 (cons targetstr
d680: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
d690: 64 65 66 61 75 6c 74 20 64 61 74 61 20 22 74 61 default data "ta
d6a0: 72 67 65 74 73 22 20 27 28 29 29 29 29 0a 09 09 rgets" '())))...
d6b0: 09 20 20 20 20 20 29 29 29 0a 09 09 20 20 20 28 . )))... (
d6c0: 6c 65 74 2a 20 28 28 72 75 6e 2d 69 64 20 20 28 let* ((run-id (
d6d0: 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d db:get-value-by-
d6e0: 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 header run heade
d6f0: 72 20 22 69 64 22 29 29 0a 09 09 09 20 20 28 72 r "id")).... (r
d700: 75 6e 6e 61 6d 65 20 28 64 62 3a 67 65 74 2d 76 unname (db:get-v
d710: 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 alue-by-header r
d720: 75 6e 20 68 65 61 64 65 72 20 22 72 75 6e 6e 61 un header "runna
d730: 6d 65 22 29 29 20 0a 09 09 09 20 20 28 73 74 61 me")) .... (sta
d740: 74 65 73 20 20 28 73 74 72 69 6e 67 2d 73 70 6c tes (string-spl
d750: 69 74 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 it (or (args:get
d760: 2d 61 72 67 20 22 2d 73 74 61 74 65 22 29 20 22 -arg "-state") "
d770: 22 29 20 22 2c 22 29 29 0a 09 09 09 20 20 28 73 ") ",")).... (s
d780: 74 61 74 75 73 65 73 20 28 73 74 72 69 6e 67 2d tatuses (string-
d790: 73 70 6c 69 74 20 28 6f 72 20 28 61 72 67 73 3a split (or (args:
d7a0: 67 65 74 2d 61 72 67 20 22 2d 73 74 61 74 75 73 get-arg "-status
d7b0: 22 29 20 22 22 29 20 22 2c 22 29 29 0a 09 09 09 ") "") ","))....
d7c0: 20 20 28 74 65 73 74 73 20 20 20 28 69 66 20 74 (tests (if t
d7d0: 65 73 74 73 2d 73 70 65 63 0a 09 09 09 09 20 20 ests-spec.....
d7e0: 20 20 20 20 20 28 64 62 3a 64 69 73 70 61 74 63 (db:dispatc
d7f0: 68 2d 71 75 65 72 79 20 61 63 63 65 73 73 2d 6d h-query access-m
d800: 6f 64 65 20 72 6d 74 3a 67 65 74 2d 74 65 73 74 ode rmt:get-test
d810: 73 2d 66 6f 72 2d 72 75 6e 20 64 62 3a 67 65 74 s-for-run db:get
d820: 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 72 -tests-for-run r
d830: 75 6e 2d 69 64 20 74 65 73 74 70 61 74 74 20 73 un-id testpatt s
d840: 74 61 74 65 73 20 73 74 61 74 75 73 65 73 20 23 tates statuses #
d850: 66 20 23 66 20 23 66 20 27 74 65 73 74 6e 61 6d f #f #f 'testnam
d860: 65 20 27 61 73 63 20 3b 3b 20 28 64 62 3a 67 65 e 'asc ;; (db:ge
d870: 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 t-tests-for-run
d880: 64 62 73 74 72 75 63 74 20 72 75 6e 2d 69 64 20 dbstruct run-id
d890: 74 65 73 74 70 61 74 74 20 27 28 29 20 27 28 29 testpatt '() '()
d8a0: 20 23 66 20 23 66 20 23 66 20 27 74 65 73 74 6e #f #f #f 'testn
d8b0: 61 6d 65 20 27 61 73 63 20 0a 09 09 09 09 09 09 ame 'asc .......
d8c0: 09 20 20 20 20 20 3b 3b 20 75 73 65 20 71 72 79 . ;; use qry
d8d0: 76 61 6c 73 20 69 66 20 74 65 73 74 2d 73 70 65 vals if test-spe
d8e0: 63 20 70 72 6f 76 69 64 65 64 0a 09 09 09 09 09 c provided......
d8f0: 09 09 20 20 20 20 20 28 69 66 20 74 65 73 74 73 .. (if tests
d900: 2d 73 70 65 63 0a 09 09 09 09 09 09 09 09 20 28 -spec......... (
d910: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
d920: 73 65 20 61 64 6a 2d 74 65 73 74 73 2d 73 70 65 se adj-tests-spe
d930: 63 20 22 2c 22 29 0a 09 09 09 09 09 09 09 09 20 c ",").........
d940: 3b 3b 20 64 62 3a 74 65 73 74 2d 72 65 63 6f 72 ;; db:test-recor
d950: 64 2d 66 69 65 6c 64 73 0a 09 09 09 09 09 09 09 d-fields........
d960: 09 20 23 66 29 0a 09 09 09 09 09 09 09 20 20 20 . #f)........
d970: 20 20 23 66 0a 09 09 09 09 09 09 09 20 20 20 20 #f........
d980: 20 27 6e 6f 72 6d 61 6c 29 0a 09 09 09 09 20 20 'normal).....
d990: 20 20 20 20 20 27 28 29 29 29 29 0a 09 09 20 20 '())))...
d9a0: 20 20 20 28 63 61 73 65 20 64 6d 6f 64 65 0a 09 (case dmode..
d9b0: 09 20 20 20 20 20 20 20 28 28 6a 73 6f 6e 20 6f . ((json o
d9c0: 64 73 20 73 65 78 70 72 29 0a 09 09 09 28 69 66 ds sexpr)....(if
d9d0: 20 72 75 6e 73 2d 73 70 65 63 0a 09 09 09 20 20 runs-spec....
d9e0: 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 09 09 (for-each ....
d9f0: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 66 69 (lambda (fi
da00: 65 6c 64 2d 6e 61 6d 65 29 0a 09 09 09 20 20 20 eld-name)....
da10: 20 20 20 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 (mutils:hier
da20: 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 28 hash-set! data (
da30: 63 6f 6e 63 20 28 64 62 3a 67 65 74 2d 76 61 6c conc (db:get-val
da40: 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e ue-by-header run
da50: 20 68 65 61 64 65 72 20 66 69 65 6c 64 2d 6e 61 header field-na
da60: 6d 65 29 29 20 74 61 72 67 65 74 73 74 72 20 72 me)) targetstr r
da70: 75 6e 6e 61 6d 65 20 22 6d 65 74 61 22 20 66 69 unname "meta" fi
da80: 65 6c 64 2d 6e 61 6d 65 29 29 0a 09 09 09 20 20 eld-name))....
da90: 20 20 20 72 75 6e 73 2d 73 70 65 63 29 29 29 0a runs-spec))).
daa0: 09 09 09 3b 3b 20 28 6d 75 74 69 6c 73 3a 68 69 ...;; (mutils:hi
dab0: 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 erhash-set! data
dac0: 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 (db:get-value-b
dad0: 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 y-header run hea
dae0: 64 65 72 20 22 73 74 61 74 75 73 22 29 20 20 20 der "status")
daf0: 20 20 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e targetstr runn
db00: 61 6d 65 20 22 6d 65 74 61 22 20 22 73 74 61 74 ame "meta" "stat
db10: 75 73 22 20 20 20 20 20 29 0a 09 09 09 3b 3b 20 us" )....;;
db20: 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 (mutils:hierhash
db30: 2d 73 65 74 21 20 64 61 74 61 20 28 64 62 3a 67 -set! data (db:g
db40: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 et-value-by-head
db50: 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 22 73 er run header "s
db60: 74 61 74 65 22 29 20 20 20 20 20 20 74 61 72 67 tate") targ
db70: 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 6d etstr runname "m
db80: 65 74 61 22 20 22 73 74 61 74 65 22 20 20 20 20 eta" "state"
db90: 20 20 29 0a 09 09 09 3b 3b 20 28 6d 75 74 69 6c )....;; (mutil
dba0: 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 s:hierhash-set!
dbb0: 64 61 74 61 20 28 63 6f 6e 63 20 28 64 62 3a 67 data (conc (db:g
dbc0: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 et-value-by-head
dbd0: 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 22 69 er run header "i
dbe0: 64 22 29 29 20 20 74 61 72 67 65 74 73 74 72 20 d")) targetstr
dbf0: 72 75 6e 6e 61 6d 65 20 22 6d 65 74 61 22 20 22 runname "meta" "
dc00: 69 64 22 20 20 20 20 20 20 20 20 20 29 0a 09 09 id" )...
dc10: 09 3b 3b 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 .;; (mutils:hier
dc20: 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 28 hash-set! data (
dc30: 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d db:get-value-by-
dc40: 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 header run heade
dc50: 72 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 29 20 r "event_time")
dc60: 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d targetstr runnam
dc70: 65 20 22 6d 65 74 61 22 20 22 65 76 65 6e 74 5f e "meta" "event_
dc80: 74 69 6d 65 22 20 29 0a 09 09 09 3b 3b 20 28 6d time" )....;; (m
dc90: 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 utils:hierhash-s
dca0: 65 74 21 20 64 61 74 61 20 28 64 62 3a 67 65 74 et! data (db:get
dcb0: 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 -value-by-header
dcc0: 20 72 75 6e 20 68 65 61 64 65 72 20 22 63 6f 6d run header "com
dcd0: 6d 65 6e 74 22 29 20 20 20 20 74 61 72 67 65 74 ment") target
dce0: 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 6d 65 74 str runname "met
dcf0: 61 22 20 22 63 6f 6d 6d 65 6e 74 22 20 20 20 20 a" "comment"
dd00: 29 0a 09 09 09 3b 3b 20 3b 3b 20 61 64 64 20 6c )....;; ;; add l
dd10: 61 73 74 20 65 6e 74 72 79 20 74 77 69 63 65 20 ast entry twice
dd20: 2d 20 73 65 65 6d 73 20 74 6f 20 62 65 20 61 20 - seems to be a
dd30: 62 75 67 20 69 6e 20 68 69 65 72 68 61 73 68 3f bug in hierhash?
dd40: 0a 09 09 09 3b 3b 20 28 6d 75 74 69 6c 73 3a 68 ....;; (mutils:h
dd50: 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 ierhash-set! dat
dd60: 61 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d a (db:get-value-
dd70: 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 by-header run he
dd80: 61 64 65 72 20 22 63 6f 6d 6d 65 6e 74 22 29 20 ader "comment")
dd90: 20 20 20 74 61 72 67 65 74 73 74 72 20 72 75 6e targetstr run
dda0: 6e 61 6d 65 20 22 6d 65 74 61 22 20 22 63 6f 6d name "meta" "com
ddb0: 6d 65 6e 74 22 20 20 20 20 29 0a 09 09 20 20 20 ment" )...
ddc0: 20 20 20 20 28 65 6c 73 65 0a 09 09 09 28 69 66 (else....(if
ddd0: 20 28 6e 75 6c 6c 3f 20 72 75 6e 73 2d 73 70 65 (null? runs-spe
dde0: 63 29 0a 09 09 09 20 20 20 20 28 70 72 69 6e 74 c).... (print
ddf0: 20 22 52 75 6e 3a 20 22 20 74 61 72 67 65 74 73 "Run: " targets
de00: 74 72 20 22 2f 22 20 72 75 6e 6e 61 6d 65 20 0a tr "/" runname .
de10: 09 09 09 09 20 20 20 22 20 73 74 61 74 75 73 3a .... " status:
de20: 20 22 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 " (db:get-value
de30: 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 -by-header run h
de40: 65 61 64 65 72 20 22 73 74 61 74 65 22 29 0a 09 eader "state")..
de50: 09 09 09 20 20 20 22 20 72 75 6e 2d 69 64 3a 20 ... " run-id:
de60: 22 20 72 75 6e 2d 69 64 20 22 2c 20 6e 75 6d 62 " run-id ", numb
de70: 65 72 20 74 65 73 74 73 3a 20 22 20 28 6c 65 6e er tests: " (len
de80: 67 74 68 20 74 65 73 74 73 29 0a 09 09 09 09 20 gth tests).....
de90: 20 20 22 20 65 76 65 6e 74 5f 74 69 6d 65 3a 20 " event_time:
dea0: 22 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d " (db:get-value-
deb0: 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 by-header run he
dec0: 61 64 65 72 20 22 65 76 65 6e 74 5f 74 69 6d 65 ader "event_time
ded0: 22 29 29 0a 09 09 09 20 20 20 20 28 62 65 67 69 ")).... (begi
dee0: 6e 0a 09 09 09 20 20 20 20 20 20 28 69 66 20 28 n.... (if (
def0: 6e 6f 74 20 28 6d 65 6d 62 65 72 20 22 74 61 72 not (member "tar
df00: 67 65 74 22 20 72 75 6e 73 2d 73 70 65 63 29 29 get" runs-spec))
df10: 0a 09 09 09 20 20 20 20 20 20 20 20 20 20 3b 3b .... ;;
df20: 20 28 64 69 73 70 6c 61 79 20 28 63 6f 6e 63 20 (display (conc
df30: 22 54 61 72 67 65 74 3a 20 22 20 74 61 72 67 65 "Target: " targe
df40: 74 73 74 72 29 29 0a 09 09 09 20 20 20 20 20 20 tstr))....
df50: 20 20 20 20 28 64 69 73 70 6c 61 79 20 28 63 6f (display (co
df60: 6e 63 20 22 52 75 6e 3a 20 22 20 74 61 72 67 65 nc "Run: " targe
df70: 74 73 74 72 20 22 2f 22 20 72 75 6e 6e 61 6d 65 tstr "/" runname
df80: 20 22 20 22 29 29 29 0a 09 09 09 20 20 20 20 20 " ")))....
df90: 20 28 66 6f 72 2d 65 61 63 68 0a 09 09 09 20 20 (for-each....
dfa0: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 66 69 (lambda (fi
dfb0: 65 6c 64 2d 6e 61 6d 65 29 0a 09 09 09 09 20 28 eld-name)..... (
dfc0: 69 66 20 28 65 71 75 61 6c 3f 20 66 69 65 6c 64 if (equal? field
dfd0: 2d 6e 61 6d 65 20 22 74 61 72 67 65 74 22 29 0a -name "target").
dfe0: 09 09 09 09 20 20 20 20 20 28 64 69 73 70 6c 61 .... (displa
dff0: 79 20 28 63 6f 6e 63 20 22 74 61 72 67 65 74 3a y (conc "target:
e000: 20 22 20 74 61 72 67 65 74 73 74 72 20 22 20 22 " targetstr " "
e010: 29 29 0a 09 09 09 09 20 20 20 20 20 28 64 69 73 ))..... (dis
e020: 70 6c 61 79 20 28 63 6f 6e 63 20 66 69 65 6c 64 play (conc field
e030: 2d 6e 61 6d 65 20 22 3a 20 22 20 28 64 62 3a 67 -name ": " (db:g
e040: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 et-value-by-head
e050: 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 28 63 er run header (c
e060: 6f 6e 63 20 66 69 65 6c 64 2d 6e 61 6d 65 29 29 onc field-name))
e070: 20 22 20 22 29 29 29 29 0a 09 09 09 20 20 20 20 " "))))....
e080: 20 20 20 72 75 6e 73 2d 73 70 65 63 29 0a 09 09 runs-spec)...
e090: 09 20 20 20 20 20 20 28 6e 65 77 6c 69 6e 65 29 . (newline)
e0a0: 29 29 29 29 0a 09 09 20 20 20 20 20 20 20 0a 09 ))))... ..
e0b0: 09 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 . (for-each
e0c0: 0a 09 09 20 20 20 20 20 20 28 6c 61 6d 62 64 61 ... (lambda
e0d0: 20 28 74 65 73 74 29 0a 09 09 20 20 20 20 20 20 (test)...
e0e0: 09 28 63 6f 6d 6d 6f 6e 3a 64 65 62 75 67 2d 68 .(common:debug-h
e0f0: 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 andle-exceptions
e100: 20 23 66 0a 09 09 09 20 65 78 6e 0a 09 09 09 20 #f.... exn....
e110: 28 62 65 67 69 6e 0a 09 09 09 20 20 20 28 64 65 (begin.... (de
e120: 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 bug:print-error
e130: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
e140: 6f 72 74 2a 20 22 42 61 64 20 64 61 74 61 20 69 ort* "Bad data i
e150: 6e 20 74 65 73 74 20 72 65 63 6f 72 64 3f 20 22 n test record? "
e160: 20 74 65 73 74 29 0a 09 09 09 20 20 20 28 64 65 test).... (de
e170: 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 bug:print-error
e180: 35 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 5 *default-log-p
e190: 6f 72 74 2a 20 22 65 78 6e 3d 22 20 28 63 6f 6e ort* "exn=" (con
e1a0: 64 69 74 69 6f 6e 2d 3e 6c 69 73 74 20 65 78 6e dition->list exn
e1b0: 29 29 0a 09 09 09 20 20 20 28 64 65 62 75 67 3a )).... (debug:
e1c0: 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
e1d0: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 20 6d 65 73 -log-port* " mes
e1e0: 73 61 67 65 3a 20 22 20 28 28 63 6f 6e 64 69 74 sage: " ((condit
e1f0: 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 ion-property-acc
e200: 65 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 essor 'exn 'mess
e210: 61 67 65 29 20 65 78 6e 29 29 0a 09 09 09 20 20 age) exn))....
e220: 20 28 70 72 69 6e 74 2d 63 61 6c 6c 2d 63 68 61 (print-call-cha
e230: 69 6e 20 28 63 75 72 72 65 6e 74 2d 65 72 72 6f in (current-erro
e240: 72 2d 70 6f 72 74 29 29 29 0a 09 09 09 20 28 6c r-port))).... (l
e250: 65 74 2a 20 28 28 74 65 73 74 2d 69 64 20 20 20 et* ((test-id
e260: 20 20 20 28 69 66 20 28 6d 65 6d 62 65 72 20 22 (if (member "
e270: 69 64 22 20 20 20 20 20 20 20 20 20 20 20 74 65 id" te
e280: 73 74 73 2d 73 70 65 63 29 28 67 65 74 2d 76 61 sts-spec)(get-va
e290: 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 lue-by-fieldname
e2a0: 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 test test-field
e2b0: 2d 69 6e 64 65 78 20 22 69 64 22 20 20 20 20 20 -index "id"
e2c0: 20 20 20 20 20 29 20 23 66 29 29 20 3b 3b 20 28 ) #f)) ;; (
e2d0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 64 20 20 db:test-get-id
e2e0: 20 20 20 20 20 20 20 74 65 73 74 29 29 0a 09 09 test))...
e2f0: 09 09 28 74 65 73 74 6e 61 6d 65 20 20 20 20 20 ..(testname
e300: 28 69 66 20 28 6d 65 6d 62 65 72 20 22 74 65 73 (if (member "tes
e310: 74 6e 61 6d 65 22 20 20 20 20 20 74 65 73 74 73 tname" tests
e320: 2d 73 70 65 63 29 28 67 65 74 2d 76 61 6c 75 65 -spec)(get-value
e330: 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 -by-fieldname te
e340: 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e st test-field-in
e350: 64 65 78 20 22 74 65 73 74 6e 61 6d 65 22 20 20 dex "testname"
e360: 20 20 29 20 23 66 29 29 20 3b 3b 20 28 64 62 3a ) #f)) ;; (db:
e370: 74 65 73 74 2d 67 65 74 2d 74 65 73 74 6e 61 6d test-get-testnam
e380: 65 20 20 20 74 65 73 74 29 29 0a 09 09 09 09 28 e test)).....(
e390: 69 74 65 6d 70 61 74 68 20 20 20 20 20 28 69 66 itempath (if
e3a0: 20 28 6d 65 6d 62 65 72 20 22 69 74 65 6d 5f 70 (member "item_p
e3b0: 61 74 68 22 20 20 20 20 74 65 73 74 73 2d 73 70 ath" tests-sp
e3c0: 65 63 29 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 ec)(get-value-by
e3d0: 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 -fieldname test
e3e0: 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 test-field-index
e3f0: 20 22 69 74 65 6d 5f 70 61 74 68 22 20 20 20 29 "item_path" )
e400: 20 23 66 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 #f)) ;; (db:tes
e410: 74 2d 67 65 74 2d 69 74 65 6d 2d 70 61 74 68 20 t-get-item-path
e420: 20 74 65 73 74 29 29 0a 09 09 09 09 28 63 6f 6d test)).....(com
e430: 6d 65 6e 74 20 20 20 20 20 20 28 69 66 20 28 6d ment (if (m
e440: 65 6d 62 65 72 20 22 63 6f 6d 6d 65 6e 74 22 20 ember "comment"
e450: 20 20 20 20 20 74 65 73 74 73 2d 73 70 65 63 29 tests-spec)
e460: 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 (get-value-by-fi
e470: 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 eldname test tes
e480: 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 63 t-field-index "c
e490: 6f 6d 6d 65 6e 74 22 20 20 20 20 20 29 20 23 66 omment" ) #f
e4a0: 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 )) ;; (db:test-g
e4b0: 65 74 2d 63 6f 6d 6d 65 6e 74 20 20 20 20 74 65 et-comment te
e4c0: 73 74 29 29 0a 09 09 09 09 28 74 73 74 61 74 65 st)).....(tstate
e4d0: 20 20 20 20 20 20 20 28 69 66 20 28 6d 65 6d 62 (if (memb
e4e0: 65 72 20 22 73 74 61 74 65 22 20 20 20 20 20 20 er "state"
e4f0: 20 20 74 65 73 74 73 2d 73 70 65 63 29 28 67 65 tests-spec)(ge
e500: 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 t-value-by-field
e510: 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 name test test-f
e520: 69 65 6c 64 2d 69 6e 64 65 78 20 22 73 74 61 74 ield-index "stat
e530: 65 22 20 20 20 20 20 20 20 29 20 23 66 29 29 20 e" ) #f))
e540: 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d ;; (db:test-get-
e550: 73 74 61 74 65 20 20 20 20 20 20 74 65 73 74 29 state test)
e560: 29 0a 09 09 09 09 28 74 73 74 61 74 75 73 20 20 ).....(tstatus
e570: 20 20 20 20 28 69 66 20 28 6d 65 6d 62 65 72 20 (if (member
e580: 22 73 74 61 74 75 73 22 20 20 20 20 20 20 20 74 "status" t
e590: 65 73 74 73 2d 73 70 65 63 29 28 67 65 74 2d 76 ests-spec)(get-v
e5a0: 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d alue-by-fieldnam
e5b0: 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c e test test-fiel
e5c0: 64 2d 69 6e 64 65 78 20 22 73 74 61 74 75 73 22 d-index "status"
e5d0: 20 20 20 20 20 20 29 20 23 66 29 29 20 3b 3b 20 ) #f)) ;;
e5e0: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 (db:test-get-sta
e5f0: 74 75 73 20 20 20 20 20 74 65 73 74 29 29 0a 09 tus test))..
e600: 09 09 09 28 65 76 65 6e 74 2d 74 69 6d 65 20 20 ...(event-time
e610: 20 28 69 66 20 28 6d 65 6d 62 65 72 20 22 65 76 (if (member "ev
e620: 65 6e 74 5f 74 69 6d 65 22 20 20 20 74 65 73 74 ent_time" test
e630: 73 2d 73 70 65 63 29 28 67 65 74 2d 76 61 6c 75 s-spec)(get-valu
e640: 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 e-by-fieldname t
e650: 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 est test-field-i
e660: 6e 64 65 78 20 22 65 76 65 6e 74 5f 74 69 6d 65 ndex "event_time
e670: 22 20 20 29 20 23 66 29 29 20 3b 3b 20 28 64 62 " ) #f)) ;; (db
e680: 3a 74 65 73 74 2d 67 65 74 2d 65 76 65 6e 74 5f :test-get-event_
e690: 74 69 6d 65 20 74 65 73 74 29 29 0a 09 09 09 09 time test)).....
e6a0: 28 72 75 6e 64 69 72 20 20 20 20 20 20 20 28 69 (rundir (i
e6b0: 66 20 28 6d 65 6d 62 65 72 20 22 72 75 6e 64 69 f (member "rundi
e6c0: 72 22 20 20 20 20 20 20 20 74 65 73 74 73 2d 73 r" tests-s
e6d0: 70 65 63 29 28 67 65 74 2d 76 61 6c 75 65 2d 62 pec)(get-value-b
e6e0: 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 y-fieldname test
e6f0: 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 test-field-inde
e700: 78 20 22 72 75 6e 64 69 72 22 20 20 20 20 20 20 x "rundir"
e710: 29 20 23 66 29 29 20 3b 3b 20 28 64 62 3a 74 65 ) #f)) ;; (db:te
e720: 73 74 2d 67 65 74 2d 72 75 6e 64 69 72 20 20 20 st-get-rundir
e730: 20 20 74 65 73 74 29 29 0a 09 09 09 09 28 66 69 test)).....(fi
e740: 6e 61 6c 5f 6c 6f 67 66 20 20 20 28 69 66 20 28 nal_logf (if (
e750: 6d 65 6d 62 65 72 20 22 66 69 6e 61 6c 5f 6c 6f member "final_lo
e760: 67 66 22 20 20 20 74 65 73 74 73 2d 73 70 65 63 gf" tests-spec
e770: 29 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 )(get-value-by-f
e780: 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 ieldname test te
e790: 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 st-field-index "
e7a0: 66 69 6e 61 6c 5f 6c 6f 67 66 22 20 20 29 20 23 final_logf" ) #
e7b0: 66 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d f)) ;; (db:test-
e7c0: 67 65 74 2d 66 69 6e 61 6c 5f 6c 6f 67 66 20 74 get-final_logf t
e7d0: 65 73 74 29 29 0a 09 09 09 09 28 72 75 6e 5f 64 est)).....(run_d
e7e0: 75 72 61 74 69 6f 6e 20 28 69 66 20 28 6d 65 6d uration (if (mem
e7f0: 62 65 72 20 22 72 75 6e 5f 64 75 72 61 74 69 6f ber "run_duratio
e800: 6e 22 20 74 65 73 74 73 2d 73 70 65 63 29 28 67 n" tests-spec)(g
e810: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c et-value-by-fiel
e820: 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d dname test test-
e830: 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 72 75 6e field-index "run
e840: 5f 64 75 72 61 74 69 6f 6e 22 29 20 23 66 29 29 _duration") #f))
e850: 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 ;; (db:test-get
e860: 2d 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 74 65 -run_duration te
e870: 73 74 29 29 0a 09 09 09 09 28 66 75 6c 6c 6e 61 st)).....(fullna
e880: 6d 65 20 20 20 20 20 28 63 6f 6e 63 20 74 65 73 me (conc tes
e890: 74 6e 61 6d 65 0a 09 09 09 09 09 09 20 20 20 20 tname.......
e8a0: 28 69 66 20 28 65 71 75 61 6c 3f 20 69 74 65 6d (if (equal? item
e8b0: 70 61 74 68 20 22 22 29 0a 09 09 09 09 09 09 09 path "")........
e8c0: 22 22 20 0a 09 09 09 09 09 09 09 28 63 6f 6e 63 "" ........(conc
e8d0: 20 22 28 22 20 69 74 65 6d 70 61 74 68 20 22 29 "(" itempath ")
e8e0: 22 29 29 29 29 29 0a 09 09 09 20 20 20 28 63 61 "))))).... (ca
e8f0: 73 65 20 64 6d 6f 64 65 0a 09 09 09 20 20 20 20 se dmode....
e900: 20 28 28 6a 73 6f 6e 20 6f 64 73 20 73 65 78 70 ((json ods sexp
e910: 72 29 0a 09 09 09 20 20 20 20 20 20 28 69 66 20 r).... (if
e920: 74 65 73 74 73 2d 73 70 65 63 0a 09 09 09 09 20 tests-spec.....
e930: 20 28 66 6f 72 2d 65 61 63 68 0a 09 09 09 09 20 (for-each.....
e940: 20 20 28 6c 61 6d 62 64 61 20 28 66 69 65 6c 64 (lambda (field
e950: 2d 6e 61 6d 65 29 0a 09 09 09 09 20 20 20 20 20 -name).....
e960: 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 (mutils:hierhash
e970: 2d 73 65 74 21 20 64 61 74 61 20 20 28 67 65 74 -set! data (get
e980: 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e -value-by-fieldn
e990: 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 ame test test-fi
e9a0: 65 6c 64 2d 69 6e 64 65 78 20 66 69 65 6c 64 2d eld-index field-
e9b0: 6e 61 6d 65 29 20 74 61 72 67 65 74 73 74 72 20 name) targetstr
e9c0: 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 28 runname "data" (
e9d0: 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 66 69 conc test-id) fi
e9e0: 65 6c 64 2d 6e 61 6d 65 29 29 0a 09 09 09 09 20 eld-name)).....
e9f0: 20 20 74 65 73 74 73 2d 73 70 65 63 29 29 29 0a tests-spec))).
ea00: 09 09 09 20 20 20 20 20 3b 3b 20 3b 3b 20 28 6d ... ;; ;; (m
ea10: 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 utils:hierhash-s
ea20: 65 74 21 20 64 61 74 61 20 20 66 75 6c 6c 6e 61 et! data fullna
ea30: 6d 65 20 20 20 74 61 72 67 65 74 73 74 72 20 72 me targetstr r
ea40: 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 28 63 unname "data" (c
ea50: 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 22 74 6e onc test-id) "tn
ea60: 61 6d 65 22 20 20 20 20 20 29 0a 09 09 09 20 20 ame" )....
ea70: 20 20 20 3b 3b 20 20 28 6d 75 74 69 6c 73 3a 68 ;; (mutils:h
ea80: 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 ierhash-set! dat
ea90: 61 20 20 74 65 73 74 6e 61 6d 65 20 20 20 74 61 a testname ta
eaa0: 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 rgetstr runname
eab0: 22 64 61 74 61 22 20 28 63 6f 6e 63 20 74 65 73 "data" (conc tes
eac0: 74 2d 69 64 29 20 22 74 65 73 74 6e 61 6d 65 22 t-id) "testname"
ead0: 20 20 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 ).... ;;
eae0: 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 68 (mutils:hierhash
eaf0: 2d 73 65 74 21 20 64 61 74 61 20 20 69 74 65 6d -set! data item
eb00: 70 61 74 68 20 20 20 74 61 72 67 65 74 73 74 72 path targetstr
eb10: 20 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 runname "data"
eb20: 28 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 22 (conc test-id) "
eb30: 69 74 65 6d 70 61 74 68 22 20 20 29 0a 09 09 09 itempath" )....
eb40: 20 20 20 20 20 3b 3b 20 20 28 6d 75 74 69 6c 73 ;; (mutils
eb50: 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 20 64 :hierhash-set! d
eb60: 61 74 61 20 20 63 6f 6d 6d 65 6e 74 20 20 20 20 ata comment
eb70: 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d targetstr runnam
eb80: 65 20 22 64 61 74 61 22 20 28 63 6f 6e 63 20 74 e "data" (conc t
eb90: 65 73 74 2d 69 64 29 20 22 63 6f 6d 6d 65 6e 74 est-id) "comment
eba0: 22 20 20 20 29 0a 09 09 09 20 20 20 20 20 3b 3b " ).... ;;
ebb0: 20 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 (mutils:hierha
ebc0: 73 68 2d 73 65 74 21 20 64 61 74 61 20 20 74 73 sh-set! data ts
ebd0: 74 61 74 65 20 20 20 20 20 74 61 72 67 65 74 73 tate targets
ebe0: 74 72 20 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 tr runname "data
ebf0: 22 20 28 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 " (conc test-id)
ec00: 20 22 73 74 61 74 65 22 20 20 20 20 20 29 0a 09 "state" )..
ec10: 09 09 20 20 20 20 20 3b 3b 20 20 28 6d 75 74 69 .. ;; (muti
ec20: 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 74 21 ls:hierhash-set!
ec30: 20 64 61 74 61 20 20 74 73 74 61 74 75 73 20 20 data tstatus
ec40: 20 20 74 61 72 67 65 74 73 74 72 20 72 75 6e 6e targetstr runn
ec50: 61 6d 65 20 22 64 61 74 61 22 20 28 63 6f 6e 63 ame "data" (conc
ec60: 20 74 65 73 74 2d 69 64 29 20 22 73 74 61 74 75 test-id) "statu
ec70: 73 22 20 20 20 20 29 0a 09 09 09 20 20 20 20 20 s" )....
ec80: 3b 3b 20 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 ;; (mutils:hier
ec90: 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 20 hash-set! data
eca0: 72 75 6e 64 69 72 20 20 20 20 20 74 61 72 67 65 rundir targe
ecb0: 74 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 64 61 tstr runname "da
ecc0: 74 61 22 20 28 63 6f 6e 63 20 74 65 73 74 2d 69 ta" (conc test-i
ecd0: 64 29 20 22 72 75 6e 64 69 72 22 20 20 20 20 29 d) "rundir" )
ece0: 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 28 6d 75 .... ;; (mu
ecf0: 74 69 6c 73 3a 68 69 65 72 68 61 73 68 2d 73 65 tils:hierhash-se
ed00: 74 21 20 64 61 74 61 20 20 66 69 6e 61 6c 5f 6c t! data final_l
ed10: 6f 67 66 20 74 61 72 67 65 74 73 74 72 20 72 75 ogf targetstr ru
ed20: 6e 6e 61 6d 65 20 22 64 61 74 61 22 20 28 63 6f nname "data" (co
ed30: 6e 63 20 74 65 73 74 2d 69 64 29 20 22 66 69 6e nc test-id) "fin
ed40: 61 6c 5f 6c 6f 67 66 22 29 0a 09 09 09 20 20 20 al_logf")....
ed50: 20 20 3b 3b 20 20 28 6d 75 74 69 6c 73 3a 68 69 ;; (mutils:hi
ed60: 65 72 68 61 73 68 2d 73 65 74 21 20 64 61 74 61 erhash-set! data
ed70: 20 20 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 74 run_duration t
ed80: 61 72 67 65 74 73 74 72 20 72 75 6e 6e 61 6d 65 argetstr runname
ed90: 20 22 64 61 74 61 22 20 28 63 6f 6e 63 20 74 65 "data" (conc te
eda0: 73 74 2d 69 64 29 20 22 72 75 6e 5f 64 75 72 61 st-id) "run_dura
edb0: 74 69 6f 6e 22 29 0a 09 09 09 20 20 20 20 20 3b tion").... ;
edc0: 3b 20 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 ; (mutils:hierh
edd0: 61 73 68 2d 73 65 74 21 20 64 61 74 61 20 20 65 ash-set! data e
ede0: 76 65 6e 74 2d 74 69 6d 65 20 74 61 72 67 65 74 vent-time target
edf0: 73 74 72 20 72 75 6e 6e 61 6d 65 20 22 64 61 74 str runname "dat
ee00: 61 22 20 28 63 6f 6e 63 20 74 65 73 74 2d 69 64 a" (conc test-id
ee10: 29 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 29 0a ) "event_time").
ee20: 09 09 09 20 20 20 20 20 3b 3b 20 20 3b 3b 20 61 ... ;; ;; a
ee30: 64 64 20 6c 61 73 74 20 65 6e 74 72 79 20 74 77 dd last entry tw
ee40: 69 63 65 20 2d 20 73 65 65 6d 73 20 74 6f 20 62 ice - seems to b
ee50: 65 20 61 20 62 75 67 20 69 6e 20 68 69 65 72 68 e a bug in hierh
ee60: 61 73 68 3f 0a 09 09 09 20 20 20 20 20 3b 3b 20 ash?.... ;;
ee70: 20 28 6d 75 74 69 6c 73 3a 68 69 65 72 68 61 73 (mutils:hierhas
ee80: 68 2d 73 65 74 21 20 64 61 74 61 20 20 65 76 65 h-set! data eve
ee90: 6e 74 2d 74 69 6d 65 20 74 61 72 67 65 74 73 74 nt-time targetst
eea0: 72 20 72 75 6e 6e 61 6d 65 20 22 64 61 74 61 22 r runname "data"
eeb0: 20 28 63 6f 6e 63 20 74 65 73 74 2d 69 64 29 20 (conc test-id)
eec0: 22 65 76 65 6e 74 5f 74 69 6d 65 22 29 0a 09 09 "event_time")...
eed0: 09 20 20 20 20 20 3b 3b 20 20 29 0a 09 09 09 20 . ;; )....
eee0: 20 20 20 20 28 65 6c 73 65 0a 09 09 09 20 20 20 (else....
eef0: 20 20 20 28 69 66 20 28 61 6e 64 20 74 73 74 61 (if (and tsta
ef00: 74 65 20 74 73 74 61 74 75 73 20 65 76 65 6e 74 te tstatus event
ef10: 2d 74 69 6d 65 29 0a 09 09 09 09 20 20 28 66 6f -time)..... (fo
ef20: 72 6d 61 74 20 23 74 0a 09 09 09 09 09 20 20 22 rmat #t...... "
ef30: 20 20 54 65 73 74 3a 20 7e 32 35 61 20 53 74 61 Test: ~25a Sta
ef40: 74 65 3a 20 7e 31 35 61 20 53 74 61 74 75 73 3a te: ~15a Status:
ef50: 20 7e 31 35 61 20 52 75 6e 74 69 6d 65 3a 20 7e ~15a Runtime: ~
ef60: 35 40 61 73 20 54 69 6d 65 3a 20 7e 32 32 61 20 5@as Time: ~22a
ef70: 48 6f 73 74 3a 20 7e 31 30 61 5c 6e 22 0a 09 09 Host: ~10a\n"...
ef80: 09 09 09 20 20 28 69 66 20 66 75 6c 6c 6e 61 6d ... (if fullnam
ef90: 65 20 66 75 6c 6c 6e 61 6d 65 20 22 22 29 0a 09 e fullname "")..
efa0: 09 09 09 09 20 20 28 69 66 20 74 73 74 61 74 65 .... (if tstate
efb0: 20 20 20 74 73 74 61 74 65 20 20 20 22 22 29 0a tstate "").
efc0: 09 09 09 09 09 20 20 28 69 66 20 74 73 74 61 74 ..... (if tstat
efd0: 75 73 20 20 74 73 74 61 74 75 73 20 20 22 22 29 us tstatus "")
efe0: 0a 09 09 09 09 09 20 20 28 67 65 74 2d 76 61 6c ...... (get-val
eff0: 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 ue-by-fieldname
f000: 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d test test-field-
f010: 69 6e 64 65 78 20 22 72 75 6e 5f 64 75 72 61 74 index "run_durat
f020: 69 6f 6e 22 29 3b 3b 28 69 66 20 74 65 73 74 20 ion");;(if test
f030: 20 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 (db:test-get
f040: 2d 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 74 65 -run_duration te
f050: 73 74 29 20 22 22 29 0a 09 09 09 09 09 20 20 28 st) "")...... (
f060: 69 66 20 65 76 65 6e 74 2d 74 69 6d 65 20 65 76 if event-time ev
f070: 65 6e 74 2d 74 69 6d 65 20 22 22 29 0a 09 09 09 ent-time "")....
f080: 09 09 20 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 .. (get-value-b
f090: 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 y-fieldname test
f0a0: 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 test-field-inde
f0b0: 78 20 22 68 6f 73 74 22 29 29 20 3b 3b 28 69 66 x "host")) ;;(if
f0c0: 20 74 65 73 74 20 28 64 62 3a 74 65 73 74 2d 67 test (db:test-g
f0d0: 65 74 2d 68 6f 73 74 20 74 65 73 74 29 29 20 22 et-host test)) "
f0e0: 22 29 0a 09 09 09 09 20 20 28 70 72 69 6e 74 20 ")..... (print
f0f0: 22 20 20 54 65 73 74 3a 20 22 20 66 75 6c 6c 6e " Test: " fulln
f100: 61 6d 65 0a 09 09 09 09 09 20 28 69 66 20 74 73 ame...... (if ts
f110: 74 61 74 65 20 20 28 63 6f 6e 63 20 22 20 53 74 tate (conc " St
f120: 61 74 65 3a 20 22 20 20 74 73 74 61 74 65 29 20 ate: " tstate)
f130: 20 22 22 29 0a 09 09 09 09 09 20 28 69 66 20 74 "")...... (if t
f140: 73 74 61 74 75 73 20 28 63 6f 6e 63 20 22 20 53 status (conc " S
f150: 74 61 74 75 73 3a 20 22 20 74 73 74 61 74 75 73 tatus: " tstatus
f160: 29 20 22 22 29 0a 09 09 09 09 09 20 28 69 66 20 ) "")...... (if
f170: 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 (get-value-by-fi
f180: 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 eldname test tes
f190: 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 72 t-field-index "r
f1a0: 75 6e 5f 64 75 72 61 74 69 6f 6e 22 29 0a 09 09 un_duration")...
f1b0: 09 09 09 20 20 20 20 20 28 63 6f 6e 63 20 22 20 ... (conc "
f1c0: 52 75 6e 74 69 6d 65 3a 20 22 20 28 67 65 74 2d Runtime: " (get-
f1d0: 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 value-by-fieldna
f1e0: 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 65 me test test-fie
f1f0: 6c 64 2d 69 6e 64 65 78 20 22 72 75 6e 5f 64 75 ld-index "run_du
f200: 72 61 74 69 6f 6e 22 29 29 0a 09 09 09 09 09 20 ration"))......
f210: 20 20 20 20 22 22 29 0a 09 09 09 09 09 20 28 69 "")...... (i
f220: 66 20 65 76 65 6e 74 2d 74 69 6d 65 20 28 63 6f f event-time (co
f230: 6e 63 20 22 20 54 69 6d 65 3a 20 22 20 65 76 65 nc " Time: " eve
f240: 6e 74 2d 74 69 6d 65 29 20 22 22 29 0a 09 09 09 nt-time) "")....
f250: 09 09 20 28 69 66 20 28 67 65 74 2d 76 61 6c 75 .. (if (get-valu
f260: 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 e-by-fieldname t
f270: 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 est test-field-i
f280: 6e 64 65 78 20 22 68 6f 73 74 22 29 0a 09 09 09 ndex "host")....
f290: 09 09 20 20 20 20 20 28 63 6f 6e 63 20 22 20 48 .. (conc " H
f2a0: 6f 73 74 3a 20 22 20 28 67 65 74 2d 76 61 6c 75 ost: " (get-valu
f2b0: 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 e-by-fieldname t
f2c0: 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 est test-field-i
f2d0: 6e 64 65 78 20 22 68 6f 73 74 22 29 29 0a 09 09 ndex "host"))...
f2e0: 09 09 09 20 20 20 20 20 22 22 29 29 29 0a 09 09 ... "")))...
f2f0: 09 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 . (if (not
f300: 28 6f 72 20 28 65 71 75 61 6c 3f 20 28 67 65 74 (or (equal? (get
f310: 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e -value-by-fieldn
f320: 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 ame test test-fi
f330: 65 6c 64 2d 69 6e 64 65 78 20 22 73 74 61 74 75 eld-index "statu
f340: 73 22 29 20 22 50 41 53 53 22 29 0a 09 09 09 09 s") "PASS").....
f350: 09 20 20 20 28 65 71 75 61 6c 3f 20 28 67 65 74 . (equal? (get
f360: 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e -value-by-fieldn
f370: 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 ame test test-fi
f380: 65 6c 64 2d 69 6e 64 65 78 20 22 73 74 61 74 75 eld-index "statu
f390: 73 22 29 20 22 57 41 52 4e 22 29 0a 09 09 09 09 s") "WARN").....
f3a0: 09 20 20 20 28 65 71 75 61 6c 3f 20 28 67 65 74 . (equal? (get
f3b0: 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c 64 6e -value-by-fieldn
f3c0: 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d 66 69 ame test test-fi
f3d0: 65 6c 64 2d 69 6e 64 65 78 20 22 73 74 61 74 65 eld-index "state
f3e0: 22 29 20 20 22 4e 4f 54 5f 53 54 41 52 54 45 44 ") "NOT_STARTED
f3f0: 22 29 29 29 0a 09 09 09 09 20 20 28 62 65 67 69 ")))..... (begi
f400: 6e 0a 09 09 09 09 20 20 20 20 28 70 72 69 6e 74 n..... (print
f410: 20 20 20 28 69 66 20 28 67 65 74 2d 76 61 6c 75 (if (get-valu
f420: 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 e-by-fieldname t
f430: 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 est test-field-i
f440: 6e 64 65 78 20 22 63 70 75 6c 6f 61 64 22 29 0a ndex "cpuload").
f450: 09 09 09 09 09 09 20 28 63 6f 6e 63 20 22 20 20 ...... (conc "
f460: 20 20 20 20 20 20 20 63 70 75 6c 6f 61 64 3a 20 cpuload:
f470: 20 22 20 20 20 28 67 65 74 2d 76 61 6c 75 65 2d " (get-value-
f480: 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 by-fieldname tes
f490: 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 t test-field-ind
f4a0: 65 78 20 22 63 70 75 6c 6f 61 64 22 29 29 0a 09 ex "cpuload"))..
f4b0: 09 09 09 09 09 20 22 22 29 20 3b 3b 20 28 64 62 ..... "") ;; (db
f4c0: 3a 74 65 73 74 2d 67 65 74 2d 63 70 75 6c 6f 61 :test-get-cpuloa
f4d0: 64 20 74 65 73 74 29 0a 09 09 09 09 09 20 20 20 d test)......
f4e0: 20 20 28 69 66 20 28 67 65 74 2d 76 61 6c 75 65 (if (get-value
f4f0: 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 -by-fieldname te
f500: 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e st test-field-in
f510: 64 65 78 20 22 64 69 73 6b 66 72 65 65 22 29 0a dex "diskfree").
f520: 09 09 09 09 09 09 20 28 63 6f 6e 63 20 22 5c 6e ...... (conc "\n
f530: 20 20 20 20 20 20 20 20 20 64 69 73 6b 66 72 65 diskfre
f540: 65 3a 20 22 20 28 67 65 74 2d 76 61 6c 75 65 2d e: " (get-value-
f550: 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 by-fieldname tes
f560: 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 t test-field-ind
f570: 65 78 20 22 64 69 73 6b 66 72 65 65 22 29 29 20 ex "diskfree"))
f580: 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d ;; (db:test-get-
f590: 64 69 73 6b 66 72 65 65 20 74 65 73 74 29 0a 09 diskfree test)..
f5a0: 09 09 09 09 09 20 22 22 29 0a 09 09 09 09 09 20 ..... "")......
f5b0: 20 20 20 20 28 69 66 20 28 67 65 74 2d 76 61 6c (if (get-val
f5c0: 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 ue-by-fieldname
f5d0: 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d test test-field-
f5e0: 69 6e 64 65 78 20 22 75 6e 61 6d 65 22 29 0a 09 index "uname")..
f5f0: 09 09 09 09 09 20 28 63 6f 6e 63 20 22 5c 6e 20 ..... (conc "\n
f600: 20 20 20 20 20 20 20 20 75 6e 61 6d 65 3a 20 20 uname:
f610: 20 20 22 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 " (get-value-b
f620: 79 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 y-fieldname test
f630: 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 test-field-inde
f640: 78 20 22 75 6e 61 6d 65 22 29 29 20 3b 3b 20 28 x "uname")) ;; (
f650: 64 62 3a 74 65 73 74 2d 67 65 74 2d 75 6e 61 6d db:test-get-unam
f660: 65 20 74 65 73 74 29 0a 09 09 09 09 09 09 20 22 e test)....... "
f670: 22 29 0a 09 09 09 09 09 20 20 20 20 20 28 69 66 ")...... (if
f680: 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 (get-value-by-f
f690: 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 74 65 ieldname test te
f6a0: 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 st-field-index "
f6b0: 72 75 6e 64 69 72 22 29 0a 09 09 09 09 09 09 20 rundir").......
f6c0: 28 63 6f 6e 63 20 22 5c 6e 20 20 20 20 20 20 20 (conc "\n
f6d0: 20 20 72 75 6e 64 69 72 3a 20 20 20 22 20 28 67 rundir: " (g
f6e0: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 66 69 65 6c et-value-by-fiel
f6f0: 64 6e 61 6d 65 20 74 65 73 74 20 74 65 73 74 2d dname test test-
f700: 66 69 65 6c 64 2d 69 6e 64 65 78 20 22 72 75 6e field-index "run
f710: 64 69 72 22 29 29 20 3b 3b 20 28 64 62 3a 74 65 dir")) ;; (db:te
f720: 73 74 2d 67 65 74 2d 72 75 6e 64 69 72 20 74 65 st-get-rundir te
f730: 73 74 29 0a 09 09 09 09 09 09 20 22 22 29 0a 3b st)....... "").;
f740: 3b 09 09 09 09 09 20 20 20 20 20 22 5c 6e 20 20 ;..... "\n
f750: 20 20 20 20 20 20 20 72 75 6e 64 69 72 3a 20 20 rundir:
f760: 20 22 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 79 " (get-value-by
f770: 2d 66 69 65 6c 64 6e 61 6d 65 20 74 65 73 74 20 -fieldname test
f780: 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e 64 65 78 test-field-index
f790: 20 22 22 29 20 3b 3b 20 28 73 64 62 3a 71 72 79 "") ;; (sdb:qry
f7a0: 20 27 67 65 74 73 74 72 20 3b 3b 20 28 66 69 6c 'getstr ;; (fil
f7b0: 65 64 62 3a 67 65 74 2d 70 61 74 68 20 2a 66 64 edb:get-path *fd
f7c0: 62 2a 20 0a 3b 3b 20 09 09 09 09 09 20 20 20 20 b* .;; .....
f7d0: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 (db:test-get-ru
f7e0: 6e 64 69 72 20 74 65 73 74 29 20 3b 3b 20 29 0a ndir test) ;; ).
f7f0: 09 09 09 09 09 20 20 20 20 20 29 0a 09 09 09 09 ..... ).....
f800: 20 20 20 20 3b 3b 20 45 61 63 68 20 74 65 73 74 ;; Each test
f810: 0a 09 09 09 09 20 20 20 20 3b 3b 20 44 4f 20 4e ..... ;; DO N
f820: 4f 54 20 72 65 6d 6f 74 65 20 72 75 6e 0a 09 09 OT remote run...
f830: 09 09 20 20 20 20 28 6c 65 74 20 28 28 73 74 65 .. (let ((ste
f840: 70 73 20 28 64 62 3a 64 69 73 70 61 74 63 68 2d ps (db:dispatch-
f850: 71 75 65 72 79 20 61 63 63 65 73 73 2d 6d 6f 64 query access-mod
f860: 65 20 72 6d 74 3a 67 65 74 2d 73 74 65 70 73 2d e rmt:get-steps-
f870: 66 6f 72 2d 74 65 73 74 20 64 62 3a 67 65 74 2d for-test db:get-
f880: 73 74 65 70 73 2d 66 6f 72 2d 74 65 73 74 20 72 steps-for-test r
f890: 75 6e 2d 69 64 20 28 64 62 3a 74 65 73 74 2d 67 un-id (db:test-g
f8a0: 65 74 2d 69 64 20 74 65 73 74 29 29 29 29 20 3b et-id test)))) ;
f8b0: 3b 20 28 64 62 3a 67 65 74 2d 73 74 65 70 73 2d ; (db:get-steps-
f8c0: 66 6f 72 2d 74 65 73 74 20 64 62 73 74 72 75 63 for-test dbstruc
f8d0: 74 20 72 75 6e 2d 69 64 20 28 64 62 3a 74 65 73 t run-id (db:tes
f8e0: 74 2d 67 65 74 2d 69 64 20 74 65 73 74 29 29 29 t-get-id test)))
f8f0: 29 0a 09 09 09 09 20 20 20 20 20 20 28 66 6f 72 )..... (for
f900: 2d 65 61 63 68 20 0a 09 09 09 09 20 20 20 20 20 -each .....
f910: 20 20 28 6c 61 6d 62 64 61 20 28 73 74 65 70 29 (lambda (step)
f920: 0a 09 09 09 09 09 20 28 66 6f 72 6d 61 74 20 23 ...... (format #
f930: 74 20 0a 09 09 09 09 09 09 20 22 20 20 20 20 53 t ....... " S
f940: 74 65 70 3a 20 7e 32 30 61 20 53 74 61 74 65 3a tep: ~20a State:
f950: 20 7e 31 30 61 20 53 74 61 74 75 73 3a 20 7e 31 ~10a Status: ~1
f960: 30 61 20 54 69 6d 65 20 7e 32 32 61 5c 6e 22 0a 0a Time ~22a\n".
f970: 09 09 09 09 09 09 20 28 74 64 62 3a 73 74 65 70 ...... (tdb:step
f980: 2d 67 65 74 2d 73 74 65 70 6e 61 6d 65 20 73 74 -get-stepname st
f990: 65 70 29 0a 09 09 09 09 09 09 20 28 74 64 62 3a ep)....... (tdb:
f9a0: 73 74 65 70 2d 67 65 74 2d 73 74 61 74 65 20 73 step-get-state s
f9b0: 74 65 70 29 0a 09 09 09 09 09 09 20 28 74 64 62 tep)....... (tdb
f9c0: 3a 73 74 65 70 2d 67 65 74 2d 73 74 61 74 75 73 :step-get-status
f9d0: 20 73 74 65 70 29 0a 09 09 09 09 09 09 20 28 74 step)....... (t
f9e0: 64 62 3a 73 74 65 70 2d 67 65 74 2d 65 76 65 6e db:step-get-even
f9f0: 74 5f 74 69 6d 65 20 73 74 65 70 29 29 29 0a 09 t_time step)))..
fa00: 09 09 09 20 20 20 20 20 20 20 73 74 65 70 73 29 ... steps)
fa10: 29 29 29 29 29 29 29 29 0a 09 09 20 20 20 20 20 ))))))))...
fa20: 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
fa30: 72 67 20 22 2d 73 6f 72 74 22 29 0a 09 09 09 20 rg "-sort")....
fa40: 20 28 73 6f 72 74 20 74 65 73 74 73 0a 09 09 09 (sort tests....
fa50: 09 28 6c 61 6d 62 64 61 20 28 61 2d 74 65 73 74 .(lambda (a-test
fa60: 20 62 2d 74 65 73 74 29 0a 09 09 09 09 20 20 28 b-test)..... (
fa70: 6c 65 74 2a 20 28 28 6b 65 79 20 20 20 20 28 61 let* ((key (a
fa80: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 6f rgs:get-arg "-so
fa90: 72 74 22 29 29 0a 09 09 09 09 09 20 28 66 69 72 rt"))...... (fir
faa0: 73 74 20 20 28 67 65 74 2d 76 61 6c 75 65 2d 62 st (get-value-b
fab0: 79 2d 66 69 65 6c 64 6e 61 6d 65 20 61 2d 74 65 y-fieldname a-te
fac0: 73 74 20 74 65 73 74 2d 66 69 65 6c 64 2d 69 6e st test-field-in
fad0: 64 65 78 20 6b 65 79 29 29 0a 09 09 09 09 09 20 dex key))......
fae0: 28 73 65 63 6f 6e 64 20 28 67 65 74 2d 76 61 6c (second (get-val
faf0: 75 65 2d 62 79 2d 66 69 65 6c 64 6e 61 6d 65 20 ue-by-fieldname
fb00: 62 2d 74 65 73 74 20 74 65 73 74 2d 66 69 65 6c b-test test-fiel
fb10: 64 2d 69 6e 64 65 78 20 6b 65 79 29 29 29 0a 09 d-index key)))..
fb20: 09 09 09 20 20 20 20 28 28 63 6f 6e 64 20 0a 09 ... ((cond ..
fb30: 09 09 09 20 20 20 20 20 20 28 28 61 6e 64 20 28 ... ((and (
fb40: 6e 75 6d 62 65 72 3f 20 66 69 72 73 74 29 28 6e number? first)(n
fb50: 75 6d 62 65 72 3f 20 73 65 63 6f 6e 64 29 29 20 umber? second))
fb60: 3c 29 0a 09 09 09 09 20 20 20 20 20 20 28 28 61 <)..... ((a
fb70: 6e 64 20 28 73 74 72 69 6e 67 3f 20 66 69 72 73 nd (string? firs
fb80: 74 29 28 73 74 72 69 6e 67 3f 20 73 65 63 6f 6e t)(string? secon
fb90: 64 29 29 20 73 74 72 69 6e 67 3c 3d 3f 29 0a 09 d)) string<=?)..
fba0: 09 09 09 20 20 20 20 20 20 28 65 6c 73 65 20 65 ... (else e
fbb0: 71 75 61 6c 3f 29 29 0a 09 09 09 09 20 20 20 20 qual?)).....
fbc0: 20 66 69 72 73 74 20 73 65 63 6f 6e 64 29 29 29 first second)))
fbd0: 29 0a 09 09 09 20 20 74 65 73 74 73 29 29 29 29 ).... tests))))
fbe0: 29 29 0a 09 20 20 20 72 75 6e 73 29 0a 09 20 20 )).. runs)..
fbf0: 28 63 61 73 65 20 64 6d 6f 64 65 0a 09 20 20 20 (case dmode..
fc00: 20 28 28 6a 73 6f 6e 29 20 20 28 6a 73 6f 6e 2d ((json) (json-
fc10: 77 72 69 74 65 20 64 61 74 61 29 29 0a 09 20 20 write data))..
fc20: 20 20 28 28 73 65 78 70 72 29 20 28 70 70 20 28 ((sexpr) (pp (
fc30: 63 6f 6d 6d 6f 6e 3a 74 6f 2d 61 6c 69 73 74 20 common:to-alist
fc40: 64 61 74 61 29 29 29 29 0a 09 20 20 28 6c 65 74 data)))).. (let
fc50: 2a 20 28 28 6d 65 74 61 64 61 74 2d 66 69 65 6c * ((metadat-fiel
fc60: 64 73 20 28 64 65 6c 65 74 65 2d 64 75 70 6c 69 ds (delete-dupli
fc70: 63 61 74 65 73 0a 09 09 09 09 20 20 28 61 70 70 cates..... (app
fc80: 65 6e 64 20 6b 65 79 73 20 27 28 20 22 72 75 6e end keys '( "run
fc90: 6e 61 6d 65 22 20 22 74 69 6d 65 22 20 22 6f 77 name" "time" "ow
fca0: 6e 65 72 22 20 22 70 61 73 73 5f 63 6f 75 6e 74 ner" "pass_count
fcb0: 22 20 22 66 61 69 6c 5f 63 6f 75 6e 74 22 20 22 " "fail_count" "
fcc0: 73 74 61 74 65 22 20 22 73 74 61 74 75 73 22 20 state" "status"
fcd0: 22 63 6f 6d 6d 65 6e 74 22 20 22 69 64 22 29 29 "comment" "id"))
fce0: 29 29 0a 09 09 20 28 72 75 6e 2d 66 69 65 6c 64 ))... (run-field
fcf0: 73 20 20 20 20 27 28 0a 09 09 09 09 20 20 22 74 s '(..... "t
fd00: 65 73 74 6e 61 6d 65 22 0a 09 09 09 09 20 20 22 estname"..... "
fd10: 69 74 65 6d 5f 70 61 74 68 22 0a 09 09 09 09 20 item_path".....
fd20: 20 22 73 74 61 74 65 22 0a 09 09 09 09 20 20 22 "state"..... "
fd30: 73 74 61 74 75 73 22 0a 09 09 09 09 20 20 22 63 status"..... "c
fd40: 6f 6d 6d 65 6e 74 22 0a 09 09 09 09 20 20 22 65 omment"..... "e
fd50: 76 65 6e 74 5f 74 69 6d 65 22 0a 09 09 09 09 20 vent_time".....
fd60: 20 22 68 6f 73 74 22 0a 09 09 09 09 20 20 22 72 "host"..... "r
fd70: 75 6e 5f 69 64 22 0a 09 09 09 09 20 20 22 72 75 un_id"..... "ru
fd80: 6e 5f 64 75 72 61 74 69 6f 6e 22 0a 09 09 09 09 n_duration".....
fd90: 20 20 22 61 74 74 65 6d 70 74 6e 75 6d 22 0a 09 "attemptnum"..
fda0: 09 09 09 20 20 22 69 64 22 0a 09 09 09 09 20 20 ... "id".....
fdb0: 22 61 72 63 68 69 76 65 64 22 0a 09 09 09 09 20 "archived".....
fdc0: 20 22 64 69 73 6b 66 72 65 65 22 0a 09 09 09 09 "diskfree".....
fdd0: 20 20 22 63 70 75 6c 6f 61 64 22 0a 09 09 09 09 "cpuload".....
fde0: 20 20 22 66 69 6e 61 6c 5f 6c 6f 67 66 22 0a 09 "final_logf"..
fdf0: 09 09 09 20 20 22 73 68 6f 72 74 64 69 72 22 0a ... "shortdir".
fe00: 09 09 09 09 20 20 22 72 75 6e 64 69 72 22 0a 09 .... "rundir"..
fe10: 09 09 09 20 20 22 75 6e 61 6d 65 22 0a 09 09 09 ... "uname"....
fe20: 09 20 20 29 0a 09 09 09 09 29 0a 09 09 20 28 6e . ).....)... (n
fe30: 65 77 64 61 74 20 20 20 20 20 20 20 20 20 20 28 ewdat (
fe40: 63 6f 6d 6d 6f 6e 3a 74 6f 2d 61 6c 69 73 74 20 common:to-alist
fe50: 64 61 74 61 29 29 0a 09 09 20 28 61 6c 6c 72 75 data))... (allru
fe60: 6e 64 61 74 20 20 20 20 20 20 20 28 69 66 20 28 ndat (if (
fe70: 6e 75 6c 6c 3f 20 6e 65 77 64 61 74 29 0a 09 09 null? newdat)...
fe80: 09 09 20 20 20 20 20 20 27 28 29 0a 09 09 09 09 .. '().....
fe90: 20 20 20 20 20 20 28 63 61 72 20 28 6d 61 70 20 (car (map
fea0: 63 64 72 20 6e 65 77 64 61 74 29 29 29 29 20 3b cdr newdat)))) ;
feb0: 3b 20 28 63 61 72 20 28 6d 61 70 20 63 64 72 20 ; (car (map cdr
fec0: 28 63 61 72 20 28 6d 61 70 20 63 64 72 20 6e 65 (car (map cdr ne
fed0: 77 64 61 74 29 29 29 29 29 0a 09 09 20 28 72 75 wdat)))))... (ru
fee0: 6e 73 20 20 20 20 20 20 20 20 20 20 20 20 28 61 ns (a
fef0: 70 70 65 6e 64 0a 09 09 09 09 20 20 20 28 6c 69 ppend..... (li
ff00: 73 74 20 22 72 75 6e 73 22 20 3b 3b 20 73 68 65 st "runs" ;; she
ff10: 65 74 6e 61 6d 65 0a 09 09 09 09 09 20 6d 65 74 etname...... met
ff20: 61 64 61 74 2d 66 69 65 6c 64 73 29 0a 09 09 09 adat-fields)....
ff30: 09 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 . (map (lambda
ff40: 20 28 72 75 6e 29 0a 09 09 09 09 09 20 20 3b 3b (run)...... ;;
ff50: 20 28 70 72 69 6e 74 20 22 72 75 6e 3a 20 22 20 (print "run: "
ff60: 72 75 6e 29 0a 09 09 09 09 09 20 20 28 6c 65 74 run)...... (let
ff70: 2a 20 28 28 72 75 6e 6e 61 6d 65 20 28 63 61 72 * ((runname (car
ff80: 20 72 75 6e 29 29 0a 09 09 09 09 09 09 20 28 72 run))....... (r
ff90: 75 6e 64 61 74 20 20 28 63 64 72 20 72 75 6e 29 undat (cdr run)
ffa0: 29 0a 09 09 09 09 09 09 20 28 6d 65 74 61 64 61 )....... (metada
ffb0: 74 20 28 6c 65 74 20 28 28 74 6d 70 20 28 61 73 t (let ((tmp (as
ffc0: 73 6f 63 20 22 6d 65 74 61 22 20 72 75 6e 64 61 soc "meta" runda
ffd0: 74 29 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 t)))........
ffe0: 28 69 66 20 74 6d 70 20 28 63 64 72 20 74 6d 70 (if tmp (cdr tmp
fff0: 29 20 23 66 29 29 29 29 0a 09 09 09 09 09 20 20 ) #f))))......
10000 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 72 75 6e ;; (print "run
10010 6e 61 6d 65 3a 20 22 20 72 75 6e 6e 61 6d 65 20 name: " runname
10020 22 5c 6e 5c 6e 72 75 6e 64 61 74 3a 20 22 20 29 "\n\nrundat: " )
10030 28 70 70 20 72 75 6e 64 61 74 29 28 70 72 69 6e (pp rundat)(prin
10040 74 20 22 5c 6e 5c 6e 6d 65 74 61 64 61 74 3a 20 t "\n\nmetadat:
10050 22 29 28 70 70 20 6d 65 74 61 64 61 74 29 0a 09 ")(pp metadat)..
10060 09 09 09 09 20 20 20 20 28 69 66 20 6d 65 74 61 .... (if meta
10070 64 61 74 0a 09 09 09 09 09 09 28 6d 61 70 20 28 dat.......(map (
10080 6c 61 6d 62 64 61 20 28 66 69 65 6c 64 29 0a 09 lambda (field)..
10090 09 09 09 09 09 20 20 20 20 20 20 20 28 6c 65 74 ..... (let
100a0 20 28 28 74 6d 70 20 28 61 73 73 6f 63 20 66 69 ((tmp (assoc fi
100b0 65 6c 64 20 6d 65 74 61 64 61 74 29 29 29 0a 09 eld metadat)))..
100c0 09 09 09 09 09 09 20 28 69 66 20 74 6d 70 20 28 ...... (if tmp (
100d0 63 64 72 20 74 6d 70 29 20 22 22 29 29 29 0a 09 cdr tmp) "")))..
100e0 09 09 09 09 09 20 20 20 20 20 6d 65 74 61 64 61 ..... metada
100f0 74 2d 66 69 65 6c 64 73 29 0a 09 09 09 09 09 09 t-fields).......
10100 28 62 65 67 69 6e 0a 09 09 09 09 09 09 20 20 28 (begin....... (
10110 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
10120 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
10130 20 22 57 41 52 4e 49 4e 47 3a 20 6d 65 74 61 20 "WARNING: meta
10140 64 61 74 61 20 66 6f 72 20 72 75 6e 20 22 20 72 data for run " r
10150 75 6e 6e 61 6d 65 20 22 20 6e 6f 74 20 66 6f 75 unname " not fou
10160 6e 64 22 29 0a 09 09 09 09 09 09 20 20 27 28 29 nd")....... '()
10170 29 29 29 29 0a 09 09 09 09 09 61 6c 6c 72 75 6e ))))......allrun
10180 64 61 74 29 29 29 0a 09 09 20 3b 3b 20 27 28 20 dat)))... ;; '(
10190 28 20 22 74 61 72 67 65 74 22 20 28 20 22 72 75 ( "target" ( "ru
101a0 6e 6e 61 6d 65 22 20 28 20 22 64 61 74 61 22 20 nname" ( "data"
101b0 28 20 22 72 75 6e 69 64 22 20 28 20 22 69 64 20 ( "runid" ( "id
101c0 2e 20 22 33 37 22 20 29 20 28 20 2e 2e 2e 20 29 . "37" ) ( ... )
101d0 29 29 29 0a 09 09 20 28 72 75 6e 2d 70 61 67 65 )))... (run-page
101e0 73 20 20 20 20 20 20 28 6d 61 70 20 28 6c 61 6d s (map (lam
101f0 62 64 61 20 28 74 61 72 67 64 61 74 29 0a 09 09 bda (targdat)...
10200 09 09 09 28 6c 65 74 2a 20 28 28 74 61 72 67 65 ...(let* ((targe
10210 74 20 20 28 63 61 72 20 74 61 72 67 64 61 74 29 t (car targdat)
10220 29 0a 09 09 09 09 09 20 20 20 20 20 20 20 28 72 )...... (r
10230 75 6e 73 64 61 74 20 28 63 64 72 20 74 61 72 67 unsdat (cdr targ
10240 64 61 74 29 29 29 0a 09 09 09 09 09 20 20 28 69 dat)))...... (i
10250 66 20 72 75 6e 73 64 61 74 0a 09 09 09 09 09 20 f runsdat......
10260 20 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 (map (lambd
10270 61 20 28 72 75 6e 64 61 74 29 0a 09 09 09 09 09 a (rundat)......
10280 09 20 20 20 20 20 28 6c 65 74 2a 20 28 28 72 75 . (let* ((ru
10290 6e 6e 61 6d 65 20 20 28 63 61 72 20 72 75 6e 64 nname (car rund
102a0 61 74 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 at))........
102b0 28 72 75 6e 64 61 74 20 20 20 28 63 64 72 20 72 (rundat (cdr r
102c0 75 6e 64 61 74 29 29 0a 09 09 09 09 09 09 09 20 undat))........
102d0 20 20 20 28 74 65 73 74 73 64 61 74 20 28 6c 65 (testsdat (le
102e0 74 20 28 28 74 6d 70 20 28 61 73 73 6f 63 20 22 t ((tmp (assoc "
102f0 64 61 74 61 22 20 72 75 6e 64 61 74 29 29 29 0a data" rundat))).
10300 09 09 09 09 09 09 09 09 09 28 69 66 20 74 6d 70 .........(if tmp
10310 20 28 63 64 72 20 74 6d 70 29 20 23 66 29 29 29 (cdr tmp) #f)))
10320 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 28 )....... (
10330 69 66 20 74 65 73 74 73 64 61 74 0a 09 09 09 09 if testsdat.....
10340 09 09 09 20 20 20 28 6c 65 74 20 28 28 74 65 73 ... (let ((tes
10350 74 73 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 ts (map (lambda
10360 28 74 65 73 74 29 0a 09 09 09 09 09 09 09 09 09 (test)..........
10370 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 74 (let* ((t
10380 65 73 74 2d 69 64 20 20 28 63 61 72 20 74 65 73 est-id (car tes
10390 74 29 29 0a 09 09 09 09 09 09 09 09 09 09 20 20 t))...........
103a0 20 20 20 20 28 74 65 73 74 2d 64 61 74 20 28 63 (test-dat (c
103b0 64 72 20 74 65 73 74 29 29 29 0a 09 09 09 09 09 dr test)))......
103c0 09 09 09 09 09 20 28 6d 61 70 20 28 6c 61 6d 62 ..... (map (lamb
103d0 64 61 20 28 66 69 65 6c 64 29 0a 09 09 09 09 09 da (field)......
103e0 09 09 09 09 09 09 28 6c 65 74 20 28 28 74 6d 70 ......(let ((tmp
103f0 20 28 61 73 73 6f 63 20 66 69 65 6c 64 20 74 65 (assoc field te
10400 73 74 2d 64 61 74 29 29 29 0a 09 09 09 09 09 09 st-dat))).......
10410 09 09 09 09 09 20 20 28 69 66 20 74 6d 70 20 28 ..... (if tmp (
10420 63 64 72 20 74 6d 70 29 20 22 22 29 29 29 0a 09 cdr tmp) "")))..
10430 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 72 ......... r
10440 75 6e 2d 66 69 65 6c 64 73 29 29 29 0a 09 09 09 un-fields)))....
10450 09 09 09 09 09 09 20 20 20 20 20 74 65 73 74 73 ...... tests
10460 64 61 74 29 29 29 0a 09 09 09 09 09 09 09 20 20 dat)))........
10470 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 54 61 ;; (print "Ta
10480 72 67 65 74 3a 20 22 20 74 61 72 67 65 74 20 22 rget: " target "
10490 2f 22 20 72 75 6e 6e 61 6d 65 20 22 20 74 65 73 /" runname " tes
104a0 74 73 3a 22 29 0a 09 09 09 09 09 09 09 20 20 20 ts:")........
104b0 20 20 3b 3b 20 28 70 70 20 74 65 73 74 73 29 0a ;; (pp tests).
104c0 09 09 09 09 09 09 09 20 20 20 20 20 28 63 6f 6e ....... (con
104d0 73 20 28 63 6f 6e 63 20 74 61 72 67 65 74 20 22 s (conc target "
104e0 2f 22 20 72 75 6e 6e 61 6d 65 29 0a 09 09 09 09 /" runname).....
104f0 09 09 09 09 20 20 20 28 63 6f 6e 73 20 28 6c 69 .... (cons (li
10500 73 74 20 28 63 6f 6e 63 20 74 61 72 67 65 74 20 st (conc target
10510 22 2f 22 20 72 75 6e 6e 61 6d 65 29 29 0a 09 09 "/" runname))...
10520 09 09 09 09 09 09 09 20 28 63 6f 6e 73 20 27 28 ....... (cons '(
10530 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 )..........
10540 20 20 28 63 6f 6e 73 20 72 75 6e 2d 66 69 65 6c (cons run-fiel
10550 64 73 20 74 65 73 74 73 29 29 29 29 29 0a 09 09 ds tests)))))...
10560 09 09 09 09 09 20 20 20 28 62 65 67 69 6e 0a 09 ..... (begin..
10570 09 09 09 09 09 09 20 20 20 20 20 28 64 65 62 75 ...... (debu
10580 67 3a 70 72 69 6e 74 20 34 20 2a 64 65 66 61 75 g:print 4 *defau
10590 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 lt-log-port* "WA
105a0 52 4e 49 4e 47 3a 20 72 75 6e 20 22 20 74 61 72 RNING: run " tar
105b0 67 65 74 20 22 2f 22 20 72 75 6e 6e 61 6d 65 20 get "/" runname
105c0 22 20 61 70 70 65 61 72 73 20 74 6f 20 68 61 76 " appears to hav
105d0 65 20 6e 6f 20 64 61 74 61 22 29 0a 09 09 09 09 e no data").....
105e0 09 09 09 20 20 20 20 20 3b 3b 20 28 70 70 20 72 ... ;; (pp r
105f0 75 6e 64 61 74 29 0a 09 09 09 09 09 09 09 20 20 undat)........
10600 20 20 20 27 28 29 29 29 29 29 0a 09 09 09 09 09 '()))))......
10610 09 20 20 20 72 75 6e 73 64 61 74 29 0a 09 09 09 . runsdat)....
10620 09 09 20 20 20 20 20 20 27 28 29 29 29 29 0a 09 .. '())))..
10630 09 09 09 20 20 20 20 20 20 6e 65 77 64 61 74 29 ... newdat)
10640 29 20 3b 3b 20 77 65 20 75 73 65 20 6e 65 77 64 ) ;; we use newd
10650 61 74 20 74 6f 20 67 65 74 20 74 61 72 67 65 74 at to get target
10660 0a 09 09 20 28 73 68 65 65 74 73 20 20 20 20 20 ... (sheets
10670 20 20 20 20 28 66 69 6c 74 65 72 20 28 6c 61 6d (filter (lam
10680 62 64 61 20 28 78 29 0a 09 09 09 09 09 20 20 20 bda (x)......
10690 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 78 29 29 29 (not (null? x)))
106a0 0a 09 09 09 09 09 20 28 63 6f 6e 73 20 72 75 6e ...... (cons run
106b0 73 20 28 6d 61 70 20 63 61 72 20 72 75 6e 2d 70 s (map car run-p
106c0 61 67 65 73 29 29 29 29 29 0a 09 20 20 20 20 3b ages))))).. ;
106d0 3b 20 28 70 72 69 6e 74 20 22 61 6c 6c 72 75 6e ; (print "allrun
106e0 64 61 74 3a 22 29 0a 09 20 20 20 20 3b 3b 20 28 dat:").. ;; (
106f0 70 70 20 61 6c 6c 72 75 6e 64 61 74 29 0a 09 20 pp allrundat)..
10700 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 72 75 ;; (print "ru
10710 6e 73 3a 22 29 0a 09 20 20 20 20 3b 3b 20 28 70 ns:").. ;; (p
10720 70 20 72 75 6e 73 29 0a 09 20 20 20 20 3b 28 70 p runs).. ;(p
10730 72 69 6e 74 20 22 73 68 65 65 74 73 3a 20 22 29 rint "sheets: ")
10740 0a 09 20 20 20 20 3b 3b 20 28 70 70 20 73 68 65 .. ;; (pp she
10750 65 74 73 29 0a 09 20 20 20 20 28 69 66 20 28 65 ets).. (if (e
10760 71 3f 20 64 6d 6f 64 65 20 27 6f 64 73 29 0a 09 q? dmode 'ods)..
10770 09 28 6c 65 74 2a 20 28 28 74 65 6d 70 64 69 72 .(let* ((tempdir
10780 20 20 20 20 28 63 6f 6e 63 20 22 2f 74 6d 70 2f (conc "/tmp/
10790 22 20 28 63 75 72 72 65 6e 74 2d 75 73 65 72 2d " (current-user-
107a0 6e 61 6d 65 29 20 22 2f 22 20 28 72 61 6e 64 6f name) "/" (rando
107b0 6d 20 31 30 30 30 30 29 20 22 5f 22 20 28 63 75 m 10000) "_" (cu
107c0 72 72 65 6e 74 2d 70 72 6f 63 65 73 73 2d 69 64 rrent-process-id
107d0 29 29 29 0a 09 09 20 20 20 20 20 20 20 28 6f 75 )))... (ou
107e0 74 70 75 74 66 69 6c 65 20 28 6f 72 20 28 61 72 tputfile (or (ar
107f0 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6f 22 29 gs:get-arg "-o")
10800 20 22 6f 75 74 2e 6f 64 73 22 29 29 0a 09 09 20 "out.ods"))...
10810 20 20 20 20 20 20 28 6f 75 66 20 20 20 20 20 20 (ouf
10820 20 20 28 69 66 20 28 73 74 72 69 6e 67 2d 6d 61 (if (string-ma
10830 74 63 68 20 28 72 65 67 65 78 70 20 22 5e 5b 2f tch (regexp "^[/
10840 7e 5d 2b 2e 2a 22 29 20 6f 75 74 70 75 74 66 69 ~]+.*") outputfi
10850 6c 65 29 20 3b 3b 20 66 75 6c 6c 20 70 61 74 68 le) ;; full path
10860 3f 0a 09 09 09 09 20 20 20 20 20 20 20 6f 75 74 ?..... out
10870 70 75 74 66 69 6c 65 0a 09 09 09 09 20 20 20 20 putfile.....
10880 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 09 20 (begin......
10890 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a (debug:print 0 *
108a0 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
108b0 2a 20 22 57 41 52 4e 49 4e 47 3a 20 70 61 74 68 * "WARNING: path
108c0 20 67 69 76 65 6e 2c 20 22 20 6f 75 74 70 75 74 given, " output
108d0 66 69 6c 65 20 22 20 69 73 20 72 65 6c 61 74 69 file " is relati
108e0 76 65 2c 20 70 72 65 66 69 78 69 6e 67 20 77 69 ve, prefixing wi
108f0 74 68 20 63 75 72 72 65 6e 74 20 64 69 72 65 63 th current direc
10900 74 6f 72 79 22 29 0a 09 09 09 09 09 20 28 63 6f tory")...... (co
10910 6e 63 20 28 63 75 72 72 65 6e 74 2d 64 69 72 65 nc (current-dire
10920 63 74 6f 72 79 29 20 22 2f 22 20 6f 75 74 70 75 ctory) "/" outpu
10930 74 66 69 6c 65 29 29 29 29 29 0a 09 09 20 20 28 tfile)))))... (
10940 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f 72 79 create-directory
10950 20 74 65 6d 70 64 69 72 20 23 74 29 0a 09 09 20 tempdir #t)...
10960 20 28 6f 64 73 3a 6c 69 73 74 2d 3e 6f 64 73 20 (ods:list->ods
10970 74 65 6d 70 64 69 72 20 6f 75 66 20 73 68 65 65 tempdir ouf shee
10980 74 73 29 29 29 29 0a 09 20 20 3b 3b 20 28 73 79 ts)))).. ;; (sy
10990 73 74 65 6d 20 28 63 6f 6e 63 20 22 72 6d 20 2d stem (conc "rm -
109a0 72 66 20 22 20 74 65 6d 70 64 69 72 29 29 0a 09 rf " tempdir))..
109b0 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
109c0 74 68 69 6e 67 2a 20 23 74 29 0a 20 20 20 20 20 thing* #t).
109d0 20 20 20 20 20 28 73 65 74 21 20 2a 74 69 6d 65 (set! *time
109e0 2d 74 6f 2d 65 78 69 74 2a 20 23 74 29 0a 20 20 -to-exit* #t).
109f0 20 20 20 20 20 20 20 20 29 20 3b 3b 20 65 6e 64 ) ;; end
10a00 20 69 66 20 74 72 75 65 20 62 72 61 6e 63 68 20 if true branch
10a10 28 65 6e 64 20 6f 66 20 61 20 6c 65 74 29 0a 20 (end of a let).
10a20 20 20 20 20 20 20 20 29 20 3b 3b 20 65 6e 64 20 ) ;; end
10a30 69 66 0a 20 20 20 20 29 20 3b 3b 20 65 6e 64 20 if. ) ;; end
10a40 69 66 20 2d 6c 69 73 74 2d 72 75 6e 73 0a 0a 3b if -list-runs..;
10a50 3b 20 44 6f 6e 27 74 20 74 68 69 6e 6b 20 49 20 ; Don't think I
10a60 6e 65 65 64 20 74 68 69 73 2e 20 49 6e 63 6f 72 need this. Incor
10a70 70 6f 72 61 74 65 64 20 69 6e 74 6f 20 2d 6c 69 porated into -li
10a80 73 74 2d 72 75 6e 73 20 69 6e 73 74 65 61 64 0a st-runs instead.
10a90 3b 3b 0a 3b 3b 20 28 69 66 20 28 61 6e 64 20 28 ;;.;; (if (and (
10aa0 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
10ab0 69 6e 63 65 22 29 0a 3b 3b 20 09 20 28 6c 61 75 ince").;; . (lau
10ac0 6e 63 68 3a 73 65 74 75 70 29 29 0a 3b 3b 20 20 nch:setup)).;;
10ad0 20 20 20 28 6c 65 74 2a 20 28 28 73 69 6e 63 65 (let* ((since
10ae0 2d 74 69 6d 65 20 28 73 74 72 69 6e 67 2d 3e 6e -time (string->n
10af0 75 6d 62 65 72 20 28 61 72 67 73 3a 67 65 74 2d umber (args:get-
10b00 61 72 67 20 22 2d 73 69 6e 63 65 22 29 29 29 0a arg "-since"))).
10b10 3b 3b 20 09 20 20 20 28 72 75 6e 2d 69 64 73 20 ;; . (run-ids
10b20 20 20 20 28 64 62 3a 67 65 74 2d 63 68 61 6e 67 (db:get-chang
10b30 65 64 2d 72 75 6e 2d 69 64 73 20 73 69 6e 63 65 ed-run-ids since
10b40 2d 74 69 6d 65 29 29 29 0a 3b 3b 20 20 20 20 20 -time))).;;
10b50 20 20 3b 3b 20 28 72 6d 74 3a 67 65 74 2d 74 65 ;; (rmt:get-te
10b60 73 74 73 2d 66 6f 72 2d 72 75 6e 73 2d 6d 69 6e sts-for-runs-min
10b70 64 61 74 61 20 72 75 6e 2d 69 64 73 20 74 65 73 data run-ids tes
10b80 74 70 61 74 74 20 73 74 61 74 65 73 20 73 74 61 tpatt states sta
10b90 74 75 73 20 6e 6f 74 2d 69 6e 29 0a 3b 3b 20 20 tus not-in).;;
10ba0 20 20 20 20 20 28 70 72 69 6e 74 20 28 73 6f 72 (print (sor
10bb0 74 20 72 75 6e 2d 69 64 73 20 3c 29 29 0a 3b 3b t run-ids <)).;;
10bc0 20 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 (set! *di
10bd0 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 dsomething* #t))
10be0 29 0a 20 20 20 20 20 20 0a 20 20 20 20 20 20 0a ). . .
10bf0 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
10c00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10c10 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10c20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10c30 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 66 75 6c 6c ========.;; full
10c40 20 72 75 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d run.;;=========
10c50 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10c60 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10c70 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10c80 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b =============..;
10c90 3b 20 67 65 74 20 6c 6f 63 6b 20 69 6e 20 64 62 ; get lock in db
10ca0 20 66 6f 72 20 66 75 6c 6c 20 72 75 6e 20 66 6f for full run fo
10cb0 72 20 74 68 69 73 20 64 69 72 65 63 74 6f 72 79 r this directory
10cc0 0a 3b 3b 20 66 6f 72 20 61 6c 6c 20 74 65 73 74 .;; for all test
10cd0 73 20 77 69 74 68 20 64 65 70 73 0a 3b 3b 20 20 s with deps.;;
10ce0 20 77 61 6c 6b 20 74 72 65 65 20 6f 66 20 74 65 walk tree of te
10cf0 73 74 73 20 74 6f 20 66 69 6e 64 20 68 65 61 64 sts to find head
10d00 20 74 61 73 6b 73 0a 3b 3b 20 20 20 61 64 64 20 tasks.;; add
10d10 68 65 61 64 20 74 61 73 6b 73 20 74 6f 20 74 61 head tasks to ta
10d20 73 6b 20 71 75 65 75 65 0a 3b 3b 20 20 20 61 64 sk queue.;; ad
10d30 64 20 64 65 70 65 6e 64 61 6e 74 20 74 61 73 6b d dependant task
10d40 73 20 74 6f 20 74 61 73 6b 20 71 75 65 75 65 20 s to task queue
10d50 0a 3b 3b 20 20 20 61 64 64 20 72 65 6d 61 69 6e .;; add remain
10d60 69 6e 67 20 74 61 73 6b 73 20 74 6f 20 74 61 73 ing tasks to tas
10d70 6b 20 71 75 65 75 65 0a 3b 3b 20 66 6f 72 20 65 k queue.;; for e
10d80 61 63 68 20 74 61 73 6b 20 69 6e 20 74 61 73 6b ach task in task
10d90 20 71 75 65 75 65 0a 3b 3b 20 20 20 69 66 20 68 queue.;; if h
10da0 61 76 65 20 61 64 65 71 75 61 74 65 20 72 65 73 ave adequate res
10db0 6f 75 72 63 65 73 0a 3b 3b 20 20 20 20 20 6c 61 ources.;; la
10dc0 75 6e 63 68 20 74 61 73 6b 0a 3b 3b 20 20 20 65 unch task.;; e
10dd0 6c 73 65 0a 3b 3b 20 20 20 20 20 70 75 74 20 74 lse.;; put t
10de0 61 73 6b 20 69 6e 20 64 65 66 65 72 72 65 64 20 ask in deferred
10df0 71 75 65 75 65 0a 3b 3b 20 69 66 20 73 74 69 6c queue.;; if stil
10e00 6c 20 6f 6b 20 74 6f 20 72 75 6e 20 74 61 73 6b l ok to run task
10e10 73 0a 3b 3b 20 20 20 70 72 6f 63 65 73 73 20 64 s.;; process d
10e20 65 66 65 72 72 65 64 20 74 61 73 6b 73 20 70 65 eferred tasks pe
10e30 72 20 61 62 6f 76 65 20 73 74 65 70 73 0a 0a 3b r above steps..;
10e40 3b 20 72 75 6e 20 61 6c 6c 20 74 65 73 74 73 20 ; run all tests
10e50 61 72 65 20 61 72 65 20 4e 6f 74 20 43 4f 4d 50 are are Not COMP
10e60 4c 45 54 45 44 20 61 6e 64 20 50 41 53 53 20 6f LETED and PASS o
10e70 72 20 43 48 45 43 4b 0a 28 69 66 20 28 6f 72 20 r CHECK.(if (or
10e80 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
10e90 72 75 6e 61 6c 6c 22 29 0a 09 28 61 72 67 73 3a runall")..(args:
10ea0 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 22 29 0a get-arg "-run").
10eb0 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 .(args:get-arg "
10ec0 2d 72 65 72 75 6e 2d 63 6c 65 61 6e 22 29 0a 09 -rerun-clean")..
10ed0 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
10ee0 72 65 72 75 6e 2d 61 6c 6c 22 29 0a 09 28 61 72 rerun-all")..(ar
10ef0 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
10f00 74 65 73 74 73 22 29 29 0a 20 20 20 20 28 6c 65 tests")). (le
10f10 74 20 28 28 6e 65 65 64 2d 63 6c 65 61 6e 20 28 t ((need-clean (
10f20 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 or (args:get-arg
10f30 20 22 2d 72 65 72 75 6e 2d 63 6c 65 61 6e 22 29 "-rerun-clean")
10f40 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
10f50 20 20 20 20 20 20 20 20 20 20 20 28 61 72 67 73 (args
10f60 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 72 75 6e :get-arg "-rerun
10f70 2d 61 6c 6c 22 29 29 29 29 0a 20 20 20 20 20 20 -all")))).
10f80 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c (general-run-cal
10f90 6c 20 0a 20 20 20 20 20 20 20 22 2d 72 75 6e 61 l . "-runa
10fa0 6c 6c 22 0a 20 20 20 20 20 20 20 22 72 75 6e 20 ll". "run
10fb0 61 6c 6c 20 74 65 73 74 73 22 0a 20 20 20 20 20 all tests".
10fc0 20 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 (lambda (targe
10fd0 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b t runname keys k
10fe0 65 79 76 61 6c 73 29 0a 20 20 20 20 20 20 20 20 eyvals).
10ff0 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
11000 72 67 20 22 2d 72 65 72 75 6e 2d 63 6c 65 61 6e rg "-rerun-clean
11010 22 29 20 3b 3b 20 66 69 72 73 74 20 73 65 74 20 ") ;; first set
11020 73 74 61 74 65 73 2f 73 74 61 74 75 73 65 73 20 states/statuses
11030 63 6f 72 72 65 63 74 0a 20 20 20 20 20 20 20 20 correct.
11040 20 20 20 20 20 28 6c 65 74 20 28 28 73 74 61 74 (let ((stat
11050 65 73 20 20 20 28 6f 72 20 28 63 6f 6e 66 69 67 es (or (config
11060 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 f:lookup *config
11070 64 61 74 2a 20 22 76 61 6c 69 64 76 61 6c 75 65 dat* "validvalue
11080 73 22 20 22 63 6c 65 61 6e 72 65 72 75 6e 2d 73 s" "cleanrerun-s
11090 74 61 74 65 73 22 29 0a 20 20 20 20 20 20 20 20 tates").
110a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
110b0 20 20 20 20 20 20 20 20 20 22 4b 49 4c 4c 52 45 "KILLRE
110c0 51 2c 4b 49 4c 4c 45 44 2c 55 4e 4b 4e 4f 57 4e Q,KILLED,UNKNOWN
110d0 2c 49 4e 43 4f 4d 50 4c 45 54 45 2c 53 54 55 43 ,INCOMPLETE,STUC
110e0 4b 2c 4e 4f 54 5f 53 54 41 52 54 45 44 22 29 29 K,NOT_STARTED"))
110f0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
11100 20 20 20 20 28 73 74 61 74 75 73 65 73 20 28 6f (statuses (o
11110 72 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 r (configf:looku
11120 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 76 p *configdat* "v
11130 61 6c 69 64 76 61 6c 75 65 73 22 20 22 63 6c 65 alidvalues" "cle
11140 61 6e 72 65 72 75 6e 2d 73 74 61 74 75 73 65 73 anrerun-statuses
11150 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ").
11160 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11170 20 20 20 20 22 46 41 49 4c 2c 49 4e 43 4f 4d 50 "FAIL,INCOMP
11180 4c 45 54 45 2c 41 42 4f 52 54 2c 43 48 45 43 4b LETE,ABORT,CHECK
11190 2c 44 45 41 44 22 29 29 29 0a 20 20 20 20 20 20 ,DEAD"))).
111a0 20 20 20 20 20 20 20 20 20 28 68 61 73 68 2d 74 (hash-t
111b0 61 62 6c 65 2d 73 65 74 21 20 61 72 67 73 3a 61 able-set! args:a
111c0 72 67 2d 68 61 73 68 20 22 2d 70 72 65 63 6c 65 rg-hash "-precle
111d0 61 6e 22 20 23 74 29 0a 20 20 20 20 20 20 20 20 an" #t).
111e0 20 20 20 20 20 20 20 28 72 75 6e 73 3a 6f 70 65 (runs:ope
111f0 72 61 74 65 2d 6f 6e 20 27 73 65 74 2d 73 74 61 rate-on 'set-sta
11200 74 65 2d 73 74 61 74 75 73 0a 20 20 20 20 20 20 te-status.
11210 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11220 20 20 20 20 20 20 20 20 20 20 74 61 72 67 65 74 target
11230 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
11240 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11250 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 (common:args-ge
11260 74 2d 72 75 6e 6e 61 6d 65 29 20 20 3b 3b 20 28 t-runname) ;; (
11270 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 or (args:get-arg
11280 20 22 2d 72 75 6e 6e 61 6d 65 22 29 28 61 72 67 "-runname")(arg
11290 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e s:get-arg ":runn
112a0 61 6d 65 22 29 29 0a 20 20 20 20 20 20 20 20 20 ame")).
112b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
112c0 20 20 20 20 20 20 20 22 25 22 20 3b 3b 20 28 63 "%" ;; (c
112d0 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 ommon:args-get-t
112e0 65 73 74 70 61 74 74 20 23 66 29 20 3b 3b 20 28 estpatt #f) ;; (
112f0 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 args:get-arg "-t
11300 65 73 74 70 61 74 74 22 29 0a 20 20 20 20 20 20 estpatt").
11310 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11320 20 20 20 20 20 20 20 20 20 20 73 74 61 74 65 3a state:
11330 20 20 73 74 61 74 65 73 0a 20 20 20 20 20 20 20 states.
11340 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11350 20 20 20 20 20 20 20 20 20 3b 3b 20 73 74 61 74 ;; stat
11360 75 73 3a 20 73 74 61 74 75 73 65 73 0a 20 20 20 us: statuses.
11370 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11380 20 20 20 20 20 20 20 20 20 20 20 20 20 6e 65 77 new
11390 2d 73 74 61 74 65 2d 73 74 61 74 75 73 3a 20 22 -state-status: "
113a0 4e 4f 54 5f 53 54 41 52 54 45 44 2c 6e 2f 61 22 NOT_STARTED,n/a"
113b0 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
113c0 20 28 72 75 6e 73 3a 63 6c 65 61 6e 2d 63 61 63 (runs:clean-cac
113d0 68 65 20 74 61 72 67 65 74 20 72 75 6e 6e 61 6d he target runnam
113e0 65 20 2a 74 6f 70 70 61 74 68 2a 29 0a 20 20 20 e *toppath*).
113f0 20 20 20 20 20 20 20 20 20 20 20 20 28 72 75 6e (run
11400 73 3a 6f 70 65 72 61 74 65 2d 6f 6e 20 27 73 65 s:operate-on 'se
11410 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 0a 20 t-state-status.
11420 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11430 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 t
11440 61 72 67 65 74 0a 20 20 20 20 20 20 20 20 20 20 arget.
11450 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11460 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 (common:ar
11470 67 73 2d 67 65 74 2d 72 75 6e 6e 61 6d 65 29 20 gs-get-runname)
11480 20 3b 3b 20 28 6f 72 20 28 61 72 67 73 3a 67 65 ;; (or (args:ge
11490 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 t-arg "-runname"
114a0 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 )(args:get-arg "
114b0 3a 72 75 6e 6e 61 6d 65 22 29 29 0a 20 20 20 20 :runname")).
114c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
114d0 20 20 20 20 20 20 20 20 20 20 20 20 22 25 22 20 "%"
114e0 3b 3b 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d ;; (common:args-
114f0 67 65 74 2d 74 65 73 74 70 61 74 74 20 23 66 29 get-testpatt #f)
11500 20 3b 3b 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ;; (args:get-ar
11510 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 0a 20 g "-testpatt").
11520 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11530 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
11540 3b 20 73 74 61 74 65 3a 20 20 73 74 61 74 65 73 ; state: states
11550 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
11560 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11570 20 73 74 61 74 75 73 3a 20 73 74 61 74 75 73 65 status: statuse
11580 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 s.
11590 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
115a0 20 20 6e 65 77 2d 73 74 61 74 65 2d 73 74 61 74 new-state-stat
115b0 75 73 3a 20 22 4e 4f 54 5f 53 54 41 52 54 45 44 us: "NOT_STARTED
115c0 2c 6e 2f 61 22 29 29 29 0a 20 20 20 20 20 20 20 ,n/a"))).
115d0 20 20 3b 3b 20 52 45 52 55 4e 20 41 4c 4c 0a 20 ;; RERUN ALL.
115e0 20 20 20 20 20 20 20 20 28 69 66 20 28 61 72 67 (if (arg
115f0 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 72 75 s:get-arg "-reru
11600 6e 2d 61 6c 6c 22 29 20 3b 3b 20 66 69 72 73 74 n-all") ;; first
11610 20 73 65 74 20 73 74 61 74 65 73 2f 73 74 61 74 set states/stat
11620 75 73 65 73 20 63 6f 72 72 65 63 74 0a 20 20 20 uses correct.
11630 20 20 20 20 20 20 20 20 20 20 28 62 65 67 69 6e (begin
11640 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
11650 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set!
11660 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 20 22 args:arg-hash "
11670 2d 70 72 65 63 6c 65 61 6e 22 20 23 74 29 0a 20 -preclean" #t).
11680 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 (r
11690 75 6e 73 3a 6f 70 65 72 61 74 65 2d 6f 6e 20 27 uns:operate-on '
116a0 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 set-state-status
116b0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
116c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
116d0 20 74 61 72 67 65 74 0a 20 20 20 20 20 20 20 20 target.
116e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
116f0 20 20 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a (common:
11700 61 72 67 73 2d 67 65 74 2d 72 75 6e 6e 61 6d 65 args-get-runname
11710 29 20 20 3b 3b 20 28 6f 72 20 28 61 72 67 73 3a ) ;; (or (args:
11720 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 6d get-arg "-runnam
11730 65 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 e")(args:get-arg
11740 20 22 3a 72 75 6e 6e 61 6d 65 22 29 29 0a 20 20 ":runname")).
11750 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11760 20 20 20 20 20 20 20 20 20 20 20 20 20 20 22 25 "%
11770 22 20 3b 3b 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 " ;; (common:arg
11780 73 2d 67 65 74 2d 74 65 73 74 70 61 74 74 20 23 s-get-testpatt #
11790 66 29 20 3b 3b 20 28 61 72 67 73 3a 67 65 74 2d f) ;; (args:get-
117a0 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 arg "-testpatt")
117b0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
117c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
117d0 20 73 74 61 74 65 3a 20 20 23 66 0a 20 20 20 20 state: #f.
117e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
117f0 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 73 ;; s
11800 74 61 74 75 73 3a 20 73 74 61 74 75 73 65 73 0a tatus: statuses.
11810 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11820 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11830 6e 65 77 2d 73 74 61 74 65 2d 73 74 61 74 75 73 new-state-status
11840 3a 20 22 4e 4f 54 5f 53 54 41 52 54 45 44 2c 6e : "NOT_STARTED,n
11850 2f 61 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 /a").
11860 20 20 20 20 28 72 75 6e 73 3a 63 6c 65 61 6e 2d (runs:clean-
11870 63 61 63 68 65 20 74 61 72 67 65 74 20 72 75 6e cache target run
11880 6e 61 6d 65 20 2a 74 6f 70 70 61 74 68 2a 29 0a name *toppath*).
11890 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
118a0 72 75 6e 73 3a 6f 70 65 72 61 74 65 2d 6f 6e 20 runs:operate-on
118b0 27 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 'set-state-statu
118c0 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 s.
118d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
118e0 20 20 74 61 72 67 65 74 0a 20 20 20 20 20 20 20 target.
118f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11900 20 20 20 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e (common
11910 3a 61 72 67 73 2d 67 65 74 2d 72 75 6e 6e 61 6d :args-get-runnam
11920 65 29 20 20 3b 3b 20 28 6f 72 20 28 61 72 67 73 e) ;; (or (args
11930 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 :get-arg "-runna
11940 6d 65 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 me")(args:get-ar
11950 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 29 0a 20 g ":runname")).
11960 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11970 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 22 "
11980 25 22 20 3b 3b 20 28 63 6f 6d 6d 6f 6e 3a 61 72 %" ;; (common:ar
11990 67 73 2d 67 65 74 2d 74 65 73 74 70 61 74 74 20 gs-get-testpatt
119a0 23 66 29 20 3b 3b 20 28 61 72 67 73 3a 67 65 74 #f) ;; (args:get
119b0 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 -arg "-testpatt"
119c0 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
119d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
119e0 20 20 3b 3b 20 73 74 61 74 65 3a 20 20 73 74 61 ;; state: sta
119f0 74 65 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 tes.
11a00 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11a10 20 20 20 20 73 74 61 74 75 73 3a 20 23 66 0a 20 status: #f.
11a20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11a30 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6e n
11a40 65 77 2d 73 74 61 74 65 2d 73 74 61 74 75 73 3a ew-state-status:
11a50 20 22 4e 4f 54 5f 53 54 41 52 54 45 44 2c 6e 2f "NOT_STARTED,n/
11a60 61 22 29 29 29 0a 20 20 20 20 20 20 20 20 20 28 a"))). (
11a70 72 75 6e 73 3a 72 75 6e 2d 74 65 73 74 73 20 74 runs:run-tests t
11a80 61 72 67 65 74 0a 20 20 20 20 20 20 20 20 20 20 arget.
11a90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 72 r
11aa0 75 6e 6e 61 6d 65 0a 20 20 20 20 20 20 20 20 20 unname.
11ab0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11ac0 23 66 20 3b 3b 20 28 63 6f 6d 6d 6f 6e 3a 61 72 #f ;; (common:ar
11ad0 67 73 2d 67 65 74 2d 74 65 73 74 70 61 74 74 20 gs-get-testpatt
11ae0 23 66 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 #f).
11af0 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;;
11b00 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
11b10 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 0a 20 g "-testpatt").
11b20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11b30 20 20 20 20 20 20 20 20 3b 3b 20 20 20 20 20 22 ;; "
11b40 25 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 %").
11b50 20 20 20 20 20 20 20 20 20 20 20 20 20 75 73 65 use
11b60 72 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 r.
11b70 20 20 20 20 20 20 20 20 20 20 20 61 72 67 73 3a args:
11b80 61 72 67 2d 68 61 73 68 29 29 29 29 29 0a 0a 3b arg-hash)))))..;
11b90 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
11ba0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11bb0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11bc0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11bd0 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 72 75 6e 20 6f =======.;; run o
11be0 6e 65 20 74 65 73 74 0a 3b 3b 3d 3d 3d 3d 3d 3d ne test.;;======
11bf0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11c00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11c10 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11c20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11c30 0a 0a 3b 3b 20 31 2e 20 66 69 6e 64 20 74 68 65 ..;; 1. find the
11c40 20 63 6f 6e 66 69 67 20 66 69 6c 65 0a 3b 3b 20 config file.;;
11c50 32 2e 20 63 68 61 6e 67 65 20 74 6f 20 74 68 65 2. change to the
11c60 20 74 65 73 74 20 64 69 72 65 63 74 6f 72 79 0a test directory.
11c70 3b 3b 20 33 2e 20 75 70 64 61 74 65 20 74 68 65 ;; 3. update the
11c80 20 64 62 20 77 69 74 68 20 22 74 65 73 74 20 73 db with "test s
11c90 74 61 72 74 65 64 22 20 73 74 61 74 75 73 2c 20 tarted" status,
11ca0 73 65 74 20 72 75 6e 6e 69 6e 67 20 68 6f 73 74 set running host
11cb0 0a 3b 3b 20 34 2e 20 70 72 6f 63 65 73 73 20 6c .;; 4. process l
11cc0 61 75 6e 63 68 20 74 68 65 20 74 65 73 74 0a 3b aunch the test.;
11cd0 3b 20 20 20 20 2d 20 6d 6f 6e 69 74 6f 72 20 74 ; - monitor t
11ce0 68 65 20 70 72 6f 63 65 73 73 2c 20 75 70 64 61 he process, upda
11cf0 74 65 20 73 74 61 74 73 20 69 6e 20 74 68 65 20 te stats in the
11d00 64 62 20 65 76 65 72 79 20 32 5e 6e 20 6d 69 6e db every 2^n min
11d10 75 74 65 73 0a 3b 3b 20 35 2e 20 61 73 20 74 68 utes.;; 5. as th
11d20 65 20 74 65 73 74 20 70 72 6f 63 65 65 64 73 20 e test proceeds
11d30 69 6e 74 65 72 6e 61 6c 6c 79 20 69 74 20 63 61 internally it ca
11d40 6c 6c 73 20 6d 65 67 61 74 65 73 74 20 61 73 20 lls megatest as
11d50 65 61 63 68 20 73 74 65 70 20 69 73 0a 3b 3b 20 each step is.;;
11d60 20 20 20 73 74 61 72 74 65 64 20 61 6e 64 20 63 started and c
11d70 6f 6d 70 6c 65 74 65 64 0a 3b 3b 20 20 20 20 2d ompleted.;; -
11d80 20 73 74 65 70 20 73 74 61 72 74 65 64 2c 20 74 step started, t
11d90 69 6d 65 73 74 61 6d 70 0a 3b 3b 20 20 20 20 2d imestamp.;; -
11da0 20 73 74 65 70 20 63 6f 6d 70 6c 65 74 65 64 2c step completed,
11db0 20 65 78 69 74 20 73 74 61 74 75 73 2c 20 74 69 exit status, ti
11dc0 6d 65 73 74 61 6d 70 0a 3b 3b 20 36 2e 20 74 65 mestamp.;; 6. te
11dd0 73 74 20 70 68 6f 6e 65 20 68 6f 6d 65 0a 3b 3b st phone home.;;
11de0 20 20 20 20 2d 20 69 66 20 74 65 73 74 20 72 75 - if test ru
11df0 6e 20 74 69 6d 65 20 3e 20 61 6c 6c 6f 77 65 64 n time > allowed
11e00 20 72 75 6e 20 74 69 6d 65 20 74 68 65 6e 20 6b run time then k
11e10 69 6c 6c 20 6a 6f 62 0a 3b 3b 20 20 20 20 2d 20 ill job.;; -
11e20 69 66 20 63 61 6e 6e 6f 74 20 61 63 63 65 73 73 if cannot access
11e30 20 64 62 20 3e 20 61 6c 6c 6f 77 65 64 20 64 69 db > allowed di
11e40 73 63 6f 6e 6e 65 63 74 20 74 69 6d 65 20 74 68 sconnect time th
11e50 65 6e 20 6b 69 6c 6c 20 6a 6f 62 0a 0a 3b 3b 20 en kill job..;;
11e60 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d == duplicated ==
11e70 20 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 (if (or (args:g
11e80 65 74 2d 61 72 67 20 22 2d 72 75 6e 22 29 28 61 et-arg "-run")(a
11e90 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
11ea0 6e 74 65 73 74 73 22 29 29 0a 3b 3b 20 3d 3d 20 ntests")).;; ==
11eb0 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 duplicated ==
11ec0 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c (general-run-cal
11ed0 6c 20 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 l .;; == duplica
11ee0 74 65 64 20 3d 3d 20 20 20 20 22 2d 72 75 6e 74 ted == "-runt
11ef0 65 73 74 73 22 20 0a 3b 3b 20 3d 3d 20 64 75 70 ests" .;; == dup
11f00 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 22 72 licated == "r
11f10 75 6e 20 61 20 74 65 73 74 22 20 0a 3b 3b 20 3d un a test" .;; =
11f20 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 = duplicated ==
11f30 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 (lambda (targ
11f40 65 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 et runname keys
11f50 6b 65 79 76 61 6c 73 29 0a 3b 3b 20 3d 3d 20 64 keyvals).;; == d
11f60 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 uplicated ==
11f70 20 20 3b 3b 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 ;;.;; == dupli
11f80 63 61 74 65 64 20 3d 3d 20 20 20 20 20 20 3b 3b cated == ;;
11f90 20 4d 61 79 20 6f 72 20 6d 61 79 20 6e 6f 74 20 May or may not
11fa0 69 6d 70 6c 65 6d 65 6e 74 20 69 74 20 74 68 69 implement it thi
11fb0 73 20 77 61 79 20 2e 2e 2e 0a 3b 3b 20 3d 3d 20 s way ....;; ==
11fc0 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 duplicated ==
11fd0 20 20 20 3b 3b 0a 3b 3b 20 3d 3d 20 64 75 70 6c ;;.;; == dupl
11fe0 69 63 61 74 65 64 20 3d 3d 20 20 20 20 20 20 3b icated == ;
11ff0 3b 20 49 6e 73 65 72 74 20 74 68 69 73 20 72 75 ; Insert this ru
12000 6e 20 69 6e 74 6f 20 74 68 65 20 74 61 73 6b 73 n into the tasks
12010 20 71 75 65 75 65 0a 3b 3b 20 3d 3d 20 64 75 70 queue.;; == dup
12020 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 20 20 licated ==
12030 3b 3b 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f ;; (open-run-clo
12040 73 65 20 74 61 73 6b 73 3a 61 64 64 20 74 61 73 se tasks:add tas
12050 6b 73 3a 6f 70 65 6e 2d 64 62 20 0a 3b 3b 20 3d ks:open-db .;; =
12060 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 = duplicated ==
12070 20 20 20 20 20 3b 3b 20 20 20 20 09 20 20 20 20 ;; .
12080 20 22 72 75 6e 74 65 73 74 73 22 20 0a 3b 3b 20 "runtests" .;;
12090 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d == duplicated ==
120a0 20 20 20 20 20 20 3b 3b 20 20 20 20 09 20 20 20 ;; .
120b0 20 20 75 73 65 72 0a 3b 3b 20 3d 3d 20 64 75 70 user.;; == dup
120c0 6c 69 63 61 74 65 64 20 3d 3d 20 20 20 20 20 20 licated ==
120d0 3b 3b 20 20 20 20 09 20 20 20 20 20 74 61 72 67 ;; . targ
120e0 65 74 0a 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 et.;; == duplica
120f0 74 65 64 20 3d 3d 20 20 20 20 20 20 3b 3b 20 20 ted == ;;
12100 20 20 09 20 20 20 20 20 72 75 6e 6e 61 6d 65 0a . runname.
12110 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 ;; == duplicated
12120 20 3d 3d 20 20 20 20 20 20 3b 3b 20 20 20 20 09 == ;; .
12130 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 (args:get-a
12140 72 67 20 22 2d 72 75 6e 74 65 73 74 73 22 29 0a rg "-runtests").
12150 3b 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 ;; == duplicated
12160 20 3d 3d 20 20 20 20 20 20 3b 3b 20 20 20 20 09 == ;; .
12170 20 20 20 20 20 23 66 29 29 29 29 0a 3b 3b 20 3d #f)))).;; =
12180 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 = duplicated ==
12190 20 20 20 20 20 28 72 75 6e 73 3a 72 75 6e 2d 74 (runs:run-t
121a0 65 73 74 73 20 74 61 72 67 65 74 0a 3b 3b 20 3d ests target.;; =
121b0 3d 20 64 75 70 6c 69 63 61 74 65 64 20 3d 3d 20 = duplicated ==
121c0 09 09 20 20 20 20 20 72 75 6e 6e 61 6d 65 0a 3b .. runname.;
121d0 3b 20 3d 3d 20 64 75 70 6c 69 63 61 74 65 64 20 ; == duplicated
121e0 3d 3d 20 09 09 20 20 20 20 20 28 63 6f 6d 6d 6f == .. (commo
121f0 6e 3a 61 72 67 73 2d 67 65 74 2d 74 65 73 74 70 n:args-get-testp
12200 61 74 74 20 23 66 29 20 3b 3b 20 28 61 72 67 73 att #f) ;; (args
12210 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 :get-arg "-runte
12220 73 74 73 22 29 0a 3b 3b 20 3d 3d 20 64 75 70 6c sts").;; == dupl
12230 69 63 61 74 65 64 20 3d 3d 20 09 09 20 20 20 20 icated == ..
12240 20 75 73 65 72 0a 3b 3b 20 3d 3d 20 64 75 70 6c user.;; == dupl
12250 69 63 61 74 65 64 20 3d 3d 20 09 09 20 20 20 20 icated == ..
12260 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 29 29 args:arg-hash))
12270 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
12280 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12290 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
122a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
122b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
122c0 52 6f 6c 6c 75 70 20 69 6e 74 6f 20 61 20 72 75 Rollup into a ru
122d0 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d n.;;============
122e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
122f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12300 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12310 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 ==========..(if
12320 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
12330 72 6f 6c 6c 75 70 22 29 0a 20 20 20 20 28 67 65 rollup"). (ge
12340 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a neral-run-call .
12350 20 20 20 20 20 22 2d 72 6f 6c 6c 75 70 22 20 0a "-rollup" .
12360 20 20 20 20 20 22 72 6f 6c 6c 75 70 20 74 65 73 "rollup tes
12370 74 73 22 20 0a 20 20 20 20 20 28 6c 61 6d 62 64 ts" . (lambd
12380 61 20 28 74 61 72 67 65 74 20 72 75 6e 6e 61 6d a (target runnam
12390 65 20 6b 65 79 73 20 6b 65 79 76 61 6c 73 29 0a e keys keyvals).
123a0 20 20 20 20 20 20 20 28 72 75 6e 73 3a 72 6f 6c (runs:rol
123b0 6c 75 70 2d 72 75 6e 20 6b 65 79 73 0a 09 09 09 lup-run keys....
123c0 6b 65 79 76 61 6c 73 0a 09 09 09 28 6f 72 20 28 keyvals....(or (
123d0 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
123e0 75 6e 6e 61 6d 65 22 29 28 61 72 67 73 3a 67 65 unname")(args:ge
123f0 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 t-arg ":runname"
12400 29 20 29 0a 09 09 09 75 73 65 72 29 29 29 29 0a ) )....user)))).
12410 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
12420 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12430 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12440 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12450 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4c 6f 63 =========.;; Loc
12460 6b 20 6f 72 20 75 6e 6c 6f 63 6b 20 61 20 72 75 k or unlock a ru
12470 6e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d n.;;============
12480 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12490 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
124a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
124b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 ==========..(if
124c0 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
124d0 67 20 22 2d 6c 6f 63 6b 22 29 28 61 72 67 73 3a g "-lock")(args:
124e0 67 65 74 2d 61 72 67 20 22 2d 75 6e 6c 6f 63 6b get-arg "-unlock
124f0 22 29 29 0a 20 20 20 20 28 67 65 6e 65 72 61 6c ")). (general
12500 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 20 -run-call .
12510 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
12520 67 20 22 2d 6c 6f 63 6b 22 29 20 22 2d 6c 6f 63 g "-lock") "-loc
12530 6b 22 20 22 2d 75 6e 6c 6f 63 6b 22 29 0a 20 20 k" "-unlock").
12540 20 20 20 22 6c 6f 63 6b 2f 75 6e 6c 6f 63 6b 20 "lock/unlock
12550 74 65 73 74 73 22 20 0a 20 20 20 20 20 28 6c 61 tests" . (la
12560 6d 62 64 61 20 28 74 61 72 67 65 74 20 72 75 6e mbda (target run
12570 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 76 61 6c name keys keyval
12580 73 29 0a 20 20 20 20 20 20 20 28 72 75 6e 73 3a s). (runs:
12590 68 61 6e 64 6c 65 2d 6c 6f 63 6b 69 6e 67 20 0a handle-locking .
125a0 09 09 20 20 74 61 72 67 65 74 0a 09 09 20 20 6b .. target... k
125b0 65 79 73 0a 09 09 20 20 28 6f 72 20 28 61 72 67 eys... (or (arg
125c0 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 6e s:get-arg "-runn
125d0 61 6d 65 22 29 28 61 72 67 73 3a 67 65 74 2d 61 ame")(args:get-a
125e0 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 20 29 rg ":runname") )
125f0 0a 09 09 20 20 28 61 72 67 73 3a 67 65 74 2d 61 ... (args:get-a
12600 72 67 20 22 2d 6c 6f 63 6b 22 29 0a 09 09 20 20 rg "-lock")...
12610 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
12620 75 6e 6c 6f 63 6b 22 29 0a 09 09 20 20 75 73 65 unlock")... use
12630 72 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d r))))..;;=======
12640 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12650 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12660 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12670 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
12680 3b 3b 20 47 65 74 20 70 61 74 68 73 20 74 6f 20 ;; Get paths to
12690 74 65 73 74 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d tests.;;========
126a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
126b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
126c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
126d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
126e0 3b 20 47 65 74 20 74 65 73 74 20 70 61 74 68 73 ; Get test paths
126f0 20 6d 61 74 63 68 69 6e 67 20 74 61 72 67 65 74 matching target
12700 2c 20 72 75 6e 6e 61 6d 65 2c 20 61 6e 64 20 74 , runname, and t
12710 65 73 74 70 61 74 74 0a 28 69 66 20 28 6f 72 20 estpatt.(if (or
12720 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
12730 74 65 73 74 2d 66 69 6c 65 73 22 29 28 61 72 67 test-files")(arg
12740 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 s:get-arg "-test
12750 2d 70 61 74 68 73 22 29 29 0a 20 20 20 20 3b 3b -paths")). ;;
12760 20 69 66 20 77 65 20 61 72 65 20 69 6e 20 61 20 if we are in a
12770 74 65 73 74 20 75 73 65 20 74 68 65 20 4d 54 5f test use the MT_
12780 43 4d 44 49 4e 46 4f 20 64 61 74 61 0a 20 20 20 CMDINFO data.
12790 20 28 69 66 20 28 67 65 74 65 6e 76 20 22 4d 54 (if (getenv "MT
127a0 5f 43 4d 44 49 4e 46 4f 22 29 0a 09 28 6c 65 74 _CMDINFO")..(let
127b0 2a 20 28 28 73 74 61 72 74 69 6e 67 64 69 72 20 * ((startingdir
127c0 28 63 75 72 72 65 6e 74 2d 64 69 72 65 63 74 6f (current-directo
127d0 72 79 29 29 0a 09 20 20 20 20 20 20 20 28 63 6d ry)).. (cm
127e0 64 69 6e 66 6f 20 20 20 28 63 6f 6d 6d 6f 6e 3a dinfo (common:
127f0 72 65 61 64 2d 65 6e 63 6f 64 65 64 2d 73 74 72 read-encoded-str
12800 69 6e 67 20 28 67 65 74 65 6e 76 20 22 4d 54 5f ing (getenv "MT_
12810 43 4d 44 49 4e 46 4f 22 29 29 29 0a 09 20 20 20 CMDINFO")))..
12820 20 20 20 20 28 74 72 61 6e 73 70 6f 72 74 20 28 (transport (
12830 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 assoc/default 't
12840 72 61 6e 73 70 6f 72 74 20 63 6d 64 69 6e 66 6f ransport cmdinfo
12850 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 )).. (test
12860 70 61 74 68 20 20 28 61 73 73 6f 63 2f 64 65 66 path (assoc/def
12870 61 75 6c 74 20 27 74 65 73 74 70 61 74 68 20 20 ault 'testpath
12880 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
12890 20 20 28 74 65 73 74 2d 6e 61 6d 65 20 28 61 73 (test-name (as
128a0 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 soc/default 'tes
128b0 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 6f 29 29 t-name cmdinfo))
128c0 0a 09 20 20 20 20 20 20 20 28 72 75 6e 73 63 72 .. (runscr
128d0 69 70 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 ipt (assoc/defau
128e0 6c 74 20 27 72 75 6e 73 63 72 69 70 74 20 63 6d lt 'runscript cm
128f0 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
12900 28 64 62 2d 68 6f 73 74 20 20 20 28 61 73 73 6f (db-host (asso
12910 63 2f 64 65 66 61 75 6c 74 20 27 64 62 2d 68 6f c/default 'db-ho
12920 73 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 st cmdinfo))..
12930 20 20 20 20 20 20 20 28 72 75 6e 2d 69 64 20 20 (run-id
12940 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
12950 20 27 72 75 6e 2d 69 64 20 20 20 20 63 6d 64 69 'run-id cmdi
12960 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 69 nfo)).. (i
12970 74 65 6d 64 61 74 20 20 20 28 61 73 73 6f 63 2f temdat (assoc/
12980 64 65 66 61 75 6c 74 20 27 69 74 65 6d 64 61 74 default 'itemdat
12990 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 cmdinfo))..
129a0 20 20 20 20 20 28 73 74 61 74 65 20 20 20 20 20 (state
129b0 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a (args:get-arg ":
129c0 73 74 61 74 65 22 29 29 0a 09 20 20 20 20 20 20 state"))..
129d0 20 28 73 74 61 74 75 73 20 20 20 20 28 61 72 67 (status (arg
129e0 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 s:get-arg ":stat
129f0 75 73 22 29 29 0a 09 20 20 20 20 20 20 20 28 74 us")).. (t
12a00 61 72 67 65 74 20 20 20 20 28 61 72 67 73 3a 67 arget (args:g
12a10 65 74 2d 61 72 67 20 22 2d 74 61 72 67 65 74 22 et-arg "-target"
12a20 29 29 0a 09 20 20 20 20 20 20 20 28 74 6f 70 70 )).. (topp
12a30 61 74 68 20 20 20 28 61 73 73 6f 63 2f 64 65 66 ath (assoc/def
12a40 61 75 6c 74 20 27 74 6f 70 70 61 74 68 20 20 20 ault 'toppath
12a50 63 6d 64 69 6e 66 6f 29 29 29 0a 09 20 20 28 63 cmdinfo))).. (c
12a60 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 hange-directory
12a70 74 6f 70 70 61 74 68 29 0a 09 20 20 28 69 66 20 toppath).. (if
12a80 28 6e 6f 74 20 74 61 72 67 65 74 29 0a 09 20 20 (not target)..
12a90 20 20 20 20 28 62 65 67 69 6e 0a 09 09 28 64 65 (begin...(de
12aa0 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 bug:print-error
12ab0 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
12ac0 6f 72 74 2a 20 22 2d 74 61 72 67 65 74 20 69 73 ort* "-target is
12ad0 20 72 65 71 75 69 72 65 64 2e 22 29 0a 09 09 28 required.")...(
12ae0 65 78 69 74 20 31 29 29 29 0a 09 20 20 28 69 66 exit 1))).. (if
12af0 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 (not (launch:se
12b00 74 75 70 29 29 0a 09 20 20 20 20 20 20 28 62 65 tup)).. (be
12b10 67 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 72 69 gin...(debug:pri
12b20 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
12b30 67 2d 70 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 g-port* "Failed
12b40 74 6f 20 73 65 74 75 70 2c 20 67 69 76 69 6e 67 to setup, giving
12b50 20 75 70 20 6f 6e 20 2d 74 65 73 74 2d 70 61 74 up on -test-pat
12b60 68 73 20 6f 72 20 2d 74 65 73 74 2d 66 69 6c 65 hs or -test-file
12b70 73 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 09 28 s, exiting")...(
12b80 65 78 69 74 20 31 29 29 29 0a 09 20 20 28 6c 65 exit 1))).. (le
12b90 74 2a 20 28 28 6b 65 79 73 20 20 20 20 20 28 72 t* ((keys (r
12ba0 6d 74 3a 67 65 74 2d 6b 65 79 73 29 29 0a 09 09 mt:get-keys))...
12bb0 20 3b 3b 20 64 62 3a 74 65 73 74 2d 67 65 74 2d ;; db:test-get-
12bc0 70 61 74 68 73 20 6d 75 73 74 20 6e 6f 74 20 62 paths must not b
12bd0 65 20 72 75 6e 20 72 65 6d 6f 74 65 0a 09 09 20 e run remote...
12be0 28 70 61 74 68 73 20 20 20 20 28 74 65 73 74 73 (paths (tests
12bf0 3a 74 65 73 74 2d 67 65 74 2d 70 61 74 68 73 2d :test-get-paths-
12c00 6d 61 74 63 68 69 6e 67 20 6b 65 79 73 20 74 61 matching keys ta
12c10 72 67 65 74 20 28 61 72 67 73 3a 67 65 74 2d 61 rget (args:get-a
12c20 72 67 20 22 2d 74 65 73 74 2d 66 69 6c 65 73 22 rg "-test-files"
12c30 29 29 29 29 0a 09 20 20 20 20 28 73 65 74 21 20 )))).. (set!
12c40 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
12c50 74 29 0a 09 20 20 20 20 28 66 6f 72 2d 65 61 63 t).. (for-eac
12c60 68 20 28 6c 61 6d 62 64 61 20 28 70 61 74 68 29 h (lambda (path)
12c70 0a 09 09 09 28 69 66 20 28 63 6f 6d 6d 6f 6e 3a ....(if (common:
12c80 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 70 61 74 file-exists? pat
12c90 68 29 0a 09 09 09 28 70 72 69 6e 74 20 70 61 74 h)....(print pat
12ca0 68 29 29 29 09 0a 09 09 20 20 20 20 20 20 70 61 h))).... pa
12cb0 74 68 73 29 29 29 0a 09 3b 3b 20 65 6c 73 65 20 ths)))..;; else
12cc0 64 6f 20 61 20 67 65 6e 65 72 61 6c 2d 72 75 6e do a general-run
12cd0 2d 63 61 6c 6c 0a 09 28 67 65 6e 65 72 61 6c 2d -call..(general-
12ce0 72 75 6e 2d 63 61 6c 6c 20 0a 09 20 22 2d 74 65 run-call .. "-te
12cf0 73 74 2d 66 69 6c 65 73 22 0a 09 20 22 47 65 74 st-files".. "Get
12d00 20 70 61 74 68 73 20 74 6f 20 74 65 73 74 22 0a paths to test".
12d10 09 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 . (lambda (targe
12d20 74 20 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b t runname keys k
12d30 65 79 76 61 6c 73 29 0a 09 20 20 20 28 6c 65 74 eyvals).. (let
12d40 2a 20 28 28 64 62 20 20 20 20 20 20 20 23 66 29 * ((db #f)
12d50 0a 09 09 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 72 ... ;; DO NOT r
12d60 75 6e 20 72 65 6d 6f 74 65 0a 09 09 20 20 28 70 un remote... (p
12d70 61 74 68 73 20 20 20 20 28 74 65 73 74 73 3a 74 aths (tests:t
12d80 65 73 74 2d 67 65 74 2d 70 61 74 68 73 2d 6d 61 est-get-paths-ma
12d90 74 63 68 69 6e 67 20 6b 65 79 73 20 74 61 72 67 tching keys targ
12da0 65 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 et (args:get-arg
12db0 20 22 2d 74 65 73 74 2d 66 69 6c 65 73 22 29 29 "-test-files"))
12dc0 29 29 0a 09 20 20 20 20 20 28 66 6f 72 2d 65 61 )).. (for-ea
12dd0 63 68 20 28 6c 61 6d 62 64 61 20 28 70 61 74 68 ch (lambda (path
12de0 29 0a 09 09 09 20 28 70 72 69 6e 74 20 70 61 74 ).... (print pat
12df0 68 29 29 0a 09 09 20 20 20 20 20 20 20 70 61 74 h))... pat
12e00 68 73 29 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d hs))))))..;;====
12e10 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12e20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12e30 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12e40 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12e50 3d 3d 0a 3b 3b 20 41 72 63 68 69 76 65 20 74 65 ==.;; Archive te
12e60 73 74 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d sts.;;==========
12e70 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12e80 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12e90 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12ea0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
12eb0 41 72 63 68 69 76 65 20 74 65 73 74 73 20 6d 61 Archive tests ma
12ec0 74 63 68 69 6e 67 20 74 61 72 67 65 74 2c 20 72 tching target, r
12ed0 75 6e 6e 61 6d 65 2c 20 61 6e 64 20 74 65 73 74 unname, and test
12ee0 70 61 74 74 0a 28 69 66 20 28 61 72 67 73 3a 67 patt.(if (args:g
12ef0 65 74 2d 61 72 67 20 22 2d 61 72 63 68 69 76 65 et-arg "-archive
12f00 22 29 0a 20 20 20 20 3b 3b 20 65 6c 73 65 20 64 "). ;; else d
12f10 6f 20 61 20 67 65 6e 65 72 61 6c 2d 72 75 6e 2d o a general-run-
12f20 63 61 6c 6c 0a 20 20 20 20 28 67 65 6e 65 72 61 call. (genera
12f30 6c 2d 72 75 6e 2d 63 61 6c 6c 20 0a 20 20 20 20 l-run-call .
12f40 20 22 2d 61 72 63 68 69 76 65 22 0a 20 20 20 20 "-archive".
12f50 20 22 41 72 63 68 69 76 65 22 0a 20 20 20 20 20 "Archive".
12f60 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 20 (lambda (target
12f70 72 75 6e 6e 61 6d 65 20 6b 65 79 73 20 6b 65 79 runname keys key
12f80 76 61 6c 73 29 0a 20 20 20 20 20 20 20 28 6f 70 vals). (op
12f90 65 72 61 74 65 2d 6f 6e 20 27 61 72 63 68 69 76 erate-on 'archiv
12fa0 65 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d e))))..;;=======
12fb0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12fc0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12fd0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12fe0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
12ff0 3b 3b 20 45 78 74 72 61 63 74 20 61 20 73 70 72 ;; Extract a spr
13000 65 61 64 73 68 65 65 74 20 66 72 6f 6d 20 74 68 eadsheet from th
13010 65 20 72 75 6e 73 20 64 61 74 61 62 61 73 65 0a e runs database.
13020 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
13030 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13040 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13050 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13060 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 ========..(if (a
13070 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 rgs:get-arg "-ex
13080 74 72 61 63 74 2d 6f 64 73 22 29 0a 20 20 20 20 tract-ods").
13090 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c (general-run-cal
130a0 6c 0a 20 20 20 20 20 22 2d 65 78 74 72 61 63 74 l. "-extract
130b0 2d 6f 64 73 22 0a 20 20 20 20 20 22 4d 61 6b 65 -ods". "Make
130c0 20 6f 64 73 20 73 70 72 65 61 64 73 68 65 65 74 ods spreadsheet
130d0 22 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 ". (lambda (
130e0 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6b target runname k
130f0 65 79 73 20 6b 65 79 76 61 6c 73 29 0a 20 20 20 eys keyvals).
13100 20 20 20 20 28 6c 65 74 20 28 28 64 62 73 74 72 (let ((dbstr
13110 75 63 74 20 20 20 28 6d 61 6b 65 2d 64 62 72 3a uct (make-dbr:
13120 64 62 73 74 72 75 63 74 20 70 61 74 68 3a 20 2a dbstruct path: *
13130 74 6f 70 70 61 74 68 2a 20 6c 6f 63 61 6c 3a 20 toppath* local:
13140 23 74 29 29 0a 09 20 20 20 20 20 28 6f 75 74 70 #t)).. (outp
13150 75 74 66 69 6c 65 20 28 61 72 67 73 3a 67 65 74 utfile (args:get
13160 2d 61 72 67 20 22 2d 65 78 74 72 61 63 74 2d 6f -arg "-extract-o
13170 64 73 22 29 29 0a 09 20 20 20 20 20 28 72 75 6e ds")).. (run
13180 73 70 61 74 74 20 20 20 28 6f 72 20 28 61 72 67 spatt (or (arg
13190 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 6e s:get-arg "-runn
131a0 61 6d 65 22 29 28 61 72 67 73 3a 67 65 74 2d 61 ame")(args:get-a
131b0 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 29 29 rg ":runname")))
131c0 0a 09 20 20 20 20 20 28 70 61 74 68 6d 6f 64 20 .. (pathmod
131d0 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
131e0 20 22 2d 70 61 74 68 6d 6f 64 22 29 29 29 0a 09 "-pathmod")))..
131f0 20 20 20 20 20 3b 3b 20 28 6b 65 79 76 61 6c 61 ;; (keyvala
13200 6c 69 73 74 20 28 6b 65 79 73 2d 3e 61 6c 69 73 list (keys->alis
13210 74 20 6b 65 79 73 20 22 25 22 29 29 29 0a 09 20 t keys "%")))..
13220 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 2a (debug:print 2 *
13230 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
13240 2a 20 22 45 78 74 72 61 63 74 20 6f 64 73 2c 20 * "Extract ods,
13250 6f 75 74 70 75 74 66 69 6c 65 3a 20 22 20 6f 75 outputfile: " ou
13260 74 70 75 74 66 69 6c 65 20 22 20 72 75 6e 73 70 tputfile " runsp
13270 61 74 74 3a 20 22 20 72 75 6e 73 70 61 74 74 20 att: " runspatt
13280 22 20 6b 65 79 76 61 6c 73 3a 20 22 20 6b 65 79 " keyvals: " key
13290 76 61 6c 73 29 0a 09 20 28 64 62 3a 65 78 74 72 vals).. (db:extr
132a0 61 63 74 2d 6f 64 73 2d 66 69 6c 65 20 64 62 73 act-ods-file dbs
132b0 74 72 75 63 74 20 6f 75 74 70 75 74 66 69 6c 65 truct outputfile
132c0 20 6b 65 79 76 61 6c 73 20 28 69 66 20 72 75 6e keyvals (if run
132d0 73 70 61 74 74 20 72 75 6e 73 70 61 74 74 20 22 spatt runspatt "
132e0 25 22 29 20 70 61 74 68 6d 6f 64 29 0a 09 20 28 %") pathmod).. (
132f0 64 62 3a 63 6c 6f 73 65 2d 61 6c 6c 20 64 62 73 db:close-all dbs
13300 74 72 75 63 74 29 0a 09 20 28 73 65 74 21 20 2a truct).. (set! *
13310 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
13320 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d )))))..;;=======
13330 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13340 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13350 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13360 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
13370 3b 3b 20 65 78 65 63 75 74 65 20 74 68 65 20 74 ;; execute the t
13380 65 73 74 0a 3b 3b 20 20 20 20 2d 20 67 65 74 73 est.;; - gets
13390 20 63 61 6c 6c 65 64 20 6f 6e 20 72 65 6d 6f 74 called on remot
133a0 65 20 68 6f 73 74 0a 3b 3b 20 20 20 20 2d 20 72 e host.;; - r
133b0 65 63 65 69 76 65 73 20 69 6e 66 6f 20 66 72 6f eceives info fro
133c0 6d 20 74 68 65 20 2d 65 78 65 63 75 74 65 20 70 m the -execute p
133d0 61 72 61 6d 0a 3b 3b 20 20 20 20 2d 20 70 61 73 aram.;; - pas
133e0 73 65 73 20 69 6e 66 6f 20 74 6f 20 73 74 65 70 ses info to step
133f0 73 20 76 69 61 20 4d 54 5f 43 4d 44 49 4e 46 4f s via MT_CMDINFO
13400 20 65 6e 76 20 76 61 72 20 28 66 75 74 75 72 65 env var (future
13410 20 69 73 20 74 6f 20 75 73 65 20 61 20 64 6f 74 is to use a dot
13420 20 66 69 6c 65 29 0a 3b 3b 20 20 20 20 2d 20 67 file).;; - g
13430 61 74 68 65 72 73 20 68 6f 73 74 20 69 6e 66 6f athers host info
13440 20 61 6e 64 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d and .;;========
13450 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13460 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13470 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13480 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
13490 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
134a0 67 20 22 2d 65 78 65 63 75 74 65 22 29 0a 20 20 g "-execute").
134b0 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 (begin. (
134c0 6c 61 75 6e 63 68 3a 65 78 65 63 75 74 65 20 28 launch:execute (
134d0 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 args:get-arg "-e
134e0 78 65 63 75 74 65 22 29 29 0a 20 20 20 20 20 20 xecute")).
134f0 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
13500 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d ing* #t)))..;;==
13510 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13520 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13530 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13540 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13550 3d 3d 3d 3d 0a 3b 3b 20 72 65 63 6f 76 65 72 20 ====.;; recover
13560 66 72 6f 6d 20 61 20 74 65 73 74 20 77 68 65 72 from a test wher
13570 65 20 74 68 65 20 6d 61 6e 61 67 69 6e 67 20 6d e the managing m
13580 74 65 73 74 20 77 61 73 20 6b 69 6c 6c 65 64 20 test was killed
13590 62 75 74 20 74 68 65 20 75 6e 64 65 72 6c 79 69 but the underlyi
135a0 6e 67 0a 3b 3b 20 70 72 6f 63 65 73 73 20 6d 69 ng.;; process mi
135b0 67 68 74 20 73 74 69 6c 6c 20 62 65 20 73 61 6c ght still be sal
135c0 76 61 67 65 61 62 6c 65 0a 3b 3b 3d 3d 3d 3d 3d vageable.;;=====
135d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
135e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
135f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13600 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13610 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 =..(if (args:get
13620 2d 61 72 67 20 22 2d 72 65 63 6f 76 65 72 2d 74 -arg "-recover-t
13630 65 73 74 22 29 0a 20 20 20 20 28 6c 65 74 2a 20 est"). (let*
13640 28 28 70 61 72 61 6d 73 20 28 73 74 72 69 6e 67 ((params (string
13650 2d 73 70 6c 69 74 20 28 61 72 67 73 3a 67 65 74 -split (args:get
13660 2d 61 72 67 20 22 2d 72 65 63 6f 76 65 72 2d 74 -arg "-recover-t
13670 65 73 74 22 29 20 22 2c 22 29 29 29 0a 20 20 20 est") ","))).
13680 20 20 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 (if (> (lengt
13690 68 20 70 61 72 61 6d 73 29 20 31 29 20 3b 3b 20 h params) 1) ;;
136a0 72 75 6e 2d 69 64 20 61 6e 64 20 74 65 73 74 2d run-id and test-
136b0 69 64 0a 09 20 20 28 6c 65 74 20 28 28 72 75 6e id.. (let ((run
136c0 2d 69 64 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d -id (string->num
136d0 62 65 72 20 28 63 61 72 20 70 61 72 61 6d 73 29 ber (car params)
136e0 29 29 0a 09 09 28 74 65 73 74 2d 69 64 20 28 73 ))...(test-id (s
136f0 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 63 tring->number (c
13700 61 64 72 20 70 61 72 61 6d 73 29 29 29 29 0a 09 adr params))))..
13710 20 20 20 20 28 69 66 20 28 61 6e 64 20 72 75 6e (if (and run
13720 2d 69 64 20 74 65 73 74 2d 69 64 29 0a 09 09 28 -id test-id)...(
13730 62 65 67 69 6e 0a 09 09 20 20 28 6c 61 75 6e 63 begin... (launc
13740 68 3a 72 65 63 6f 76 65 72 2d 74 65 73 74 20 72 h:recover-test r
13750 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 0a 09 un-id test-id)..
13760 09 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d . (set! *didsom
13770 65 74 68 69 6e 67 2a 20 23 74 29 29 0a 09 09 28 ething* #t))...(
13780 62 65 67 69 6e 0a 09 09 20 20 28 64 65 62 75 67 begin... (debug
13790 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
137a0 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
137b0 2a 20 22 62 61 64 20 72 75 6e 2d 69 64 20 6f 72 * "bad run-id or
137c0 20 74 65 73 74 2d 69 64 2c 20 6d 75 73 74 20 62 test-id, must b
137d0 65 20 69 6e 74 65 67 65 72 73 22 29 0a 09 09 20 e integers")...
137e0 20 28 65 78 69 74 20 31 29 29 29 29 29 29 29 0a (exit 1))))))).
137f0 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
13800 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13810 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13820 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13830 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 54 65 73 =========.;; Tes
13840 74 20 63 6f 6d 6d 61 6e 64 73 20 28 69 2e 65 2e t commands (i.e.
13850 20 66 6f 72 20 75 73 65 20 69 6e 73 69 64 65 20 for use inside
13860 74 65 73 74 73 29 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d tests).;;=======
13870 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13880 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13890 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
138a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
138b0 0a 28 64 65 66 69 6e 65 20 28 6d 65 67 61 74 65 .(define (megate
138c0 73 74 3a 73 74 65 70 20 73 74 65 70 20 73 74 61 st:step step sta
138d0 74 65 20 73 74 61 74 75 73 20 6c 6f 67 66 69 6c te status logfil
138e0 65 20 6d 73 67 29 0a 20 20 28 69 66 20 28 6e 6f e msg). (if (no
138f0 74 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d t (getenv "MT_CM
13900 44 49 4e 46 4f 22 29 29 0a 20 20 20 20 20 20 28 DINFO")). (
13910 62 65 67 69 6e 0a 09 28 64 65 62 75 67 3a 70 72 begin..(debug:pr
13920 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 int-error 0 *def
13930 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
13940 4d 54 5f 43 4d 44 49 4e 46 4f 20 65 6e 76 20 76 MT_CMDINFO env v
13950 61 72 20 6e 6f 74 20 73 65 74 2c 20 2d 73 74 65 ar not set, -ste
13960 70 20 6d 75 73 74 20 62 65 20 63 61 6c 6c 65 64 p must be called
13970 20 2a 69 6e 73 69 64 65 2a 20 61 20 6d 65 67 61 *inside* a mega
13980 74 65 73 74 20 69 6e 76 6f 6b 65 64 20 65 6e 76 test invoked env
13990 69 72 6f 6e 6d 65 6e 74 21 22 29 0a 09 28 65 78 ironment!")..(ex
139a0 69 74 20 35 29 29 0a 20 20 20 20 20 20 28 6c 65 it 5)). (le
139b0 74 2a 20 28 28 63 6d 64 69 6e 66 6f 20 20 20 28 t* ((cmdinfo (
139c0 63 6f 6d 6d 6f 6e 3a 72 65 61 64 2d 65 6e 63 6f common:read-enco
139d0 64 65 64 2d 73 74 72 69 6e 67 20 28 67 65 74 65 ded-string (gete
139e0 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 nv "MT_CMDINFO")
139f0 29 29 0a 09 20 20 20 20 20 28 74 72 61 6e 73 70 )).. (transp
13a00 6f 72 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 ort (assoc/defau
13a10 6c 74 20 27 74 72 61 6e 73 70 6f 72 74 20 63 6d lt 'transport cm
13a20 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 74 dinfo)).. (t
13a30 65 73 74 70 61 74 68 20 20 28 61 73 73 6f 63 2f estpath (assoc/
13a40 64 65 66 61 75 6c 74 20 27 74 65 73 74 70 61 74 default 'testpat
13a50 68 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 h cmdinfo))..
13a60 20 20 20 28 74 65 73 74 2d 6e 61 6d 65 20 28 61 (test-name (a
13a70 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 ssoc/default 'te
13a80 73 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 6f 29 st-name cmdinfo)
13a90 29 0a 09 20 20 20 20 20 28 72 75 6e 73 63 72 69 ).. (runscri
13aa0 70 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c pt (assoc/defaul
13ab0 74 20 27 72 75 6e 73 63 72 69 70 74 20 63 6d 64 t 'runscript cmd
13ac0 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 64 62 info)).. (db
13ad0 2d 68 6f 73 74 20 20 20 28 61 73 73 6f 63 2f 64 -host (assoc/d
13ae0 65 66 61 75 6c 74 20 27 64 62 2d 68 6f 73 74 20 efault 'db-host
13af0 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 cmdinfo))..
13b00 20 20 28 72 75 6e 2d 69 64 20 20 20 20 28 61 73 (run-id (as
13b10 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e soc/default 'run
13b20 2d 69 64 20 20 20 20 63 6d 64 69 6e 66 6f 29 29 -id cmdinfo))
13b30 0a 09 20 20 20 20 20 28 74 65 73 74 2d 69 64 20 .. (test-id
13b40 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
13b50 20 27 74 65 73 74 2d 69 64 20 20 20 63 6d 64 69 'test-id cmdi
13b60 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 69 74 65 nfo)).. (ite
13b70 6d 64 61 74 20 20 20 28 61 73 73 6f 63 2f 64 65 mdat (assoc/de
13b80 66 61 75 6c 74 20 27 69 74 65 6d 64 61 74 20 20 fault 'itemdat
13b90 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
13ba0 20 28 77 6f 72 6b 2d 61 72 65 61 20 28 61 73 73 (work-area (ass
13bb0 6f 63 2f 64 65 66 61 75 6c 74 20 27 77 6f 72 6b oc/default 'work
13bc0 2d 61 72 65 61 20 63 6d 64 69 6e 66 6f 29 29 0a -area cmdinfo)).
13bd0 09 20 20 20 20 20 28 64 62 20 20 20 20 20 20 20 . (db
13be0 20 23 66 29 29 0a 09 28 63 68 61 6e 67 65 2d 64 #f))..(change-d
13bf0 69 72 65 63 74 6f 72 79 20 74 65 73 74 70 61 74 irectory testpat
13c00 68 29 0a 09 28 69 66 20 28 6e 6f 74 20 28 6c 61 h)..(if (not (la
13c10 75 6e 63 68 3a 73 65 74 75 70 29 29 0a 09 20 20 unch:setup))..
13c20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 20 (begin..
13c30 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a (debug:print 0 *
13c40 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
13c50 2a 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 * "Failed to set
13c60 75 70 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 20 up, exiting")..
13c70 20 20 20 20 20 28 65 78 69 74 20 31 29 29 29 0a (exit 1))).
13c80 09 28 69 66 20 28 61 6e 64 20 73 74 61 74 65 20 .(if (and state
13c90 73 74 61 74 75 73 29 0a 09 20 20 20 20 28 6c 65 status).. (le
13ca0 74 20 28 28 63 6f 6d 6d 65 6e 74 20 28 6c 61 75 t ((comment (lau
13cb0 6e 63 68 3a 6c 6f 61 64 2d 6c 6f 67 70 72 6f 2d nch:load-logpro-
13cc0 64 61 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d dat run-id test-
13cd0 69 64 20 73 74 65 70 29 29 29 0a 09 20 20 20 20 id step)))..
13ce0 20 20 3b 3b 20 28 72 6d 74 3a 74 65 73 74 2d 73 ;; (rmt:test-s
13cf0 65 74 2d 6c 6f 67 21 20 72 75 6e 2d 69 64 20 74 et-log! run-id t
13d00 65 73 74 2d 69 64 20 28 63 6f 6e 63 20 73 74 65 est-id (conc ste
13d10 70 6e 61 6d 65 20 22 2e 68 74 6d 6c 22 29 29 29 pname ".html")))
13d20 29 0a 09 20 20 20 20 20 20 28 72 6d 74 3a 74 65 ).. (rmt:te
13d30 73 74 73 74 65 70 2d 73 65 74 2d 73 74 61 74 75 ststep-set-statu
13d40 73 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 s! run-id test-i
13d50 64 20 73 74 65 70 20 73 74 61 74 65 20 73 74 61 d step state sta
13d60 74 75 73 20 28 6f 72 20 63 6f 6d 6d 65 6e 74 20 tus (or comment
13d70 6d 73 67 29 20 6c 6f 67 66 69 6c 65 29 29 0a 09 msg) logfile))..
13d80 20 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 (begin..
13d90 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 (debug:print-e
13da0 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d rror 0 *default-
13db0 6c 6f 67 2d 70 6f 72 74 2a 20 22 59 6f 75 20 6d log-port* "You m
13dc0 75 73 74 20 73 70 65 63 69 66 79 20 3a 73 74 61 ust specify :sta
13dd0 74 65 20 61 6e 64 20 3a 73 74 61 74 75 73 20 77 te and :status w
13de0 69 74 68 20 65 76 65 72 79 20 63 61 6c 6c 20 74 ith every call t
13df0 6f 20 2d 73 74 65 70 22 29 0a 09 20 20 20 20 20 o -step")..
13e00 20 28 65 78 69 74 20 36 29 29 29 29 29 29 0a 0a (exit 6))))))..
13e10 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
13e20 67 20 22 2d 73 74 65 70 22 29 0a 20 20 20 20 28 g "-step"). (
13e30 62 65 67 69 6e 0a 20 20 20 20 20 20 28 6d 65 67 begin. (meg
13e40 61 74 65 73 74 3a 73 74 65 70 20 0a 20 20 20 20 atest:step .
13e50 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
13e60 20 22 2d 73 74 65 70 22 29 0a 20 20 20 20 20 20 "-step").
13e70 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 (or (args:get-a
13e80 72 67 20 22 2d 73 74 61 74 65 22 29 28 61 72 67 rg "-state")(arg
13e90 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 s:get-arg ":stat
13ea0 65 22 29 29 0a 20 20 20 20 20 20 20 28 6f 72 20 e")). (or
13eb0 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
13ec0 73 74 61 74 75 73 22 29 28 61 72 67 73 3a 67 65 status")(args:ge
13ed0 74 2d 61 72 67 20 22 3a 73 74 61 74 75 73 22 29 t-arg ":status")
13ee0 29 0a 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 ). (args:g
13ef0 65 74 2d 61 72 67 20 22 2d 73 65 74 6c 6f 67 22 et-arg "-setlog"
13f00 29 0a 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 ). (args:g
13f10 65 74 2d 61 72 67 20 22 2d 6d 22 29 29 0a 20 20 et-arg "-m")).
13f20 20 20 20 20 3b 3b 20 28 69 66 20 64 62 20 28 73 ;; (if db (s
13f30 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
13f40 20 64 62 29 29 0a 20 20 20 20 20 20 28 73 65 74 db)). (set
13f50 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
13f60 20 23 74 29 29 29 0a 20 20 20 20 0a 28 69 66 20 #t))). .(if
13f70 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
13f80 67 20 22 2d 73 65 74 6c 6f 67 22 29 20 20 20 20 g "-setlog")
13f90 20 20 20 3b 3b 20 73 69 6e 63 65 20 73 65 74 74 ;; since sett
13fa0 69 6e 67 20 75 70 20 69 73 20 73 6f 20 63 6f 73 ing up is so cos
13fb0 74 6c 79 20 6c 65 74 73 20 70 69 67 67 79 62 61 tly lets piggyba
13fc0 63 6b 20 6f 6e 20 2d 74 65 73 74 2d 73 74 61 74 ck on -test-stat
13fd0 75 73 0a 09 3b 3b 20 20 20 20 20 28 6e 6f 74 20 us..;; (not
13fe0 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
13ff0 73 74 65 70 22 29 29 29 20 20 3b 3b 20 2d 73 65 step"))) ;; -se
14000 74 6c 6f 67 20 6d 61 79 20 68 61 76 65 20 62 65 tlog may have be
14010 65 6e 20 70 72 6f 63 65 73 73 65 64 20 61 6c 72 en processed alr
14020 65 61 64 79 20 69 6e 20 74 68 65 20 22 2d 73 74 eady in the "-st
14030 65 70 22 20 70 72 65 76 69 6f 75 73 0a 09 3b 3b ep" previous..;;
14040 20 20 20 20 20 4e 45 57 20 50 4f 4c 49 43 59 20 NEW POLICY
14050 2d 20 2d 73 65 74 6c 6f 67 20 73 65 74 73 20 74 - -setlog sets t
14060 65 73 74 20 6f 76 65 72 61 6c 6c 20 6c 6f 67 20 est overall log
14070 6f 6e 20 65 76 65 72 79 20 63 61 6c 6c 2e 0a 09 on every call...
14080 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
14090 73 65 74 2d 74 6f 70 6c 6f 67 22 29 0a 09 28 61 set-toplog")..(a
140a0 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 rgs:get-arg "-te
140b0 73 74 2d 73 74 61 74 75 73 22 29 0a 09 28 61 72 st-status")..(ar
140c0 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 74 gs:get-arg "-set
140d0 2d 76 61 6c 75 65 73 22 29 0a 09 28 61 72 67 73 -values")..(args
140e0 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 61 64 2d :get-arg "-load-
140f0 74 65 73 74 2d 64 61 74 61 22 29 0a 09 28 61 72 test-data")..(ar
14100 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
14110 73 74 65 70 22 29 0a 09 28 61 72 67 73 3a 67 65 step")..(args:ge
14120 74 2d 61 72 67 20 22 2d 73 75 6d 6d 61 72 69 7a t-arg "-summariz
14130 65 2d 69 74 65 6d 73 22 29 29 0a 20 20 20 20 28 e-items")). (
14140 69 66 20 28 6e 6f 74 20 28 67 65 74 65 6e 76 20 if (not (getenv
14150 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 0a 09 "MT_CMDINFO"))..
14160 28 62 65 67 69 6e 0a 09 20 20 28 64 65 62 75 67 (begin.. (debug
14170 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
14180 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
14190 2a 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 20 65 6e * "MT_CMDINFO en
141a0 76 20 76 61 72 20 6e 6f 74 20 73 65 74 2c 20 63 v var not set, c
141b0 6f 6d 6d 61 6e 64 73 20 2d 74 65 73 74 2d 73 74 ommands -test-st
141c0 61 74 75 73 2c 20 2d 72 75 6e 73 74 65 70 20 61 atus, -runstep a
141d0 6e 64 20 2d 73 65 74 6c 6f 67 20 6d 75 73 74 20 nd -setlog must
141e0 62 65 20 63 61 6c 6c 65 64 20 2a 69 6e 73 69 64 be called *insid
141f0 65 2a 20 61 20 6d 65 67 61 74 65 73 74 20 65 6e e* a megatest en
14200 76 69 72 6f 6e 6d 65 6e 74 21 22 29 0a 09 20 20 vironment!")..
14210 28 65 78 69 74 20 35 29 29 0a 09 28 6c 65 74 2a (exit 5))..(let*
14220 20 28 28 73 74 61 72 74 69 6e 67 64 69 72 20 28 ((startingdir (
14230 63 75 72 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 current-director
14240 79 29 29 0a 09 20 20 20 20 20 20 20 28 63 6d 64 y)).. (cmd
14250 69 6e 66 6f 20 20 20 28 63 6f 6d 6d 6f 6e 3a 72 info (common:r
14260 65 61 64 2d 65 6e 63 6f 64 65 64 2d 73 74 72 69 ead-encoded-stri
14270 6e 67 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 ng (getenv "MT_C
14280 4d 44 49 4e 46 4f 22 29 29 29 0a 09 20 20 20 20 MDINFO")))..
14290 20 20 20 28 74 72 61 6e 73 70 6f 72 74 20 28 61 (transport (a
142a0 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 72 ssoc/default 'tr
142b0 61 6e 73 70 6f 72 74 20 63 6d 64 69 6e 66 6f 29 ansport cmdinfo)
142c0 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 70 ).. (testp
142d0 61 74 68 20 20 28 61 73 73 6f 63 2f 64 65 66 61 ath (assoc/defa
142e0 75 6c 74 20 27 74 65 73 74 70 61 74 68 20 20 63 ult 'testpath c
142f0 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
14300 20 28 74 65 73 74 2d 6e 61 6d 65 20 28 61 73 73 (test-name (ass
14310 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 oc/default 'test
14320 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 6f 29 29 0a -name cmdinfo)).
14330 09 20 20 20 20 20 20 20 28 72 75 6e 73 63 72 69 . (runscri
14340 70 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c pt (assoc/defaul
14350 74 20 27 72 75 6e 73 63 72 69 70 74 20 63 6d 64 t 'runscript cmd
14360 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
14370 64 62 2d 68 6f 73 74 20 20 20 28 61 73 73 6f 63 db-host (assoc
14380 2f 64 65 66 61 75 6c 74 20 27 64 62 2d 68 6f 73 /default 'db-hos
14390 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 t cmdinfo))..
143a0 20 20 20 20 20 20 28 72 75 6e 2d 69 64 20 20 20 (run-id
143b0 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
143c0 27 72 75 6e 2d 69 64 20 20 20 20 63 6d 64 69 6e 'run-id cmdin
143d0 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 fo)).. (te
143e0 73 74 2d 69 64 20 20 20 28 61 73 73 6f 63 2f 64 st-id (assoc/d
143f0 65 66 61 75 6c 74 20 27 74 65 73 74 2d 69 64 20 efault 'test-id
14400 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 cmdinfo))..
14410 20 20 20 20 28 69 74 65 6d 64 61 74 20 20 20 28 (itemdat (
14420 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 69 assoc/default 'i
14430 74 65 6d 64 61 74 20 20 20 63 6d 64 69 6e 66 6f temdat cmdinfo
14440 29 29 0a 09 20 20 20 20 20 20 20 28 77 6f 72 6b )).. (work
14450 2d 61 72 65 61 20 28 61 73 73 6f 63 2f 64 65 66 -area (assoc/def
14460 61 75 6c 74 20 27 77 6f 72 6b 2d 61 72 65 61 20 ault 'work-area
14470 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
14480 20 20 28 64 62 20 20 20 20 20 20 20 20 23 66 29 (db #f)
14490 20 3b 3b 20 28 6f 70 65 6e 2d 64 62 29 29 0a 09 ;; (open-db))..
144a0 20 20 20 20 20 20 20 28 73 74 61 74 65 20 20 20 (state
144b0 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
144c0 22 3a 73 74 61 74 65 22 29 29 0a 09 20 20 20 20 ":state"))..
144d0 20 20 20 28 73 74 61 74 75 73 20 20 20 20 28 61 (status (a
144e0 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 rgs:get-arg ":st
144f0 61 74 75 73 22 29 29 0a 09 20 20 20 20 20 20 20 atus"))..
14500 28 73 74 65 70 6e 61 6d 65 20 20 28 61 72 67 73 (stepname (args
14510 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 65 70 22 :get-arg "-step"
14520 29 29 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 ))).. (if (not
14530 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 0a (launch:setup)).
14540 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 . (begin...
14550 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a (debug:print 0 *
14560 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
14570 2a 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 * "Failed to set
14580 75 70 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 09 up, exiting")...
14590 28 65 78 69 74 20 31 29 29 29 0a 0a 09 20 20 28 (exit 1)))... (
145a0 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
145b0 20 22 2d 72 75 6e 73 74 65 70 22 29 28 64 65 62 "-runstep")(deb
145c0 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 20 ug:print-info 1
145d0 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
145e0 74 2a 20 22 52 75 6e 6e 69 6e 67 20 2d 72 75 6e t* "Running -run
145f0 73 74 65 70 2c 20 66 69 72 73 74 20 63 68 61 6e step, first chan
14600 67 65 20 74 6f 20 64 69 72 65 63 74 6f 72 79 20 ge to directory
14610 22 20 77 6f 72 6b 2d 61 72 65 61 29 29 0a 09 20 " work-area))..
14620 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f (change-directo
14630 72 79 20 77 6f 72 6b 2d 61 72 65 61 29 0a 09 20 ry work-area)..
14640 20 3b 3b 20 63 61 6e 20 73 65 74 75 70 20 61 73 ;; can setup as
14650 20 63 6c 69 65 6e 74 20 66 6f 72 20 73 65 72 76 client for serv
14660 65 72 20 6d 6f 64 65 20 6e 6f 77 0a 09 20 20 3b er mode now.. ;
14670 3b 20 28 63 6c 69 65 6e 74 3a 73 65 74 75 70 29 ; (client:setup)
14680 0a 0a 09 20 20 28 69 66 20 28 61 72 67 73 3a 67 ... (if (args:g
14690 65 74 2d 61 72 67 20 22 2d 6c 6f 61 64 2d 74 65 et-arg "-load-te
146a0 73 74 2d 64 61 74 61 22 29 0a 09 20 20 20 20 20 st-data")..
146b0 20 3b 3b 20 68 61 73 20 73 75 62 20 63 6f 6d 6d ;; has sub comm
146c0 61 6e 64 73 20 74 68 61 74 20 61 72 65 20 72 64 ands that are rd
146d0 62 3a 0a 09 20 20 20 20 20 20 3b 3b 20 44 4f 20 b:.. ;; DO
146e0 4e 4f 54 20 70 75 74 20 74 68 69 73 20 6f 6e 65 NOT put this one
146f0 20 69 6e 74 6f 20 65 69 74 68 65 72 20 72 6d 74 into either rmt
14700 3a 20 6f 72 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c : or open-run-cl
14710 6f 73 65 0a 09 20 20 20 20 20 20 28 74 64 62 3a ose.. (tdb:
14720 6c 6f 61 64 2d 74 65 73 74 2d 64 61 74 61 20 72 load-test-data r
14730 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 29 0a un-id test-id)).
14740 09 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 . (if (args:get
14750 2d 61 72 67 20 22 2d 73 65 74 6c 6f 67 22 29 0a -arg "-setlog").
14760 09 20 20 20 20 20 20 28 6c 65 74 20 28 28 6c 6f . (let ((lo
14770 67 66 6e 61 6d 65 20 28 61 72 67 73 3a 67 65 74 gfname (args:get
14780 2d 61 72 67 20 22 2d 73 65 74 6c 6f 67 22 29 29 -arg "-setlog"))
14790 29 0a 09 09 28 72 6d 74 3a 74 65 73 74 2d 73 65 )...(rmt:test-se
147a0 74 2d 6c 6f 67 21 20 72 75 6e 2d 69 64 20 74 65 t-log! run-id te
147b0 73 74 2d 69 64 20 6c 6f 67 66 6e 61 6d 65 29 29 st-id logfname))
147c0 29 0a 09 20 20 28 69 66 20 28 61 72 67 73 3a 67 ).. (if (args:g
147d0 65 74 2d 61 72 67 20 22 2d 73 65 74 2d 74 6f 70 et-arg "-set-top
147e0 6c 6f 67 22 29 0a 09 20 20 20 20 20 20 3b 3b 20 log").. ;;
147f0 44 4f 20 4e 4f 54 20 72 75 6e 20 72 65 6d 6f 74 DO NOT run remot
14800 65 0a 09 20 20 20 20 20 20 28 74 65 73 74 73 3a e.. (tests:
14810 74 65 73 74 2d 73 65 74 2d 74 6f 70 6c 6f 67 21 test-set-toplog!
14820 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
14830 65 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 e (args:get-arg
14840 22 2d 73 65 74 2d 74 6f 70 6c 6f 67 22 29 29 29 "-set-toplog")))
14850 0a 09 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 .. (if (args:ge
14860 74 2d 61 72 67 20 22 2d 73 75 6d 6d 61 72 69 7a t-arg "-summariz
14870 65 2d 69 74 65 6d 73 22 29 0a 09 20 20 20 20 20 e-items")..
14880 20 3b 3b 20 44 4f 20 4e 4f 54 20 72 75 6e 20 72 ;; DO NOT run r
14890 65 6d 6f 74 65 0a 09 20 20 20 20 20 20 28 74 65 emote.. (te
148a0 73 74 73 3a 73 75 6d 6d 61 72 69 7a 65 2d 69 74 sts:summarize-it
148b0 65 6d 73 20 72 75 6e 2d 69 64 20 74 65 73 74 2d ems run-id test-
148c0 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 23 74 29 id test-name #t)
148d0 29 20 3b 3b 20 64 6f 20 66 6f 72 63 65 20 68 65 ) ;; do force he
148e0 72 65 0a 09 20 20 28 69 66 20 28 61 72 67 73 3a re.. (if (args:
148f0 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 73 74 65 get-arg "-runste
14900 70 22 29 0a 09 20 20 20 20 20 20 28 69 66 20 28 p").. (if (
14910 6e 75 6c 6c 3f 20 72 65 6d 61 72 67 73 29 0a 09 null? remargs)..
14920 09 20 20 28 62 65 67 69 6e 0a 09 09 20 20 20 20 . (begin...
14930 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 (debug:print-err
14940 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f or 0 *default-lo
14950 67 2d 70 6f 72 74 2a 20 22 6e 6f 74 68 69 6e 67 g-port* "nothing
14960 20 73 70 65 63 69 66 69 65 64 20 74 6f 20 72 75 specified to ru
14970 6e 21 22 29 0a 09 09 20 20 20 20 28 69 66 20 64 n!")... (if d
14980 62 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c b (sqlite3:final
14990 69 7a 65 21 20 64 62 29 29 0a 09 09 20 20 20 20 ize! db))...
149a0 28 65 78 69 74 20 36 29 29 0a 09 09 20 20 28 6c (exit 6))... (l
149b0 65 74 2a 20 28 28 73 74 65 70 6e 61 6d 65 20 20 et* ((stepname
149c0 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
149d0 2d 72 75 6e 73 74 65 70 22 29 29 0a 09 09 09 20 -runstep"))....
149e0 28 6c 6f 67 70 72 6f 66 69 6c 65 20 28 61 72 67 (logprofile (arg
149f0 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 67 70 s:get-arg "-logp
14a00 72 6f 22 29 29 0a 09 09 09 20 28 6c 6f 67 66 69 ro")).... (logfi
14a10 6c 65 20 20 20 20 28 63 6f 6e 63 20 73 74 65 70 le (conc step
14a20 6e 61 6d 65 20 22 2e 6c 6f 67 22 29 29 0a 09 09 name ".log"))...
14a30 09 20 28 63 6d 64 20 20 20 20 20 20 20 20 28 69 . (cmd (i
14a40 66 20 28 6e 75 6c 6c 3f 20 72 65 6d 61 72 67 73 f (null? remargs
14a50 29 20 23 66 20 28 63 61 72 20 72 65 6d 61 72 67 ) #f (car remarg
14a60 73 29 29 29 0a 09 09 09 20 28 70 61 72 61 6d 73 s))).... (params
14a70 20 20 20 20 20 28 69 66 20 63 6d 64 20 28 63 64 (if cmd (cd
14a80 72 20 72 65 6d 61 72 67 73 29 20 27 28 29 29 29 r remargs) '()))
14a90 0a 09 09 09 20 28 65 78 69 74 73 74 61 74 20 20 .... (exitstat
14aa0 20 23 66 29 0a 09 09 09 20 28 73 68 65 6c 6c 20 #f).... (shell
14ab0 20 20 20 20 20 28 6c 65 74 20 28 28 73 68 20 28 (let ((sh (
14ac0 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d get-environment-
14ad0 76 61 72 69 61 62 6c 65 20 22 53 48 45 4c 4c 22 variable "SHELL"
14ae0 29 20 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 ) )).....
14af0 28 69 66 20 73 68 20 0a 09 09 09 09 09 20 20 20 (if sh ......
14b00 28 6c 61 73 74 20 28 73 74 72 69 6e 67 2d 73 70 (last (string-sp
14b10 6c 69 74 20 73 68 20 22 2f 22 29 29 0a 09 09 09 lit sh "/"))....
14b20 09 09 20 20 20 22 62 61 73 68 22 29 29 29 0a 09 .. "bash")))..
14b30 09 09 20 28 72 65 64 69 72 20 20 20 20 20 20 28 .. (redir (
14b40 63 61 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 case (string->sy
14b50 6d 62 6f 6c 20 73 68 65 6c 6c 29 0a 09 09 09 09 mbol shell).....
14b60 20 20 20 20 20 20 20 28 28 74 63 73 68 20 63 73 ((tcsh cs
14b70 68 20 6b 73 68 29 20 20 20 20 22 3e 26 22 29 0a h ksh) ">&").
14b80 09 09 09 09 20 20 20 20 20 20 20 28 28 7a 73 68 .... ((zsh
14b90 20 62 61 73 68 20 73 68 20 61 73 68 29 20 22 32 bash sh ash) "2
14ba0 3e 26 31 20 3e 22 29 0a 09 09 09 09 20 20 20 20 >&1 >").....
14bb0 20 20 20 28 65 6c 73 65 20 22 3e 26 22 29 29 29 (else ">&")))
14bc0 0a 09 09 09 20 28 66 75 6c 6c 63 6d 64 20 20 20 .... (fullcmd
14bd0 20 28 63 6f 6e 63 20 22 28 22 20 28 73 74 72 69 (conc "(" (stri
14be0 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 0a ng-intersperse .
14bf0 09 09 09 09 09 09 28 63 6f 6e 73 20 63 6d 64 20 ......(cons cmd
14c00 70 61 72 61 6d 73 29 20 22 20 22 29 0a 09 09 09 params) " ")....
14c10 09 09 20 20 20 22 29 20 22 20 72 65 64 69 72 20 .. ") " redir
14c20 22 20 22 20 6c 6f 67 66 69 6c 65 29 29 29 0a 09 " " logfile)))..
14c30 09 20 20 20 20 3b 3b 20 6d 61 72 6b 20 74 68 65 . ;; mark the
14c40 20 73 74 61 72 74 20 6f 66 20 74 68 65 20 74 65 start of the te
14c50 73 74 0a 09 09 20 20 20 20 28 72 6d 74 3a 74 65 st... (rmt:te
14c60 73 74 73 74 65 70 2d 73 65 74 2d 73 74 61 74 75 ststep-set-statu
14c70 73 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 s! run-id test-i
14c80 64 20 73 74 65 70 6e 61 6d 65 20 22 73 74 61 72 d stepname "star
14c90 74 22 20 22 6e 2f 61 22 20 28 61 72 67 73 3a 67 t" "n/a" (args:g
14ca0 65 74 2d 61 72 67 20 22 2d 6d 22 29 20 6c 6f 67 et-arg "-m") log
14cb0 66 69 6c 65 29 0a 09 09 20 20 20 20 3b 3b 20 72 file)... ;; r
14cc0 75 6e 20 74 68 65 20 74 65 73 74 20 73 74 65 70 un the test step
14cd0 0a 09 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 ... (debug:pr
14ce0 69 6e 74 2d 69 6e 66 6f 20 32 20 2a 64 65 66 61 int-info 2 *defa
14cf0 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 52 ult-log-port* "R
14d00 75 6e 6e 69 6e 67 20 5c 22 22 20 66 75 6c 6c 63 unning \"" fullc
14d10 6d 64 20 22 5c 22 20 69 6e 20 64 69 72 65 63 74 md "\" in direct
14d20 6f 72 79 20 5c 22 22 20 73 74 61 72 74 69 6e 67 ory \"" starting
14d30 64 69 72 29 0a 09 09 20 20 20 20 28 63 68 61 6e dir)... (chan
14d40 67 65 2d 64 69 72 65 63 74 6f 72 79 20 73 74 61 ge-directory sta
14d50 72 74 69 6e 67 64 69 72 29 0a 09 09 20 20 20 20 rtingdir)...
14d60 28 73 65 74 21 20 65 78 69 74 73 74 61 74 20 28 (set! exitstat (
14d70 73 79 73 74 65 6d 20 66 75 6c 6c 63 6d 64 29 29 system fullcmd))
14d80 0a 09 09 20 20 20 20 28 73 65 74 21 20 2a 67 6c ... (set! *gl
14d90 6f 62 61 6c 65 78 69 74 73 74 61 74 75 73 2a 20 obalexitstatus*
14da0 65 78 69 74 73 74 61 74 29 0a 09 09 20 20 20 20 exitstat)...
14db0 3b 3b 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 ;; (change-direc
14dc0 74 6f 72 79 20 74 65 73 74 70 61 74 68 29 0a 09 tory testpath)..
14dd0 09 20 20 20 20 3b 3b 20 72 75 6e 20 6c 6f 67 70 . ;; run logp
14de0 72 6f 20 69 66 20 61 70 70 6c 69 63 61 62 6c 65 ro if applicable
14df0 20 3b 3b 20 28 70 72 6f 63 65 73 73 2d 72 75 6e ;; (process-run
14e00 20 22 6c 73 22 20 28 6c 69 73 74 20 22 2f 66 6f "ls" (list "/fo
14e10 6f 22 20 22 32 3e 26 31 22 20 22 62 6c 61 68 2e o" "2>&1" "blah.
14e20 6c 6f 67 22 29 29 0a 09 09 20 20 20 20 28 69 66 log"))... (if
14e30 20 6c 6f 67 70 72 6f 66 69 6c 65 0a 09 09 09 28 logprofile....(
14e40 6c 65 74 2a 20 28 28 68 74 6d 6c 6c 6f 67 66 69 let* ((htmllogfi
14e50 6c 65 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d le (conc stepnam
14e60 65 20 22 2e 68 74 6d 6c 22 29 29 0a 09 09 09 20 e ".html"))....
14e70 20 20 20 20 20 20 28 6f 6c 64 65 78 69 74 73 74 (oldexitst
14e80 61 74 20 65 78 69 74 73 74 61 74 29 0a 09 09 09 at exitstat)....
14e90 20 20 20 20 20 20 20 28 63 6d 64 20 20 20 20 20 (cmd
14ea0 20 20 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 (string-inte
14eb0 72 73 70 65 72 73 65 20 28 6c 69 73 74 20 22 6c rsperse (list "l
14ec0 6f 67 70 72 6f 22 20 6c 6f 67 70 72 6f 66 69 6c ogpro" logprofil
14ed0 65 20 68 74 6d 6c 6c 6f 67 66 69 6c 65 20 22 3c e htmllogfile "<
14ee0 22 20 6c 6f 67 66 69 6c 65 20 22 3e 22 20 28 63 " logfile ">" (c
14ef0 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 5f 6c onc stepname "_l
14f00 6f 67 70 72 6f 2e 6c 6f 67 22 29 29 20 22 20 22 ogpro.log")) " "
14f10 29 29 29 0a 09 09 09 20 20 28 64 65 62 75 67 3a ))).... (debug:
14f20 70 72 69 6e 74 2d 69 6e 66 6f 20 32 20 2a 64 65 print-info 2 *de
14f30 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
14f40 22 72 75 6e 6e 69 6e 67 20 5c 22 22 20 63 6d 64 "running \"" cmd
14f50 20 22 5c 22 22 29 0a 09 09 09 20 20 28 63 68 61 "\"").... (cha
14f60 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 73 74 nge-directory st
14f70 61 72 74 69 6e 67 64 69 72 29 0a 09 09 09 20 20 artingdir)....
14f80 28 73 65 74 21 20 65 78 69 74 73 74 61 74 20 28 (set! exitstat (
14f90 73 79 73 74 65 6d 20 63 6d 64 29 29 0a 09 09 09 system cmd))....
14fa0 20 20 28 73 65 74 21 20 2a 67 6c 6f 62 61 6c 65 (set! *globale
14fb0 78 69 74 73 74 61 74 75 73 2a 20 65 78 69 74 73 xitstatus* exits
14fc0 74 61 74 29 20 3b 3b 20 6e 6f 20 6e 65 63 65 73 tat) ;; no neces
14fd0 73 61 72 79 0a 09 09 09 20 20 28 63 68 61 6e 67 sary.... (chang
14fe0 65 2d 64 69 72 65 63 74 6f 72 79 20 74 65 73 74 e-directory test
14ff0 70 61 74 68 29 0a 09 09 09 20 20 28 72 6d 74 3a path).... (rmt:
15000 74 65 73 74 2d 73 65 74 2d 6c 6f 67 21 20 72 75 test-set-log! ru
15010 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 68 74 6d n-id test-id htm
15020 6c 6c 6f 67 66 69 6c 65 29 29 29 0a 09 09 20 20 llogfile)))...
15030 20 20 28 6c 65 74 20 28 28 6d 73 67 20 28 61 72 (let ((msg (ar
15040 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 gs:get-arg "-m")
15050 29 29 0a 09 09 20 20 20 20 20 20 28 72 6d 74 3a ))... (rmt:
15060 74 65 73 74 73 74 65 70 2d 73 65 74 2d 73 74 61 teststep-set-sta
15070 74 75 73 21 20 72 75 6e 2d 69 64 20 74 65 73 74 tus! run-id test
15080 2d 69 64 20 73 74 65 70 6e 61 6d 65 20 22 65 6e -id stepname "en
15090 64 22 20 65 78 69 74 73 74 61 74 20 6d 73 67 20 d" exitstat msg
150a0 6c 6f 67 66 69 6c 65 29 29 0a 09 09 20 20 20 20 logfile))...
150b0 29 29 29 0a 09 20 20 28 69 66 20 28 6f 72 20 28 ))).. (if (or (
150c0 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 args:get-arg "-t
150d0 65 73 74 2d 73 74 61 74 75 73 22 29 0a 09 09 20 est-status")...
150e0 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
150f0 2d 73 65 74 2d 76 61 6c 75 65 73 22 29 29 0a 09 -set-values"))..
15100 20 20 20 20 20 20 28 6c 65 74 20 28 28 6e 65 77 (let ((new
15110 73 74 61 74 75 73 20 28 63 6f 6e 64 0a 09 09 09 status (cond....
15120 09 28 28 6e 75 6d 62 65 72 3f 20 73 74 61 74 75 .((number? statu
15130 73 29 20 20 20 20 20 20 20 28 69 66 20 28 65 71 s) (if (eq
15140 75 61 6c 3f 20 73 74 61 74 75 73 20 30 29 20 22 ual? status 0) "
15150 50 41 53 53 22 20 22 46 41 49 4c 22 29 29 0a 09 PASS" "FAIL"))..
15160 09 09 09 28 28 61 6e 64 20 28 73 74 72 69 6e 67 ...((and (string
15170 3f 20 73 74 61 74 75 73 29 0a 09 09 09 09 20 20 ? status).....
15180 20 20 20 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d (string->num
15190 62 65 72 20 73 74 61 74 75 73 29 29 28 69 66 20 ber status))(if
151a0 28 65 71 75 61 6c 3f 20 28 73 74 72 69 6e 67 2d (equal? (string-
151b0 3e 6e 75 6d 62 65 72 20 73 74 61 74 75 73 29 20 >number status)
151c0 30 29 20 22 50 41 53 53 22 20 22 46 41 49 4c 22 0) "PASS" "FAIL"
151d0 29 29 0a 09 09 09 09 28 65 6c 73 65 20 73 74 61 )).....(else sta
151e0 74 75 73 29 29 29 0a 09 09 20 20 20 20 3b 3b 20 tus)))... ;;
151f0 74 72 61 6e 73 66 65 72 20 72 65 6c 65 76 61 6e transfer relevan
15200 74 20 6b 65 79 73 20 69 6e 74 6f 20 61 20 68 61 t keys into a ha
15210 73 68 20 74 6f 20 62 65 20 70 61 73 73 65 64 20 sh to be passed
15220 74 6f 20 74 65 73 74 2d 73 65 74 2d 73 74 61 74 to test-set-stat
15230 75 73 21 0a 09 09 20 20 20 20 3b 3b 20 63 6f 75 us!... ;; cou
15240 6c 64 20 75 73 65 20 61 6e 20 61 73 73 6f 63 20 ld use an assoc
15250 6c 69 73 74 20 49 20 67 75 65 73 73 2e 20 0a 09 list I guess. ..
15260 09 20 20 20 20 28 6f 74 68 65 72 64 61 74 61 20 . (otherdata
15270 28 6c 65 74 20 28 28 72 65 73 20 28 6d 61 6b 65 (let ((res (make
15280 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 29 0a 09 -hash-table)))..
15290 09 09 09 20 28 66 6f 72 2d 65 61 63 68 20 28 6c ... (for-each (l
152a0 61 6d 62 64 61 20 28 6b 65 79 29 0a 09 09 09 09 ambda (key).....
152b0 09 20 20 20 20 20 28 69 66 20 28 61 72 67 73 3a . (if (args:
152c0 67 65 74 2d 61 72 67 20 6b 65 79 29 0a 09 09 09 get-arg key)....
152d0 09 09 09 20 28 68 61 73 68 2d 74 61 62 6c 65 2d ... (hash-table-
152e0 73 65 74 21 20 72 65 73 20 6b 65 79 20 28 61 72 set! res key (ar
152f0 67 73 3a 67 65 74 2d 61 72 67 20 6b 65 79 29 29 gs:get-arg key))
15300 29 29 0a 09 09 09 09 09 20 20 20 28 6c 69 73 74 ))...... (list
15310 20 22 3a 76 61 6c 75 65 22 20 22 3a 74 6f 6c 22 ":value" ":tol"
15320 20 22 3a 65 78 70 65 63 74 65 64 22 20 22 3a 66 ":expected" ":f
15330 69 72 73 74 5f 65 72 72 22 20 22 3a 66 69 72 73 irst_err" ":firs
15340 74 5f 77 61 72 6e 22 20 22 3a 75 6e 69 74 73 22 t_warn" ":units"
15350 20 22 3a 63 61 74 65 67 6f 72 79 22 20 22 3a 76 ":category" ":v
15360 61 72 69 61 62 6c 65 22 29 29 0a 09 09 09 09 20 ariable")).....
15370 72 65 73 29 29 29 0a 09 09 28 69 66 20 28 61 6e res)))...(if (an
15380 64 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 d (args:get-arg
15390 22 2d 74 65 73 74 2d 73 74 61 74 75 73 22 29 0a "-test-status").
153a0 09 09 09 20 28 6f 72 20 28 6e 6f 74 20 73 74 61 ... (or (not sta
153b0 74 65 29 0a 09 09 09 20 20 20 20 20 28 6e 6f 74 te).... (not
153c0 20 73 74 61 74 75 73 29 29 29 0a 09 09 20 20 20 status)))...
153d0 20 28 62 65 67 69 6e 0a 09 09 20 20 20 20 20 20 (begin...
153e0 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 (debug:print-err
153f0 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f or 0 *default-lo
15400 67 2d 70 6f 72 74 2a 20 22 59 6f 75 20 6d 75 73 g-port* "You mus
15410 74 20 73 70 65 63 69 66 79 20 3a 73 74 61 74 65 t specify :state
15420 20 61 6e 64 20 3a 73 74 61 74 75 73 20 77 69 74 and :status wit
15430 68 20 65 76 65 72 79 20 63 61 6c 6c 20 74 6f 20 h every call to
15440 2d 74 65 73 74 2d 73 74 61 74 75 73 5c 6e 22 20 -test-status\n"
15450 68 65 6c 70 29 0a 09 09 20 20 20 20 20 20 28 69 help)... (i
15460 66 20 28 73 71 6c 69 74 65 33 3a 64 61 74 61 62 f (sqlite3:datab
15470 61 73 65 3f 20 64 62 29 28 73 71 6c 69 74 65 33 ase? db)(sqlite3
15480 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 29 0a :finalize! db)).
15490 09 09 20 20 20 20 20 20 28 65 78 69 74 20 36 29 .. (exit 6)
154a0 29 29 0a 09 09 28 6c 65 74 2a 20 28 28 6d 73 67 ))...(let* ((msg
154b0 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
154c0 67 20 22 2d 6d 22 29 29 0a 09 09 20 20 20 20 20 g "-m"))...
154d0 20 20 28 6e 75 6d 6f 74 68 20 28 6c 65 6e 67 74 (numoth (lengt
154e0 68 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 h (hash-table-ke
154f0 79 73 20 6f 74 68 65 72 64 61 74 61 29 29 29 29 ys otherdata))))
15500 0a 09 09 20 20 3b 3b 20 43 6f 6e 76 65 72 74 20 ... ;; Convert
15510 74 6f 20 72 70 63 20 69 6e 73 69 64 65 20 74 68 to rpc inside th
15520 65 20 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 e tests:test-set
15530 2d 73 74 61 74 75 73 21 20 63 61 6c 6c 2c 20 6e -status! call, n
15540 6f 74 20 68 65 72 65 0a 09 09 20 20 28 74 65 73 ot here... (tes
15550 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 ts:test-set-stat
15560 75 73 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d us! run-id test-
15570 69 64 20 73 74 61 74 65 20 6e 65 77 73 74 61 74 id state newstat
15580 75 73 20 6d 73 67 20 6f 74 68 65 72 64 61 74 61 us msg otherdata
15590 20 77 6f 72 6b 2d 61 72 65 61 3a 20 77 6f 72 6b work-area: work
155a0 2d 61 72 65 61 29 29 29 29 0a 09 20 20 28 69 66 -area)))).. (if
155b0 20 28 73 71 6c 69 74 65 33 3a 64 61 74 61 62 61 (sqlite3:databa
155c0 73 65 3f 20 64 62 29 28 73 71 6c 69 74 65 33 3a se? db)(sqlite3:
155d0 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 29 0a 09 finalize! db))..
155e0 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
155f0 74 68 69 6e 67 2a 20 23 74 29 29 29 29 0a 0a 3b thing* #t))))..;
15600 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
15610 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15620 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15630 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15640 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 56 61 72 69 6f =======.;; Vario
15650 75 73 20 68 65 6c 70 65 72 20 63 6f 6d 6d 61 6e us helper comman
15660 64 73 20 63 61 6e 20 67 6f 20 62 65 6c 6f 77 20 ds can go below
15670 68 65 72 65 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d here.;;=========
15680 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15690 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
156a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
156b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 =============..(
156c0 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 if (or (args:get
156d0 2d 61 72 67 20 22 2d 73 68 6f 77 6b 65 79 73 22 -arg "-showkeys"
156e0 29 0a 20 20 20 20 20 20 20 20 28 61 72 67 73 3a ). (args:
156f0 67 65 74 2d 61 72 67 20 22 2d 73 68 6f 77 2d 6b get-arg "-show-k
15700 65 79 73 22 29 29 0a 20 20 20 20 28 6c 65 74 20 eys")). (let
15710 28 28 64 62 20 23 66 29 0a 09 20 20 28 6b 65 79 ((db #f).. (key
15720 73 20 23 66 29 29 0a 20 20 20 20 20 20 28 69 66 s #f)). (if
15730 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 (not (launch:se
15740 74 75 70 29 29 0a 09 20 20 28 62 65 67 69 6e 0a tup)).. (begin.
15750 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
15760 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 0 *default-log
15770 2d 70 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 74 -port* "Failed t
15780 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 o setup, exiting
15790 22 29 0a 09 20 20 20 20 28 65 78 69 74 20 31 29 ").. (exit 1)
157a0 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 6b )). (set! k
157b0 65 79 73 20 28 72 6d 74 3a 67 65 74 2d 6b 65 79 eys (rmt:get-key
157c0 73 29 29 20 3b 3b 20 20 64 62 29 29 0a 20 20 20 s)) ;; db)).
157d0 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
157e0 31 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 1 *default-log-p
157f0 6f 72 74 2a 20 22 4b 65 79 73 3a 20 22 20 28 73 ort* "Keys: " (s
15800 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
15810 65 20 6b 65 79 73 20 22 2c 20 22 29 29 0a 20 20 e keys ", ")).
15820 20 20 20 20 28 69 66 20 28 73 71 6c 69 74 65 33 (if (sqlite3
15830 3a 64 61 74 61 62 61 73 65 3f 20 64 62 29 28 73 :database? db)(s
15840 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
15850 20 64 62 29 29 0a 20 20 20 20 20 20 28 73 65 74 db)). (set
15860 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a ! *didsomething*
15870 20 23 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 #t)))..(if (arg
15880 73 3a 67 65 74 2d 61 72 67 20 22 2d 67 75 69 22 s:get-arg "-gui"
15890 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 ). (begin.
158a0 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
158b0 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
158c0 6f 72 74 2a 20 22 4c 6f 6f 6b 20 61 74 20 74 68 ort* "Look at th
158d0 65 20 64 61 73 68 62 6f 61 72 64 20 66 6f 72 20 e dashboard for
158e0 6e 6f 77 22 29 0a 20 20 20 20 20 20 3b 3b 20 28 now"). ;; (
158f0 6d 65 67 61 74 65 73 74 2d 67 75 69 29 0a 20 20 megatest-gui).
15900 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
15910 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a mething* #t)))..
15920 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
15930 67 20 22 2d 63 72 65 61 74 65 2d 6d 65 67 61 74 g "-create-megat
15940 65 73 74 2d 61 72 65 61 22 29 0a 20 20 20 20 28 est-area"). (
15950 62 65 67 69 6e 0a 20 20 20 20 20 20 28 67 65 6e begin. (gen
15960 65 78 61 6d 70 6c 65 3a 6d 6b 2d 6d 65 67 61 74 example:mk-megat
15970 65 73 74 2e 63 6f 6e 66 69 67 29 0a 20 20 20 20 est.config).
15980 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
15990 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 thing* #t)))..(i
159a0 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
159b0 22 2d 63 72 65 61 74 65 2d 74 65 73 74 22 29 0a "-create-test").
159c0 20 20 20 20 28 6c 65 74 20 28 28 74 65 73 74 6e (let ((testn
159d0 61 6d 65 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ame (args:get-ar
159e0 67 20 22 2d 63 72 65 61 74 65 2d 74 65 73 74 22 g "-create-test"
159f0 29 29 29 0a 20 20 20 20 20 20 28 67 65 6e 65 78 ))). (genex
15a00 61 6d 70 6c 65 3a 6d 6b 2d 6d 65 67 61 74 65 73 ample:mk-megates
15a10 74 2d 74 65 73 74 20 74 65 73 74 6e 61 6d 65 29 t-test testname)
15a20 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 . (set! *di
15a30 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 dsomething* #t))
15a40 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
15a50 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15a60 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15a70 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15a80 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 55 ===========.;; U
15a90 70 64 61 74 65 20 74 68 65 20 64 61 74 61 62 61 pdate the databa
15aa0 73 65 20 73 63 68 65 6d 61 2c 20 63 6c 65 61 6e se schema, clean
15ab0 20 75 70 20 74 68 65 20 64 62 0a 3b 3b 3d 3d 3d up the db.;;===
15ac0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15ad0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15ae0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15af0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15b00 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 ===..(if (args:g
15b10 65 74 2d 61 72 67 20 22 2d 72 65 62 75 69 6c 64 et-arg "-rebuild
15b20 2d 64 62 22 29 0a 20 20 20 20 28 62 65 67 69 6e -db"). (begin
15b30 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 . (if (not
15b40 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 0a (launch:setup)).
15b50 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 28 . (begin.. (
15b60 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
15b70 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
15b80 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 "Failed to setu
15b90 70 2c 20 65 78 69 74 69 6e 67 22 29 20 0a 09 20 p, exiting") ..
15ba0 20 20 20 28 65 78 69 74 20 31 29 29 29 0a 20 20 (exit 1))).
15bb0 20 20 20 20 3b 3b 20 6b 65 65 70 20 74 68 69 73 ;; keep this
15bc0 20 6f 6e 65 20 6c 6f 63 61 6c 0a 20 20 20 20 20 one local.
15bd0 20 3b 3b 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c ;; (open-run-cl
15be0 6f 73 65 20 70 61 74 63 68 2d 64 62 20 23 66 29 ose patch-db #f)
15bf0 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 64 62 . (let ((db
15c00 73 74 72 75 63 74 20 28 64 62 3a 73 65 74 75 70 struct (db:setup
15c10 20 23 66 20 61 72 65 61 70 61 74 68 3a 20 2a 74 #f areapath: *t
15c20 6f 70 70 61 74 68 2a 29 29 29 0a 20 20 20 20 20 oppath*))).
15c30 20 20 20 28 63 6f 6d 6d 6f 6e 3a 63 6c 65 61 6e (common:clean
15c40 75 70 2d 64 62 20 64 62 73 74 72 75 63 74 20 66 up-db dbstruct f
15c50 75 6c 6c 3a 20 23 74 29 29 0a 20 20 20 20 20 20 ull: #t)).
15c60 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
15c70 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 ing* #t)))..(if
15c80 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
15c90 63 6c 65 61 6e 75 70 2d 64 62 22 29 0a 20 20 20 cleanup-db").
15ca0 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 69 (begin. (i
15cb0 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 f (not (launch:s
15cc0 65 74 75 70 29 29 0a 09 20 20 28 62 65 67 69 6e etup)).. (begin
15cd0 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 .. (debug:pri
15ce0 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
15cf0 67 2d 70 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 g-port* "Failed
15d00 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e to setup, exitin
15d10 67 22 29 20 0a 09 20 20 20 20 28 65 78 69 74 20 g") .. (exit
15d20 31 29 29 29 0a 20 20 20 20 20 20 28 6c 65 74 20 1))). (let
15d30 28 28 64 62 73 74 72 75 63 74 20 28 64 62 3a 73 ((dbstruct (db:s
15d40 65 74 75 70 20 23 66 20 61 72 65 61 70 61 74 68 etup #f areapath
15d50 3a 20 2a 74 6f 70 70 61 74 68 2a 29 29 29 0a 20 : *toppath*))).
15d60 20 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 63 (common:c
15d70 6c 65 61 6e 75 70 2d 64 62 20 64 62 73 74 72 75 leanup-db dbstru
15d80 63 74 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 ct)). (set!
15d90 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 *didsomething*
15da0 23 74 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 #t)))..(if (args
15db0 3a 67 65 74 2d 61 72 67 20 22 2d 6d 61 72 6b 2d :get-arg "-mark-
15dc0 69 6e 63 6f 6d 70 6c 65 74 65 73 22 29 0a 20 20 incompletes").
15dd0 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 (begin. (
15de0 69 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a if (not (launch:
15df0 73 65 74 75 70 29 29 0a 09 20 20 28 62 65 67 69 setup)).. (begi
15e00 6e 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 n.. (debug:pr
15e10 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c int 0 *default-l
15e20 6f 67 2d 70 6f 72 74 2a 20 22 46 61 69 6c 65 64 og-port* "Failed
15e30 20 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 to setup, exiti
15e40 6e 67 22 29 0a 09 20 20 20 20 28 65 78 69 74 20 ng").. (exit
15e50 31 29 29 29 0a 20 20 20 20 20 20 28 6f 70 65 6e 1))). (open
15e60 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 62 3a 66 69 -run-close db:fi
15e70 6e 64 2d 61 6e 64 2d 6d 61 72 6b 2d 69 6e 63 6f nd-and-mark-inco
15e80 6d 70 6c 65 74 65 20 23 66 29 0a 20 20 20 20 20 mplete #f).
15e90 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 (set! *didsomet
15ea0 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d hing* #t)))..;;=
15eb0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15ec0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15ed0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15ee0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15ef0 3d 3d 3d 3d 3d 0a 3b 3b 20 55 70 64 61 74 65 20 =====.;; Update
15f00 74 68 65 20 74 65 73 74 73 20 6d 65 74 61 20 64 the tests meta d
15f10 61 74 61 20 66 72 6f 6d 20 74 68 65 20 74 65 73 ata from the tes
15f20 74 63 6f 6e 66 69 67 20 66 69 6c 65 73 0a 3b 3b tconfig files.;;
15f30 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15f40 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15f50 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15f60 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15f70 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 61 72 67 ======..(if (arg
15f80 73 3a 67 65 74 2d 61 72 67 20 22 2d 75 70 64 61 s:get-arg "-upda
15f90 74 65 2d 6d 65 74 61 22 29 0a 20 20 20 20 28 62 te-meta"). (b
15fa0 65 67 69 6e 0a 20 20 20 20 20 20 28 69 66 20 28 egin. (if (
15fb0 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 not (launch:setu
15fc0 70 29 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 p)).. (begin..
15fd0 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
15fe0 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
15ff0 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 74 6f 20 ort* "Failed to
16000 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 29 setup, exiting")
16010 20 0a 09 20 20 20 20 28 65 78 69 74 20 31 29 29 .. (exit 1))
16020 29 0a 20 20 20 20 20 20 28 72 75 6e 73 3a 75 70 ). (runs:up
16030 64 61 74 65 2d 61 6c 6c 2d 74 65 73 74 5f 6d 65 date-all-test_me
16040 74 61 20 23 66 29 0a 20 20 20 20 20 20 28 73 65 ta #f). (se
16050 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 t! *didsomething
16060 2a 20 23 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d * #t)))..;;=====
16070 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
16080 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
16090 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
160a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
160b0 3d 0a 3b 3b 20 53 74 61 72 74 20 61 20 72 65 70 =.;; Start a rep
160c0 6c 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d l.;;============
160d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
160e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
160f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
16100 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 66 ==========..;; f
16110 61 6b 65 6f 75 74 20 72 65 61 64 6c 69 6e 65 0a akeout readline.
16120 28 69 6e 63 6c 75 64 65 20 22 72 65 61 64 6c 69 (include "readli
16130 6e 65 2d 66 69 78 2e 73 63 6d 22 29 0a 0a 0a 28 ne-fix.scm")...(
16140 77 68 65 6e 20 28 61 72 67 73 3a 67 65 74 2d 61 when (args:get-a
16150 72 67 20 22 2d 64 69 66 66 2d 72 65 70 22 29 0a rg "-diff-rep").
16160 20 20 28 77 68 65 6e 20 28 61 6e 64 0a 20 20 20 (when (and.
16170 20 20 20 20 20 20 28 6e 6f 74 20 28 61 72 67 73 (not (args
16180 3a 67 65 74 2d 61 72 67 20 22 2d 64 69 66 66 2d :get-arg "-diff-
16190 68 74 6d 6c 22 29 29 0a 20 20 20 20 20 20 20 20 html")).
161a0 20 28 6e 6f 74 20 28 61 72 67 73 3a 67 65 74 2d (not (args:get-
161b0 61 72 67 20 22 2d 64 69 66 66 2d 65 6d 61 69 6c arg "-diff-email
161c0 22 29 29 29 0a 20 20 20 20 28 64 65 62 75 67 3a "))). (debug:
161d0 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
161e0 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4d 75 73 74 -log-port* "Must
161f0 20 73 70 65 63 69 66 79 20 2d 64 69 66 66 2d 68 specify -diff-h
16200 74 6d 6c 20 6f 72 20 2d 64 69 66 66 2d 65 6d 61 tml or -diff-ema
16210 69 6c 20 77 69 74 68 20 2d 64 69 66 66 2d 72 65 il with -diff-re
16220 70 22 29 0a 20 20 20 20 28 73 65 74 21 20 2a 64 p"). (set! *d
16230 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 31 29 0a idsomething* 1).
16240 20 20 20 20 28 65 78 69 74 20 31 29 29 0a 20 20 (exit 1)).
16250 0a 20 20 28 6c 65 74 2a 20 28 28 74 6f 70 70 61 . (let* ((toppa
16260 74 68 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 th (launch:setup
16270 29 29 29 0a 20 20 20 20 28 64 6f 2d 64 69 66 66 ))). (do-diff
16280 2d 72 65 70 6f 72 74 0a 20 20 20 20 20 28 61 72 -report. (ar
16290 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 72 63 gs:get-arg "-src
162a0 2d 74 61 72 67 65 74 22 29 0a 20 20 20 20 20 28 -target"). (
162b0 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
162c0 72 63 2d 72 75 6e 6e 61 6d 65 22 29 0a 20 20 20 rc-runname").
162d0 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
162e0 22 2d 74 61 72 67 65 74 22 29 0a 20 20 20 20 20 "-target").
162f0 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
16300 72 75 6e 6e 61 6d 65 22 29 0a 20 20 20 20 20 28 runname"). (
16310 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 args:get-arg "-d
16320 69 66 66 2d 68 74 6d 6c 22 29 0a 20 20 20 20 20 iff-html").
16330 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
16340 64 69 66 66 2d 65 6d 61 69 6c 22 29 29 0a 20 20 diff-email")).
16350 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
16360 74 68 69 6e 67 2a 20 23 74 29 0a 20 20 20 20 28 thing* #t). (
16370 65 78 69 74 20 30 29 29 29 0a 0a 28 69 66 20 28 exit 0)))..(if (
16380 6f 72 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 52 or (getenv "MT_R
16390 55 4e 53 43 52 49 50 54 22 29 0a 09 28 61 72 67 UNSCRIPT")..(arg
163a0 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 70 6c s:get-arg "-repl
163b0 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d 61 72 ")..(args:get-ar
163c0 67 20 22 2d 6c 6f 61 64 22 29 29 0a 20 20 20 20 g "-load")).
163d0 28 6c 65 74 2a 20 28 28 74 6f 70 70 61 74 68 20 (let* ((toppath
163e0 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 29 0a (launch:setup)).
163f0 09 20 20 20 28 64 62 73 74 72 75 63 74 20 28 69 . (dbstruct (i
16400 66 20 28 61 6e 64 20 74 6f 70 70 61 74 68 0a 20 f (and toppath.
16410 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16420 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
16430 6d 6d 6f 6e 3a 6f 6e 2d 68 6f 6d 65 68 6f 73 74 mmon:on-homehost
16440 3f 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ?)).
16450 20 20 20 20 20 20 20 20 20 20 20 20 20 28 64 62 (db
16460 3a 73 65 74 75 70 20 23 74 29 0a 20 20 20 20 20 :setup #t).
16470 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16480 20 20 20 20 23 66 29 29 29 20 3b 3b 20 6d 61 6b #f))) ;; mak
16490 65 2d 64 62 72 3a 64 62 73 74 72 75 63 74 20 70 e-dbr:dbstruct p
164a0 61 74 68 3a 20 74 6f 70 70 61 74 68 20 6c 6f 63 ath: toppath loc
164b0 61 6c 3a 20 28 61 72 67 73 3a 67 65 74 2d 61 72 al: (args:get-ar
164c0 67 20 22 2d 6c 6f 63 61 6c 22 29 29 20 23 66 29 g "-local")) #f)
164d0 29 29 0a 20 20 20 20 20 20 28 69 66 20 2a 74 6f )). (if *to
164e0 70 70 61 74 68 2a 0a 09 20 20 28 63 6f 6e 64 0a ppath*.. (cond.
164f0 09 20 20 20 28 28 67 65 74 65 6e 76 20 22 4d 54 . ((getenv "MT
16500 5f 52 55 4e 53 43 52 49 50 54 22 29 0a 09 20 20 _RUNSCRIPT")..
16510 20 20 3b 3b 20 48 6f 77 20 74 6f 20 72 75 6e 20 ;; How to run
16520 6d 65 67 61 74 65 73 74 20 73 63 72 69 70 74 73 megatest scripts
16530 0a 09 20 20 20 20 3b 3b 0a 09 20 20 20 20 3b 3b .. ;;.. ;;
16540 20 23 21 2f 62 69 6e 2f 62 61 73 68 0a 09 20 20 #!/bin/bash..
16550 20 20 3b 3b 0a 09 20 20 20 20 3b 3b 20 65 78 70 ;;.. ;; exp
16560 6f 72 74 20 4d 54 5f 52 55 4e 53 43 52 49 50 54 ort MT_RUNSCRIPT
16570 3d 79 65 73 0a 09 20 20 20 20 3b 3b 20 6d 65 67 =yes.. ;; meg
16580 61 74 65 73 74 20 3c 3c 20 45 4f 46 0a 09 20 20 atest << EOF..
16590 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 48 65 6c ;; (print "Hel
165a0 6c 6f 20 77 6f 72 6c 64 22 29 0a 09 20 20 20 20 lo world")..
165b0 3b 3b 20 28 65 78 69 74 29 0a 09 20 20 20 20 3b ;; (exit).. ;
165c0 3b 20 45 4f 46 0a 0a 09 20 20 20 20 28 72 65 70 ; EOF... (rep
165d0 6c 29 29 0a 09 20 20 20 28 65 6c 73 65 0a 09 20 l)).. (else..
165e0 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 (begin..
165f0 20 28 73 65 74 21 20 2a 64 62 2a 20 64 62 73 74 (set! *db* dbst
16600 72 75 63 74 29 0a 09 20 20 20 20 20 20 28 69 6d ruct).. (im
16610 70 6f 72 74 20 65 78 74 72 61 73 29 20 3b 3b 20 port extras) ;;
16620 6d 69 67 68 74 20 6e 6f 74 20 62 65 20 6e 65 65 might not be nee
16630 64 65 64 0a 09 20 20 20 20 20 20 3b 3b 20 28 69 ded.. ;; (i
16640 6d 70 6f 72 74 20 63 73 69 29 0a 09 20 20 20 20 mport csi)..
16650 20 20 28 69 6d 70 6f 72 74 20 72 65 61 64 6c 69 (import readli
16660 6e 65 29 0a 09 20 20 20 20 20 20 28 69 6d 70 6f ne).. (impo
16670 72 74 20 61 70 72 6f 70 6f 73 29 0a 09 20 20 20 rt apropos)..
16680 20 20 20 3b 3b 20 28 69 6d 70 6f 72 74 20 28 70 ;; (import (p
16690 72 65 66 69 78 20 73 71 6c 69 74 65 33 20 73 71 refix sqlite3 sq
166a0 6c 69 74 65 33 3a 29 29 20 3b 3b 20 64 6f 65 73 lite3:)) ;; does
166b0 6e 27 74 20 77 6f 72 6b 20 2e 2e 2e 0a 0a 09 20 n't work ......
166c0 20 20 20 20 20 28 69 66 20 2a 75 73 65 2d 6e 65 (if *use-ne
166d0 77 2d 72 65 61 64 6c 69 6e 65 2a 0a 09 09 20 20 w-readline*...
166e0 28 62 65 67 69 6e 0a 09 09 20 20 20 20 28 69 6e (begin... (in
166f0 73 74 61 6c 6c 2d 68 69 73 74 6f 72 79 2d 66 69 stall-history-fi
16700 6c 65 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d le (get-environm
16710 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 48 4f ent-variable "HO
16720 4d 45 22 29 20 22 2e 6d 65 67 61 74 65 73 74 5f ME") ".megatest_
16730 68 69 73 74 6f 72 79 22 29 20 3b 3b 20 20 5b 68 history") ;; [h
16740 6f 6d 65 64 69 72 5d 20 5b 66 69 6c 65 6e 61 6d omedir] [filenam
16750 65 5d 20 5b 6e 6c 69 6e 65 73 5d 29 0a 09 09 20 e] [nlines])...
16760 20 20 20 28 63 75 72 72 65 6e 74 2d 69 6e 70 75 (current-inpu
16770 74 2d 70 6f 72 74 20 28 6d 61 6b 65 2d 72 65 61 t-port (make-rea
16780 64 6c 69 6e 65 2d 70 6f 72 74 20 22 6d 65 67 61 dline-port "mega
16790 74 65 73 74 3e 20 22 29 29 29 0a 09 09 20 20 28 test> ")))... (
167a0 62 65 67 69 6e 0a 09 09 20 20 20 20 28 67 6e 75 begin... (gnu
167b0 2d 68 69 73 74 6f 72 79 2d 69 6e 73 74 61 6c 6c -history-install
167c0 2d 66 69 6c 65 2d 6d 61 6e 61 67 65 72 0a 09 09 -file-manager...
167d0 20 20 20 20 20 28 73 74 72 69 6e 67 2d 61 70 70 (string-app
167e0 65 6e 64 0a 09 09 20 20 20 20 20 20 28 6f 72 20 end... (or
167f0 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 (get-environment
16800 2d 76 61 72 69 61 62 6c 65 20 22 48 4f 4d 45 22 -variable "HOME"
16810 29 20 22 2e 22 29 20 22 2f 2e 6d 65 67 61 74 65 ) ".") "/.megate
16820 73 74 5f 68 69 73 74 6f 72 79 22 29 29 0a 09 09 st_history"))...
16830 20 20 20 20 28 63 75 72 72 65 6e 74 2d 69 6e 70 (current-inp
16840 75 74 2d 70 6f 72 74 20 28 6d 61 6b 65 2d 67 6e ut-port (make-gn
16850 75 2d 72 65 61 64 6c 69 6e 65 2d 70 6f 72 74 20 u-readline-port
16860 22 6d 65 67 61 74 65 73 74 3e 20 22 29 29 29 29 "megatest> "))))
16870 0a 09 20 20 20 20 20 20 28 69 66 20 28 61 72 67 .. (if (arg
16880 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 70 6c s:get-arg "-repl
16890 22 29 0a 09 09 20 20 28 72 65 70 6c 29 0a 09 09 ")... (repl)...
168a0 20 20 28 6c 6f 61 64 20 28 61 72 67 73 3a 67 65 (load (args:ge
168b0 74 2d 61 72 67 20 22 2d 6c 6f 61 64 22 29 29 29 t-arg "-load")))
168c0 0a 09 20 20 20 20 20 20 3b 3b 20 28 64 62 3a 63 .. ;; (db:c
168d0 6c 6f 73 65 2d 61 6c 6c 20 64 62 73 74 72 75 63 lose-all dbstruc
168e0 74 29 20 3c 3d 20 74 61 6b 65 6e 20 63 61 72 65 t) <= taken care
168f0 20 6f 66 20 62 79 20 6f 6e 2d 65 78 69 74 20 63 of by on-exit c
16900 61 6c 6c 0a 09 20 20 20 20 20 20 29 0a 09 20 20 all.. )..
16910 20 20 28 65 78 69 74 29 29 29 0a 09 20 20 28 73 (exit))).. (s
16920 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e et! *didsomethin
16930 67 2a 20 23 74 29 29 29 29 0a 0a 3b 3b 3d 3d 3d g* #t))))..;;===
16940 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
16950 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
16960 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
16970 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
16980 3d 3d 3d 0a 3b 3b 20 57 61 69 74 20 6f 6e 20 61 ===.;; Wait on a
16990 20 72 75 6e 20 74 6f 20 63 6f 6d 70 6c 65 74 65 run to complete
169a0 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
169b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
169c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
169d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
169e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 =========..(if (
169f0 61 6e 64 20 28 61 72 67 73 3a 67 65 74 2d 61 72 and (args:get-ar
16a00 67 20 22 2d 72 75 6e 2d 77 61 69 74 22 29 0a 09 g "-run-wait")..
16a10 20 28 6e 6f 74 20 28 6f 72 20 28 61 72 67 73 3a (not (or (args:
16a20 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 22 29 0a get-arg "-run").
16a30 09 09 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 .. (args:get-ar
16a40 67 20 22 2d 72 75 6e 74 65 73 74 73 22 29 29 29 g "-runtests")))
16a50 29 20 3b 3b 20 72 75 6e 2d 77 61 69 74 20 69 73 ) ;; run-wait is
16a60 20 62 75 69 6c 74 20 69 6e 74 6f 20 72 75 6e 74 built into runt
16a70 65 73 74 73 20 6e 6f 77 0a 20 20 20 20 28 62 65 ests now. (be
16a80 67 69 6e 0a 20 20 20 20 20 20 28 69 66 20 28 6e gin. (if (n
16a90 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 ot (launch:setup
16aa0 29 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 )).. (begin..
16ab0 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
16ac0 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
16ad0 72 74 2a 20 22 46 61 69 6c 65 64 20 74 6f 20 73 rt* "Failed to s
16ae0 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 29 20 etup, exiting")
16af0 0a 09 20 20 20 20 28 65 78 69 74 20 31 29 29 29 .. (exit 1)))
16b00 0a 20 20 20 20 20 20 28 6f 70 65 72 61 74 65 2d . (operate-
16b10 6f 6e 20 27 72 75 6e 2d 77 61 69 74 29 0a 20 20 on 'run-wait).
16b20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f (set! *didso
16b30 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a mething* #t)))..
16b40 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 ;; ;; ;; redo me
16b50 20 3b 3b 20 4e 6f 74 20 63 6f 6e 76 65 72 74 65 ;; Not converte
16b60 64 20 74 6f 20 75 73 65 20 64 62 73 74 72 75 63 d to use dbstruc
16b70 74 20 79 65 74 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 t yet.;; ;; ;; r
16b80 65 64 6f 20 6d 65 20 3b 3b 0a 3b 3b 20 3b 3b 20 edo me ;;.;; ;;
16b90 3b 3b 20 72 65 64 6f 20 6d 65 20 28 69 66 20 28 ;; redo me (if (
16ba0 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 args:get-arg "-c
16bb0 6f 6e 76 65 72 74 2d 74 6f 2d 6e 6f 72 6d 22 29 onvert-to-norm")
16bc0 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d .;; ;; ;; redo m
16bd0 65 20 20 20 20 20 28 6c 65 74 2a 20 28 28 74 6f e (let* ((to
16be0 70 70 61 74 68 20 28 73 65 74 75 70 2d 66 6f 72 ppath (setup-for
16bf0 2d 72 75 6e 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 -run)).;; ;; ;;
16c00 72 65 64 6f 20 6d 65 20 09 20 20 20 28 64 62 73 redo me . (dbs
16c10 74 72 75 63 74 20 28 69 66 20 74 6f 70 70 61 74 truct (if toppat
16c20 68 20 28 6d 61 6b 65 2d 64 62 72 3a 64 62 73 74 h (make-dbr:dbst
16c30 72 75 63 74 20 70 61 74 68 3a 20 74 6f 70 70 61 ruct path: toppa
16c40 74 68 20 6c 6f 63 61 6c 3a 20 23 74 29 29 29 29 th local: #t))))
16c50 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d .;; ;; ;; redo m
16c60 65 20 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 e (for-eac
16c70 68 20 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f h .;; ;; ;; redo
16c80 20 6d 65 20 20 20 20 20 20 20 20 28 6c 61 6d 62 me (lamb
16c90 64 61 20 28 66 69 65 6c 64 29 0a 3b 3b 20 3b 3b da (field).;; ;;
16ca0 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 28 6c ;; redo me . (l
16cb0 65 74 20 28 28 64 61 74 20 27 28 29 29 29 0a 3b et ((dat '())).;
16cc0 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 ; ;; ;; redo me
16cd0 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 . (debug:print
16ce0 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 -info 0 *default
16cf0 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 47 65 74 74 -log-port* "Gett
16d00 69 6e 67 20 64 61 74 61 20 66 6f 72 20 66 69 65 ing data for fie
16d10 6c 64 20 22 20 66 69 65 6c 64 29 0a 3b 3b 20 3b ld " field).;; ;
16d20 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 20 ; ;; redo me .
16d30 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 (sqlite3:for-ea
16d40 63 68 2d 72 6f 77 0a 3b 3b 20 3b 3b 20 3b 3b 20 ch-row.;; ;; ;;
16d50 72 65 64 6f 20 6d 65 20 09 20 20 20 20 28 6c 61 redo me . (la
16d60 6d 62 64 61 20 28 69 64 20 76 61 6c 29 0a 3b 3b mbda (id val).;;
16d70 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 ;; ;; redo me .
16d80 20 20 20 20 20 20 28 73 65 74 21 20 64 61 74 20 (set! dat
16d90 28 63 6f 6e 73 20 28 6c 69 73 74 20 69 64 20 76 (cons (list id v
16da0 61 6c 29 20 64 61 74 29 29 29 0a 3b 3b 20 3b 3b al) dat))).;; ;;
16db0 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 20 20 ;; redo me .
16dc0 20 28 64 62 3a 67 65 74 2d 64 62 20 64 62 20 72 (db:get-db db r
16dd0 75 6e 2d 69 64 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 un-id).;; ;; ;;
16de0 72 65 64 6f 20 6d 65 20 09 20 20 20 20 28 63 6f redo me . (co
16df0 6e 63 20 22 53 45 4c 45 43 54 20 69 64 2c 22 20 nc "SELECT id,"
16e00 66 69 65 6c 64 20 22 20 46 52 4f 4d 20 74 65 73 field " FROM tes
16e10 74 73 3b 22 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 ts;")).;; ;; ;;
16e20 72 65 64 6f 20 6d 65 20 09 20 20 20 28 64 65 62 redo me . (deb
16e30 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 ug:print-info 0
16e40 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
16e50 74 2a 20 22 66 6f 75 6e 64 20 22 20 28 6c 65 6e t* "found " (len
16e60 67 74 68 20 64 61 74 29 20 22 20 69 74 65 6d 73 gth dat) " items
16e70 20 66 6f 72 20 66 69 65 6c 64 20 22 20 66 69 65 for field " fie
16e80 6c 64 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 ld).;; ;; ;; red
16e90 6f 20 6d 65 20 09 20 20 20 28 6c 65 74 20 28 28 o me . (let ((
16ea0 71 72 79 20 28 73 71 6c 69 74 65 33 3a 70 72 65 qry (sqlite3:pre
16eb0 70 61 72 65 20 64 62 20 28 63 6f 6e 63 20 22 55 pare db (conc "U
16ec0 50 44 41 54 45 20 74 65 73 74 73 20 53 45 54 20 PDATE tests SET
16ed0 22 20 66 69 65 6c 64 20 22 3d 3f 20 57 48 45 52 " field "=? WHER
16ee0 45 20 69 64 3d 3f 3b 22 29 29 29 29 0a 3b 3b 20 E id=?;")))).;;
16ef0 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 20 ;; ;; redo me .
16f00 20 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 3b 3b (for-each.;;
16f10 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d 65 20 09 ;; ;; redo me .
16f20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 69 (lambda (i
16f30 74 65 6d 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 tem).;; ;; ;; re
16f40 64 6f 20 6d 65 20 09 09 28 6c 65 74 20 28 28 6e do me ..(let ((n
16f50 65 77 76 61 6c 20 3b 3b 20 28 73 64 62 3a 71 72 ewval ;; (sdb:qr
16f60 79 20 27 67 65 74 69 64 20 0a 3b 3b 20 3b 3b 20 y 'getid .;; ;;
16f70 3b 3b 20 72 65 64 6f 20 6d 65 20 09 09 20 20 20 ;; redo me ..
16f80 20 20 20 20 28 63 61 64 72 20 69 74 65 6d 29 29 (cadr item))
16f90 29 20 3b 3b 20 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 ) ;; ).;; ;; ;;
16fa0 72 65 64 6f 20 6d 65 20 09 09 20 20 28 69 66 20 redo me .. (if
16fb0 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 6e 65 77 (not (equal? new
16fc0 76 61 6c 20 28 63 61 64 72 20 69 74 65 6d 29 29 val (cadr item))
16fd0 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 ).;; ;; ;; redo
16fe0 6d 65 20 09 09 20 20 20 20 20 20 28 64 65 62 75 me .. (debu
16ff0 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a g:print-info 0 *
17000 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
17010 2a 20 22 43 6f 6e 76 65 72 74 69 6e 67 20 22 20 * "Converting "
17020 28 63 61 64 72 20 69 74 65 6d 29 20 22 20 74 6f (cadr item) " to
17030 20 22 20 6e 65 77 76 61 6c 20 22 20 66 6f 72 20 " newval " for
17040 74 65 73 74 20 23 22 20 28 63 61 72 20 69 74 65 test #" (car ite
17050 6d 29 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 m))).;; ;; ;; re
17060 64 6f 20 6d 65 20 09 09 20 20 28 73 71 6c 69 74 do me .. (sqlit
17070 65 33 3a 65 78 65 63 75 74 65 20 71 72 79 20 6e e3:execute qry n
17080 65 77 76 61 6c 20 28 63 61 72 20 69 74 65 6d 29 ewval (car item)
17090 29 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 ))).;; ;; ;; red
170a0 6f 20 6d 65 20 09 20 20 20 20 20 20 64 61 74 29 o me . dat)
170b0 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f 20 6d .;; ;; ;; redo m
170c0 65 20 09 20 20 20 20 20 28 73 71 6c 69 74 65 33 e . (sqlite3
170d0 3a 66 69 6e 61 6c 69 7a 65 21 20 71 72 79 29 29 :finalize! qry))
170e0 29 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f )).;; ;; ;; redo
170f0 20 6d 65 20 20 20 20 20 20 20 20 28 64 62 3a 63 me (db:c
17100 6c 6f 73 65 2d 61 6c 6c 20 64 62 73 74 72 75 63 lose-all dbstruc
17110 74 29 0a 3b 3b 20 3b 3b 20 3b 3b 20 72 65 64 6f t).;; ;; ;; redo
17120 20 6d 65 20 20 20 20 20 20 20 20 28 6c 69 73 74 me (list
17130 20 22 75 6e 61 6d 65 22 20 22 72 75 6e 64 69 72 "uname" "rundir
17140 22 20 22 66 69 6e 61 6c 5f 6c 6f 67 66 22 20 22 " "final_logf" "
17150 63 6f 6d 6d 65 6e 74 22 29 29 0a 3b 3b 20 3b 3b comment")).;; ;;
17160 20 3b 3b 20 72 65 64 6f 20 6d 65 20 20 20 20 20 ;; redo me
17170 20 20 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 (set! *didsome
17180 74 68 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 thing* #t)))..(i
17190 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
171a0 22 2d 69 6d 70 6f 72 74 2d 6d 65 67 61 74 65 73 "-import-megates
171b0 74 2e 64 62 22 29 0a 20 20 20 20 28 62 65 67 69 t.db"). (begi
171c0 6e 0a 20 20 20 20 20 20 28 64 62 3a 6d 75 6c 74 n. (db:mult
171d0 69 2d 64 62 2d 73 79 6e 63 20 0a 20 20 20 20 20 i-db-sync .
171e0 20 20 28 64 62 3a 73 65 74 75 70 20 23 66 29 0a (db:setup #f).
171f0 20 20 20 20 20 20 20 27 6b 69 6c 6c 73 65 72 76 'killserv
17200 65 72 73 0a 20 20 20 20 20 20 20 27 64 65 6a 75 ers. 'deju
17210 6e 6b 0a 20 20 20 20 20 20 20 27 61 64 6a 2d 74 nk. 'adj-t
17220 65 73 74 69 64 73 0a 20 20 20 20 20 20 20 27 6f estids. 'o
17230 6c 64 32 6e 65 77 0a 20 20 20 20 20 20 20 3b 3b ld2new. ;;
17240 20 27 6e 65 77 32 6f 6c 64 0a 20 20 20 20 20 20 'new2old.
17250 20 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a ). (set! *
17260 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 didsomething* #t
17270 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 )))..(if (args:g
17280 65 74 2d 61 72 67 20 22 2d 73 79 6e 63 2d 74 6f et-arg "-sync-to
17290 2d 6d 65 67 61 74 65 73 74 2e 64 62 22 29 0a 20 -megatest.db").
172a0 20 20 20 28 6c 65 74 20 28 28 72 65 73 20 28 64 (let ((res (d
172b0 62 3a 6d 75 6c 74 69 2d 64 62 2d 73 79 6e 63 20 b:multi-db-sync
172c0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
172d0 20 28 64 62 3a 73 65 74 75 70 20 23 66 29 0a 20 (db:setup #f).
172e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 27 '
172f0 6e 65 77 32 6f 6c 64 29 29 29 0a 20 20 20 20 20 new2old))).
17300 20 28 70 72 69 6e 74 20 22 53 79 6e 63 65 64 20 (print "Synced
17310 22 20 72 65 73 20 22 20 72 65 63 6f 72 64 73 20 " res " records
17320 74 6f 20 6d 65 67 61 74 65 73 74 2e 64 62 22 29 to megatest.db")
17330 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 . (set! *di
17340 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 dsomething* #t))
17350 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 65 74 )..(if (args:get
17360 2d 61 72 67 20 22 2d 73 79 6e 63 2d 74 6f 22 29 -arg "-sync-to")
17370 0a 20 20 20 20 28 6c 65 74 20 28 28 74 6f 70 70 . (let ((topp
17380 61 74 68 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 ath (launch:setu
17390 70 29 29 29 0a 20 20 20 20 20 20 28 74 61 73 6b p))). (task
173a0 73 3a 73 79 6e 63 2d 74 6f 2d 70 6f 73 74 67 72 s:sync-to-postgr
173b0 65 73 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 28 es *configdat* (
173c0 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
173d0 79 6e 63 2d 74 6f 22 29 29 0a 20 20 20 20 20 20 ync-to")).
173e0 28 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 (set! *didsometh
173f0 69 6e 67 2a 20 23 74 29 29 29 0a 0a 28 69 66 20 ing* #t)))..(if
17400 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
17410 67 65 6e 65 72 61 74 65 2d 68 74 6d 6c 22 29 0a generate-html").
17420 20 20 20 20 28 6c 65 74 2a 20 28 28 74 6f 70 70 (let* ((topp
17430 61 74 68 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 ath (launch:setu
17440 70 29 29 29 0a 20 20 20 20 20 20 28 69 66 20 28 p))). (if (
17450 74 65 73 74 73 3a 63 72 65 61 74 65 2d 68 74 6d tests:create-htm
17460 6c 2d 74 72 65 65 20 23 66 29 0a 20 20 20 20 20 l-tree #f).
17470 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
17480 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c t-info 0 *defaul
17490 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 48 54 4d t-log-port* "HTM
174a0 4c 20 6f 75 74 70 75 74 20 63 72 65 61 74 65 64 L output created
174b0 20 69 6e 20 22 20 74 6f 70 70 61 74 68 20 22 2f in " toppath "/
174c0 6c 74 2f 70 61 67 65 23 2e 68 74 6d 6c 22 29 0a lt/page#.html").
174d0 20 20 20 20 20 20 20 20 20 20 28 64 65 62 75 67 (debug
174e0 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
174f0 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 69 t-log-port* "Fai
17500 6c 65 64 20 74 6f 20 63 72 65 61 74 65 20 48 54 led to create HT
17510 4d 4c 20 6f 75 74 70 75 74 20 69 6e 20 22 20 74 ML output in " t
17520 6f 70 70 61 74 68 20 22 2f 6c 74 2f 72 75 6e 73 oppath "/lt/runs
17530 2d 69 6e 64 65 78 2e 68 74 6d 6c 22 29 29 0a 20 -index.html")).
17540 20 20 20 20 20 28 73 65 74 21 20 2a 64 69 64 73 (set! *dids
17550 6f 6d 65 74 68 69 6e 67 2a 20 23 74 29 29 29 0a omething* #t))).
17560 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
17570 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
17580 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
17590 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
175a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 45 78 69 =========.;; Exi
175b0 74 20 61 6e 64 20 63 6c 65 61 6e 20 75 70 0a 3b t and clean up.;
175c0 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
175d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
175e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
175f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
17600 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 69 66 20 28 6e 6f =======..(if (no
17610 74 20 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a t *didsomething*
17620 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 ). (debug:pri
17630 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
17640 67 2d 70 6f 72 74 2a 20 68 65 6c 70 29 0a 20 20 g-port* help).
17650 20 20 28 73 65 74 21 20 2a 74 69 6d 65 2d 74 6f (set! *time-to
17660 2d 65 78 69 74 2a 20 23 74 29 0a 20 20 20 20 29 -exit* #t). )
17670 0a 3b 3b 28 64 65 62 75 67 3a 70 72 69 6e 74 2d .;;(debug:print-
17680 69 6e 66 6f 20 31 33 20 2a 64 65 66 61 75 6c 74 info 13 *default
17690 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 74 68 72 65 -log-port* "thre
176a0 61 64 2d 6a 6f 69 6e 21 20 77 61 74 63 68 64 6f ad-join! watchdo
176b0 67 22 29 0a 0a 3b 3b 20 6a 6f 69 6e 20 74 68 65 g")..;; join the
176c0 20 77 61 74 63 68 64 6f 67 20 74 68 72 65 61 64 watchdog thread
176d0 20 69 66 20 69 74 20 68 61 73 20 62 65 65 6e 20 if it has been
176e0 74 68 72 65 61 64 2d 73 74 61 72 74 21 65 64 20 thread-start!ed
176f0 20 28 69 74 20 6d 61 79 20 6e 6f 74 20 68 61 76 (it may not hav
17700 65 20 62 65 65 6e 20 73 74 61 72 74 65 64 20 69 e been started i
17710 6e 20 74 68 65 20 63 61 73 65 20 6f 66 20 61 20 n the case of a
17720 73 65 72 76 65 72 20 74 68 61 74 20 6e 65 76 65 server that neve
17730 72 20 65 6e 74 65 72 73 20 72 75 6e 6e 69 6e 67 r enters running
17740 20 73 74 61 74 65 29 0a 3b 3b 20 20 20 28 73 79 state).;; (sy
17750 6d 62 6f 6c 73 20 72 65 74 75 72 6e 65 64 20 62 mbols returned b
17760 79 20 74 68 72 65 61 64 2d 73 74 61 74 65 3a 20 y thread-state:
17770 63 72 65 61 74 65 64 20 72 65 61 64 79 20 72 75 created ready ru
17780 6e 6e 69 6e 67 20 62 6c 6f 63 6b 65 64 20 73 75 nning blocked su
17790 73 70 65 6e 64 65 64 20 73 6c 65 65 70 69 6e 67 spended sleeping
177a0 20 74 65 72 6d 69 6e 61 74 65 64 20 64 65 61 64 terminated dead
177b0 29 0a 3b 3b 20 54 4f 44 4f 3a 20 66 6f 72 20 6d ).;; TODO: for m
177c0 75 6c 74 69 70 6c 65 20 61 72 65 61 73 2c 20 77 ultiple areas, w
177d0 65 20 77 69 6c 6c 20 68 61 76 65 20 6d 75 6c 74 e will have mult
177e0 69 70 6c 65 20 77 61 74 63 68 64 6f 67 73 3b 20 iple watchdogs;
177f0 61 6e 64 20 6d 75 6c 74 69 70 6c 65 20 74 68 72 and multiple thr
17800 65 61 64 73 20 74 6f 20 6d 61 6e 61 67 65 0a 28 eads to manage.(
17810 69 66 20 28 74 68 72 65 61 64 3f 20 2a 77 61 74 if (thread? *wat
17820 63 68 64 6f 67 2a 29 0a 20 20 20 20 28 63 61 73 chdog*). (cas
17830 65 20 28 74 68 72 65 61 64 2d 73 74 61 74 65 20 e (thread-state
17840 2a 77 61 74 63 68 64 6f 67 2a 29 0a 20 20 20 20 *watchdog*).
17850 20 20 28 28 72 65 61 64 79 20 72 75 6e 6e 69 6e ((ready runnin
17860 67 20 62 6c 6f 63 6b 65 64 20 73 6c 65 65 70 69 g blocked sleepi
17870 6e 67 20 74 65 72 6d 69 6e 61 74 65 64 20 64 65 ng terminated de
17880 61 64 29 0a 20 20 20 20 20 20 20 28 74 68 72 65 ad). (thre
17890 61 64 2d 6a 6f 69 6e 21 20 2a 77 61 74 63 68 64 ad-join! *watchd
178a0 6f 67 2a 29 29 29 29 0a 0a 28 73 65 74 21 20 2a og*))))..(set! *
178b0 74 69 6d 65 2d 74 6f 2d 65 78 69 74 2a 20 23 74 time-to-exit* #t
178c0 29 0a 0a 28 69 66 20 28 6e 6f 74 20 28 65 71 3f )..(if (not (eq?
178d0 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 61 74 *globalexitstat
178e0 75 73 2a 20 30 29 29 0a 20 20 20 20 28 69 66 20 us* 0)). (if
178f0 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
17900 67 20 22 2d 72 75 6e 22 29 28 61 72 67 73 3a 67 g "-run")(args:g
17910 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 74 et-arg "-runtest
17920 73 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 s")(args:get-arg
17930 20 22 2d 72 75 6e 61 6c 6c 22 29 29 0a 20 20 20 "-runall")).
17940 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 (begin.
17950 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 (debug:pr
17960 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c int 0 *default-l
17970 6f 67 2d 70 6f 72 74 2a 20 22 4e 4f 54 45 3a 20 og-port* "NOTE:
17980 53 75 62 70 72 6f 63 65 73 73 65 73 20 77 69 74 Subprocesses wit
17990 68 20 6e 6f 6e 2d 7a 65 72 6f 20 65 78 69 74 20 h non-zero exit
179a0 63 6f 64 65 20 64 65 74 65 63 74 65 64 3a 20 22 code detected: "
179b0 20 2a 67 6c 6f 62 61 6c 65 78 69 74 73 74 61 74 *globalexitstat
179c0 75 73 2a 29 0a 20 20 20 20 20 20 20 20 20 20 20 us*).
179d0 28 65 78 69 74 20 30 29 29 0a 20 20 20 20 20 20 (exit 0)).
179e0 20 20 28 63 61 73 65 20 2a 67 6c 6f 62 61 6c 65 (case *globale
179f0 78 69 74 73 74 61 74 75 73 2a 0a 20 20 20 20 20 xitstatus*.
17a00 20 20 20 20 28 28 30 29 28 65 78 69 74 20 30 29 ((0)(exit 0)
17a10 29 0a 20 20 20 20 20 20 20 20 20 28 28 31 29 28 ). ((1)(
17a20 65 78 69 74 20 31 29 29 0a 20 20 20 20 20 20 20 exit 1)).
17a30 20 20 28 28 32 29 28 65 78 69 74 20 32 29 29 0a ((2)(exit 2)).
17a40 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 28 (else (
17a50 65 78 69 74 20 33 29 29 29 29 29 0a exit 3))))).