Artifact
d0aaf6cd91d2937cee0256da7a151bbd88bbeb25:
0000: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
0010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0040: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 6f 70 79 ========.;; Copy
0050: 72 69 67 68 74 20 32 30 30 36 2d 32 30 31 37 2c right 2006-2017,
0060: 20 4d 61 74 74 68 65 77 20 57 65 6c 6c 61 6e 64 Matthew Welland
0070: 2e 0a 3b 3b 20 0a 3b 3b 20 54 68 69 73 20 66 69 ..;; .;; This fi
0080: 6c 65 20 69 73 20 70 61 72 74 20 6f 66 20 4d 65 le is part of Me
0090: 67 61 74 65 73 74 2e 0a 3b 3b 20 0a 3b 3b 20 20 gatest..;; .;;
00a0: 20 20 20 4d 65 67 61 74 65 73 74 20 69 73 20 66 Megatest is f
00b0: 72 65 65 20 73 6f 66 74 77 61 72 65 3a 20 79 6f ree software: yo
00c0: 75 20 63 61 6e 20 72 65 64 69 73 74 72 69 62 75 u can redistribu
00d0: 74 65 20 69 74 20 61 6e 64 2f 6f 72 20 6d 6f 64 te it and/or mod
00e0: 69 66 79 0a 3b 3b 20 20 20 20 20 69 74 20 75 6e ify.;; it un
00f0: 64 65 72 20 74 68 65 20 74 65 72 6d 73 20 6f 66 der the terms of
0100: 20 74 68 65 20 47 4e 55 20 47 65 6e 65 72 61 6c the GNU General
0110: 20 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 65 20 Public License
0120: 61 73 20 70 75 62 6c 69 73 68 65 64 20 62 79 0a as published by.
0130: 3b 3b 20 20 20 20 20 74 68 65 20 46 72 65 65 20 ;; the Free
0140: 53 6f 66 74 77 61 72 65 20 46 6f 75 6e 64 61 74 Software Foundat
0150: 69 6f 6e 2c 20 65 69 74 68 65 72 20 76 65 72 73 ion, either vers
0160: 69 6f 6e 20 33 20 6f 66 20 74 68 65 20 4c 69 63 ion 3 of the Lic
0170: 65 6e 73 65 2c 20 6f 72 0a 3b 3b 20 20 20 20 20 ense, or.;;
0180: 28 61 74 20 79 6f 75 72 20 6f 70 74 69 6f 6e 29 (at your option)
0190: 20 61 6e 79 20 6c 61 74 65 72 20 76 65 72 73 69 any later versi
01a0: 6f 6e 2e 0a 3b 3b 20 0a 3b 3b 20 20 20 20 20 4d on..;; .;; M
01b0: 65 67 61 74 65 73 74 20 69 73 20 64 69 73 74 72 egatest is distr
01c0: 69 62 75 74 65 64 20 69 6e 20 74 68 65 20 68 6f ibuted in the ho
01d0: 70 65 20 74 68 61 74 20 69 74 20 77 69 6c 6c 20 pe that it will
01e0: 62 65 20 75 73 65 66 75 6c 2c 0a 3b 3b 20 20 20 be useful,.;;
01f0: 20 20 62 75 74 20 57 49 54 48 4f 55 54 20 41 4e but WITHOUT AN
0200: 59 20 57 41 52 52 41 4e 54 59 3b 20 77 69 74 68 Y WARRANTY; with
0210: 6f 75 74 20 65 76 65 6e 20 74 68 65 20 69 6d 70 out even the imp
0220: 6c 69 65 64 20 77 61 72 72 61 6e 74 79 20 6f 66 lied warranty of
0230: 0a 3b 3b 20 20 20 20 20 4d 45 52 43 48 41 4e 54 .;; MERCHANT
0240: 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 4e 45 ABILITY or FITNE
0250: 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 43 55 SS FOR A PARTICU
0260: 4c 41 52 20 50 55 52 50 4f 53 45 2e 20 20 53 65 LAR PURPOSE. Se
0270: 65 20 74 68 65 0a 3b 3b 20 20 20 20 20 47 4e 55 e the.;; GNU
0280: 20 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 General Public
0290: 4c 69 63 65 6e 73 65 20 66 6f 72 20 6d 6f 72 65 License for more
02a0: 20 64 65 74 61 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b details..;; .;;
02b0: 20 20 20 20 20 59 6f 75 20 73 68 6f 75 6c 64 20 You should
02c0: 68 61 76 65 20 72 65 63 65 69 76 65 64 20 61 20 have received a
02d0: 63 6f 70 79 20 6f 66 20 74 68 65 20 47 4e 55 20 copy of the GNU
02e0: 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 4c General Public L
02f0: 69 63 65 6e 73 65 0a 3b 3b 20 20 20 20 20 61 6c icense.;; al
0300: 6f 6e 67 20 77 69 74 68 20 4d 65 67 61 74 65 73 ong with Megates
0310: 74 2e 20 20 49 66 20 6e 6f 74 2c 20 73 65 65 20 t. If not, see
0320: 3c 68 74 74 70 3a 2f 2f 77 77 77 2e 67 6e 75 2e <http://www.gnu.
0330: 6f 72 67 2f 6c 69 63 65 6e 73 65 73 2f 3e 2e 0a org/licenses/>..
0340: 3b 3b 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;.;;===========
0350: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 75 73 ===========..(us
0390: 65 20 66 6f 72 6d 61 74 20 74 79 70 65 64 2d 72 e format typed-r
03a0: 65 63 6f 72 64 73 29 20 3b 3b 20 52 41 44 54 20 ecords) ;; RADT
03b0: 3d 3e 20 70 75 72 70 6f 73 65 20 6f 66 20 6a 73 => purpose of js
03c0: 6f 6e 20 66 6f 72 6d 61 74 3f 3f 0a 0a 28 64 65 on format??..(de
03d0: 63 6c 61 72 65 20 28 75 6e 69 74 20 72 6d 74 29 clare (unit rmt)
03e0: 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ).(declare (uses
03f0: 20 64 65 62 75 67 70 72 69 6e 74 29 29 0a 28 64 debugprint)).(d
0400: 65 63 6c 61 72 65 20 28 75 73 65 73 20 61 70 69 eclare (uses api
0410: 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 )).(declare (use
0420: 73 20 63 6f 6d 6d 6f 6e 6d 6f 64 29 29 0a 28 64 s commonmod)).(d
0430: 65 63 6c 61 72 65 20 28 75 73 65 73 20 64 62 66 eclare (uses dbf
0440: 69 6c 65 29 29 0a 28 64 65 63 6c 61 72 65 20 28 ile)).(declare (
0450: 75 73 65 73 20 64 62 6d 6f 64 29 29 0a 28 64 65 uses dbmod)).(de
0460: 63 6c 61 72 65 20 28 75 73 65 73 20 74 63 70 2d clare (uses tcp-
0470: 74 72 61 6e 73 70 6f 72 74 6d 6f 64 29 29 0a 28 transportmod)).(
0480: 69 6e 63 6c 75 64 65 20 22 63 6f 6d 6d 6f 6e 5f include "common_
0490: 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 28 64 records.scm").(d
04a0: 65 63 6c 61 72 65 20 28 75 73 65 73 20 72 6d 74 eclare (uses rmt
04b0: 6d 6f 64 29 29 0a 0a 3b 3b 20 75 73 65 64 20 62 mod))..;; used b
04c0: 79 20 68 74 74 70 2d 74 72 61 6e 73 70 6f 72 74 y http-transport
04d0: 0a 28 69 6d 70 6f 72 74 20 64 62 66 69 6c 65 0a .(import dbfile.
04e0: 09 72 6d 74 6d 6f 64 0a 09 63 6f 6d 6d 6f 6e 6d .rmtmod..commonm
04f0: 6f 64 0a 09 64 65 62 75 67 70 72 69 6e 74 0a 3b od..debugprint.;
0500: 3b 20 09 64 62 6d 65 6d 6d 6f 64 0a 09 64 62 66 ; .dbmemmod..dbf
0510: 69 6c 65 0a 09 64 62 6d 6f 64 0a 09 74 63 70 2d ile..dbmod..tcp-
0520: 74 72 61 6e 73 70 6f 72 74 6d 6f 64 29 0a 0a 3b transportmod)..;
0530: 3b 0a 3b 3b 20 54 48 45 53 45 20 41 52 45 20 41 ;.;; THESE ARE A
0540: 4c 4c 20 43 41 4c 4c 45 44 20 4f 4e 20 54 48 45 LL CALLED ON THE
0550: 20 43 4c 49 45 4e 54 20 53 49 44 45 21 21 21 0a CLIENT SIDE!!!.
0560: 3b 3b 0a 0a 3b 3b 20 67 65 6e 65 72 61 74 65 20 ;;..;; generate
0570: 65 6e 74 72 69 65 73 20 66 6f 72 20 7e 2f 2e 6d entries for ~/.m
0580: 65 67 61 74 65 73 74 72 63 20 77 69 74 68 20 74 egatestrc with t
0590: 68 65 20 66 6f 6c 6c 6f 77 69 6e 67 0a 3b 3b 0a he following.;;.
05a0: 3b 3b 20 20 67 72 65 70 20 64 65 66 69 6e 65 20 ;; grep define
05b0: 2e 2e 2f 72 6d 74 2e 73 63 6d 20 7c 20 67 72 65 ../rmt.scm | gre
05c0: 70 20 72 6d 74 3a 20 7c 70 65 72 6c 20 2d 70 69 p rmt: |perl -pi
05d0: 20 2d 65 20 27 73 2f 5c 28 64 65 66 69 6e 65 5c -e 's/\(define\
05e0: 73 2b 5c 28 28 5c 53 2b 29 5c 57 2e 2a 24 2f 5c s+\((\S+)\W.*$/\
05f0: 31 2f 27 7c 73 6f 72 74 20 2d 75 0a 0a 3b 3b 3d 1/'|sort -u..;;=
0600: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0610: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0620: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0630: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0640: 3d 3d 3d 3d 3d 0a 3b 3b 20 20 53 20 55 20 50 20 =====.;; S U P
0650: 50 20 4f 20 52 20 54 20 20 20 46 20 55 20 4e 20 P O R T F U N
0660: 43 20 54 20 49 20 4f 20 4e 20 53 0a 3b 3b 3d 3d C T I O N S.;;==
0670: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0680: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0690: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
06a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
06b0: 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 72 ====..(define (r
06c0: 6d 74 3a 6f 6e 2d 68 6f 6d 65 68 6f 73 74 3f 20 mt:on-homehost?
06d0: 72 75 6e 72 65 6d 6f 74 65 29 0a 20 20 28 6c 65 runremote). (le
06e0: 74 2a 20 28 28 68 68 2d 64 61 74 20 28 72 65 6d t* ((hh-dat (rem
06f0: 6f 74 65 2d 68 68 2d 64 61 74 20 72 75 6e 72 65 ote-hh-dat runre
0700: 6d 6f 74 65 29 29 29 0a 20 20 20 20 28 69 66 20 mote))). (if
0710: 28 70 61 69 72 3f 20 68 68 2d 64 61 74 29 0a 09 (pair? hh-dat)..
0720: 28 63 64 72 20 68 68 2d 64 61 74 29 0a 09 28 62 (cdr hh-dat)..(b
0730: 65 67 69 6e 0a 09 20 20 28 64 65 62 75 67 3a 70 egin.. (debug:p
0740: 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 rint-info 0 *def
0750: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
0760: 68 68 2d 64 61 74 3d 22 68 68 2d 64 61 74 29 0a hh-dat="hh-dat).
0770: 09 20 20 23 66 29 29 29 29 0a 0a 28 64 65 66 69 . #f))))..(defi
0780: 6e 65 20 28 6d 61 6b 65 2d 61 6e 64 2d 69 6e 69 ne (make-and-ini
0790: 74 2d 72 65 6d 6f 74 65 20 61 72 65 61 70 61 74 t-remote areapat
07a0: 68 29 0a 20 20 20 28 63 61 73 65 20 28 72 6d 74 h). (case (rmt
07b0: 3a 74 72 61 6e 73 70 6f 72 74 2d 6d 6f 64 65 29 :transport-mode)
07c0: 0a 20 20 20 20 20 28 28 68 74 74 70 29 28 6d 61 . ((http)(ma
07d0: 6b 65 2d 72 65 6d 6f 74 65 29 29 0a 20 20 20 20 ke-remote)).
07e0: 20 28 28 74 63 70 29 20 28 74 74 3a 6d 61 6b 65 ((tcp) (tt:make
07f0: 2d 72 65 6d 6f 74 65 20 61 72 65 61 70 61 74 68 -remote areapath
0800: 29 29 0a 20 20 20 20 20 28 65 6c 73 65 20 23 66 )). (else #f
0810: 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
0820: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0830: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0840: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0850: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 =============..(
0860: 64 65 66 69 6e 65 20 2a 73 65 6e 64 2d 72 65 63 define *send-rec
0870: 65 69 76 65 2d 6d 75 74 65 78 2a 20 28 6d 61 6b eive-mutex* (mak
0880: 65 2d 6d 75 74 65 78 29 29 20 3b 3b 20 73 68 6f e-mutex)) ;; sho
0890: 75 6c 64 20 68 61 76 65 20 73 65 70 61 72 61 74 uld have separat
08a0: 65 20 6d 75 74 65 78 20 70 65 72 20 72 75 6e 2d e mutex per run-
08b0: 69 64 0a 28 64 65 66 69 6e 65 20 2a 74 74 64 61 id.(define *ttda
08c0: 74 2a 20 23 66 29 0a 3b 3b 20 68 6f 77 20 74 6f t* #f).;; how to
08d0: 20 6d 61 6b 65 20 61 72 65 61 2d 64 61 74 0a 28 make area-dat.(
08e0: 64 65 66 69 6e 65 20 28 72 6d 74 3a 73 65 74 2d define (rmt:set-
08f0: 74 74 64 61 74 20 61 72 65 61 70 61 74 68 20 74 ttdat areapath t
0900: 74 64 61 74 29 0a 20 20 28 69 66 20 74 74 64 61 tdat). (if ttda
0910: 74 0a 20 20 20 20 74 74 64 61 74 0a 20 20 20 20 t. ttdat.
0920: 28 69 66 20 2a 74 74 64 61 74 2a 0a 20 20 20 20 (if *ttdat*.
0930: 20 20 20 2a 74 74 64 61 74 2a 0a 20 20 20 20 20 *ttdat*.
0940: 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 (begin.
0950: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
0960: 6e 66 6f 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c nfo 2 *default-l
0970: 6f 67 2d 70 6f 72 74 2a 20 22 72 6d 74 3a 73 65 og-port* "rmt:se
0980: 74 2d 74 74 64 61 74 3a 20 49 6e 69 74 69 61 6c t-ttdat: Initial
0990: 69 7a 65 20 6e 65 77 20 74 74 64 61 74 22 29 0a ize new ttdat").
09a0: 20 20 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 (let* (
09b0: 28 6e 65 77 72 65 6d 6f 74 65 20 20 28 6d 61 6b (newremote (mak
09c0: 65 2d 61 6e 64 2d 69 6e 69 74 2d 72 65 6d 6f 74 e-and-init-remot
09d0: 65 20 61 72 65 61 70 61 74 68 29 29 29 0a 20 20 e areapath))).
09e0: 20 20 20 20 20 20 20 20 20 28 73 65 74 21 20 2a (set! *
09f0: 74 74 64 61 74 2a 20 6e 65 77 72 65 6d 6f 74 65 ttdat* newremote
0a00: 29 0a 09 20 20 20 6e 65 77 72 65 6d 6f 74 65 0a ).. newremote.
0a10: 20 20 20 20 20 20 20 20 20 29 0a 20 20 20 20 20 ).
0a20: 20 20 29 0a 20 20 20 20 20 29 0a 20 20 20 29 0a ). ). ).
0a30: 29 0a 0a 3b 3b 20 4e 42 2f 2f 20 61 72 65 61 2d )..;; NB// area-
0a40: 64 61 74 20 72 65 70 6c 61 63 65 64 20 62 79 20 dat replaced by
0a50: 74 74 64 61 74 0a 3b 3b 20 0a 28 64 65 66 69 6e ttdat.;; .(defin
0a60: 65 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 e (rmt:send-rece
0a70: 69 76 65 20 63 6d 64 20 72 75 6e 2d 69 64 20 70 ive cmd run-id p
0a80: 61 72 61 6d 73 20 23 21 6b 65 79 20 28 61 74 74 arams #!key (att
0a90: 65 6d 70 74 6e 75 6d 20 31 29 28 74 74 64 61 74 emptnum 1)(ttdat
0aa0: 20 23 66 29 29 0a 20 20 28 61 73 73 65 72 74 20 #f)). (assert
0ab0: 28 6f 72 20 28 6e 6f 74 20 72 75 6e 2d 69 64 29 (or (not run-id)
0ac0: 20 28 6e 75 6d 62 65 72 3f 20 72 75 6e 2d 69 64 (number? run-id
0ad0: 29 29 20 22 46 41 54 41 4c 3a 20 72 75 6e 2d 69 )) "FATAL: run-i
0ae0: 64 20 69 73 20 72 65 71 75 69 72 65 64 20 74 6f d is required to
0af0: 20 62 65 20 61 20 6e 75 6d 62 65 72 20 6f 72 20 be a number or
0b00: 23 66 22 29 0a 20 20 28 61 73 73 65 72 74 20 2a #f"). (assert *
0b10: 74 6f 70 70 61 74 68 2a 20 22 46 41 54 41 4c 3a toppath* "FATAL:
0b20: 20 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 rmt:send-receiv
0b30: 65 20 63 61 6c 6c 65 64 20 77 69 74 68 20 2a 74 e called with *t
0b40: 6f 70 70 61 74 68 2a 20 6e 6f 74 20 73 65 74 2e oppath* not set.
0b50: 22 29 0a 20 20 28 6c 65 74 2a 20 28 28 61 72 65 "). (let* ((are
0b60: 61 70 61 74 68 20 20 20 20 20 20 2a 74 6f 70 70 apath *topp
0b70: 61 74 68 2a 29 20 3b 3b 20 54 4f 44 4f 20 2d 20 ath*) ;; TODO -
0b80: 72 65 73 6f 6c 76 65 20 66 72 6f 6d 20 64 62 73 resolve from dbs
0b90: 74 72 75 63 74 20 74 6f 20 62 65 20 63 6f 6d 70 truct to be comp
0ba0: 61 74 69 62 6c 65 20 77 69 74 68 20 6d 75 6c 74 atible with mult
0bb0: 69 70 6c 65 20 61 72 65 61 73 0a 09 20 28 72 65 iple areas.. (re
0bc0: 61 64 6f 6e 6c 79 2d 6d 6f 64 65 20 28 72 6d 74 adonly-mode (rmt
0bd0: 6d 6f 64 3a 63 61 6c 63 2d 72 6f 2d 6d 6f 64 65 mod:calc-ro-mode
0be0: 20 74 74 64 61 74 20 2a 74 6f 70 70 61 74 68 2a ttdat *toppath*
0bf0: 29 29 0a 09 20 28 74 65 73 74 73 75 69 74 65 20 )).. (testsuite
0c00: 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d (common:get-
0c10: 74 65 73 74 73 75 69 74 65 2d 6e 61 6d 65 29 29 testsuite-name))
0c20: 0a 09 20 28 64 62 66 6e 61 6d 65 20 20 20 20 20 .. (dbfname
0c30: 20 20 28 63 6f 6e 63 20 28 64 62 66 69 6c 65 3a (conc (dbfile:
0c40: 72 75 6e 2d 69 64 2d 3e 64 62 6e 75 6d 20 72 75 run-id->dbnum ru
0c50: 6e 2d 69 64 29 22 2e 64 62 22 29 29 0a 09 20 28 n-id)".db")).. (
0c60: 64 62 64 69 72 20 20 20 20 20 20 20 20 20 28 63 dbdir (c
0c70: 6f 6e 63 20 61 72 65 61 70 61 74 68 20 22 2f 2e onc areapath "/.
0c80: 6d 74 64 62 22 29 29 29 0a 20 20 20 20 28 69 66 mtdb"))). (if
0c90: 20 28 61 6e 64 20 28 6e 6f 74 20 2a 6a 6f 75 72 (and (not *jour
0ca0: 6e 61 6c 2d 73 74 61 74 73 2a 29 0a 09 20 20 20 nal-stats*)..
0cb0: 20 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 (file-exists?
0cc0: 64 62 64 69 72 29 29 0a 09 28 74 74 3a 73 74 61 dbdir))..(tt:sta
0cd0: 72 74 2d 73 74 61 74 73 20 64 62 64 69 72 29 29 rt-stats dbdir))
0ce0: 20 3b 3b 20 66 69 78 6d 65 20 2d 20 66 69 6e 64 ;; fixme - find
0cf0: 20 74 68 65 20 72 69 67 68 74 20 63 61 6c 6c 20 the right call
0d00: 74 6f 20 67 65 74 20 74 68 65 20 64 62 20 64 69 to get the db di
0d10: 72 65 63 74 6f 72 79 0a 20 20 20 20 0a 20 20 20 rectory. .
0d20: 20 3b 3b 20 63 68 65 63 6b 20 74 68 65 20 6c 6f ;; check the lo
0d30: 61 64 20 6f 6e 20 64 62 66 6e 61 6d 65 20 61 6e ad on dbfname an
0d40: 64 20 61 64 64 20 73 6f 6d 65 20 64 65 6c 61 79 d add some delay
0d50: 20 75 73 69 6e 67 20 61 20 64 72 6f 6f 70 20 63 using a droop c
0d60: 75 72 76 65 20 6f 66 20 73 6f 72 74 73 0a 20 20 urve of sorts.
0d70: 20 20 28 69 66 20 2a 6a 6f 75 72 6e 61 6c 2d 73 (if *journal-s
0d80: 74 61 74 73 2a 0a 09 28 6c 65 74 2a 20 28 28 6c tats*..(let* ((l
0d90: 6f 61 64 20 20 28 74 74 3a 67 65 74 2d 6a 6f 75 oad (tt:get-jou
0da0: 72 6e 61 6c 2d 73 74 61 74 73 20 64 62 66 6e 61 rnal-stats dbfna
0db0: 6d 65 29 29 29 0a 09 20 20 28 69 66 20 28 3e 20 me))).. (if (>
0dc0: 6c 6f 61 64 20 30 2e 31 29 20 3b 3b 20 73 74 61 load 0.1) ;; sta
0dd0: 72 74 20 61 63 74 69 76 61 74 69 6e 67 20 64 65 rt activating de
0de0: 6c 61 79 20 61 74 20 31 30 25 20 6a 6f 75 72 6e lay at 10% journ
0df0: 61 6c 20 6c 6f 61 64 20 74 69 6d 65 0a 09 20 20 al load time..
0e00: 20 20 20 20 28 6c 65 74 20 28 28 64 65 6c 79 20 (let ((dely
0e10: 28 2a 20 35 30 20 28 2a 20 6c 6f 61 64 20 6c 6f (* 50 (* load lo
0e20: 61 64 29 29 29 29 20 3b 3b 20 31 30 30 25 20 6a ad)))) ;; 100% j
0e30: 6f 75 72 6e 61 6c 20 74 69 6d 65 3d 35 30 73 65 ournal time=50se
0e40: 63 20 64 65 6c 61 79 0a 09 09 28 64 65 62 75 67 c delay...(debug
0e50: 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
0e60: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4a 6f 75 t-log-port* "Jou
0e70: 72 6e 61 6c 20 6c 6f 61 64 20 22 6c 6f 61 64 22 rnal load "load"
0e80: 20 6f 6e 20 22 64 62 66 6e 61 6d 65 22 20 64 65 on "dbfname" de
0e90: 6c 61 79 69 6e 67 20 71 75 65 72 69 65 73 20 22 laying queries "
0ea0: 64 65 6c 79 22 73 2e 22 29 0a 09 09 28 74 68 72 dely"s.")...(thr
0eb0: 65 61 64 2d 73 6c 65 65 70 21 20 64 65 6c 79 29 ead-sleep! dely)
0ec0: 29 29 29 29 0a 09 0a 20 20 20 20 28 63 61 73 65 ))))... (case
0ed0: 20 28 72 6d 74 3a 74 72 61 6e 73 70 6f 72 74 2d (rmt:transport-
0ee0: 6d 6f 64 65 29 0a 20 20 20 20 20 20 28 28 74 63 mode). ((tc
0ef0: 70 29 0a 20 20 20 20 20 20 20 28 6c 65 74 2a 20 p). (let*
0f00: 28 28 73 74 61 72 74 2d 74 69 6d 65 20 20 20 20 ((start-time
0f10: 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 (current-seconds
0f20: 29 29 20 3b 3b 20 73 6e 61 70 73 68 6f 74 20 74 )) ;; snapshot t
0f30: 69 6d 65 20 73 6f 20 61 6c 6c 20 75 73 65 20 63 ime so all use c
0f40: 61 73 65 73 20 67 65 74 20 73 61 6d 65 20 76 61 ases get same va
0f50: 6c 75 65 0a 09 20 20 20 20 20 20 28 61 74 74 65 lue.. (atte
0f60: 6d 70 74 6e 75 6d 20 20 20 20 28 2b 20 31 20 61 mptnum (+ 1 a
0f70: 74 74 65 6d 70 74 6e 75 6d 29 29 0a 09 20 20 20 ttemptnum))..
0f80: 20 20 20 28 6d 74 65 78 65 20 20 20 20 20 20 20 (mtexe
0f90: 20 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6e 64 2d 6c (common:find-l
0fa0: 6f 63 61 6c 2d 6d 65 67 61 74 65 73 74 29 29 0a ocal-megatest)).
0fb0: 09 20 20 20 20 20 20 28 74 74 64 61 74 20 20 20 . (ttdat
0fc0: 20 20 20 20 20 20 28 72 6d 74 3a 73 65 74 2d 74 (rmt:set-t
0fd0: 74 64 61 74 20 61 72 65 61 70 61 74 68 20 74 74 tdat areapath tt
0fe0: 64 61 74 29 29 0a 09 20 20 20 20 20 20 28 63 6f dat)).. (co
0ff0: 6e 6e 20 20 20 20 20 20 20 20 20 20 28 74 74 3a nn (tt:
1000: 67 65 74 2d 63 6f 6e 6e 20 74 74 64 61 74 20 64 get-conn ttdat d
1010: 62 66 6e 61 6d 65 29 29 0a 09 20 20 20 20 20 20 bfname))..
1020: 28 69 73 2d 6d 61 69 6e 20 20 20 20 20 20 20 28 (is-main (
1030: 65 71 75 61 6c 3f 20 64 62 66 6e 61 6d 65 20 22 equal? dbfname "
1040: 6d 61 69 6e 2e 64 62 22 29 29 20 3b 3b 20 77 68 main.db")) ;; wh
1050: 79 20 6e 6f 74 20 28 6e 6f 74 20 72 75 6e 2d 69 y not (not run-i
1060: 64 29 20 3f 0a 09 20 20 20 20 20 20 28 73 65 72 d) ?.. (ser
1070: 76 65 72 2d 73 74 61 72 74 2d 70 72 6f 63 20 28 ver-start-proc (
1080: 69 66 20 69 73 2d 6d 61 69 6e 0a 09 09 09 09 20 if is-main.....
1090: 20 20 20 20 23 66 0a 09 09 09 09 20 20 20 20 20 #f.....
10a0: 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 09 20 (lambda ().....
10b0: 20 20 20 20 20 20 3b 3b 20 28 64 65 62 75 67 3a ;; (debug:
10c0: 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 print-info 0 *de
10d0: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
10e0: 22 73 74 61 72 74 69 6e 67 20 73 65 72 76 65 72 "starting server
10f0: 20 66 6f 72 20 64 62 66 6e 61 6d 65 3a 20 22 64 for dbfname: "d
1100: 62 66 6e 61 6d 65 29 0a 09 09 09 09 20 20 20 20 bfname).....
1110: 20 20 20 28 72 6d 74 3a 73 74 61 72 74 2d 73 65 (rmt:start-se
1120: 72 76 65 72 20 3b 3b 20 74 74 3a 73 65 72 76 65 rver ;; tt:serve
1130: 72 2d 70 72 6f 63 65 73 73 2d 72 75 6e 0a 09 09 r-process-run...
1140: 09 09 09 61 72 65 61 70 61 74 68 0a 09 09 09 09 ...areapath.....
1150: 09 74 65 73 74 73 75 69 74 65 20 3b 3b 20 28 64 .testsuite ;; (d
1160: 62 66 69 6c 65 3a 74 65 73 74 73 75 69 74 65 2d bfile:testsuite-
1170: 6e 61 6d 65 29 0a 09 09 09 09 09 6d 74 65 78 65 name)......mtexe
1180: 0a 09 09 09 09 09 72 75 6e 2d 69 64 29 29 29 29 ......run-id))))
1190: 29 0a 09 20 3b 3b 20 68 65 72 65 20 77 65 20 6c ).. ;; here we l
11a0: 6f 6f 6b 20 61 74 20 74 74 64 61 74 2c 20 69 66 ook at ttdat, if
11b0: 20 64 62 66 6e 61 6d 65 20 69 73 20 4e 4f 54 20 dbfname is NOT
11c0: 6d 61 69 6e 2e 64 62 20 77 65 20 63 68 65 63 6b main.db we check
11d0: 20 74 68 61 74 20 61 20 63 6f 6e 6e 20 65 78 69 that a conn exi
11e0: 73 74 73 20 66 6f 72 20 69 74 0a 09 20 3b 3b 20 sts for it.. ;;
11f0: 61 6e 64 20 69 66 20 74 68 65 72 65 20 69 73 20 and if there is
1200: 6e 6f 20 63 6f 6e 6e 20 77 65 20 66 69 72 73 74 no conn we first
1210: 20 73 65 6e 64 20 61 20 72 65 71 75 65 73 74 20 send a request
1220: 74 6f 20 74 68 65 20 6d 61 69 6e 2e 64 62 20 73 to the main.db s
1230: 65 72 76 65 72 20 74 6f 20 73 74 61 72 74 20 61 erver to start a
1240: 0a 09 20 3b 3b 20 73 65 72 76 65 72 20 66 6f 72 .. ;; server for
1250: 20 74 68 65 20 64 62 66 6e 61 6d 65 2e 0a 09 20 the dbfname...
1260: 23 3b 28 69 66 20 28 61 6e 64 20 28 6e 6f 74 20 #;(if (and (not
1270: 69 73 2d 6d 61 69 6e 29 28 6e 6f 74 20 63 6f 6e is-main)(not con
1280: 6e 29 29 20 3b 3b 20 6e 6f 20 65 78 69 73 74 69 n)) ;; no existi
1290: 6e 67 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 74 6f ng connection to
12a0: 20 6e 6f 6e 2d 6d 61 69 6e 20 73 65 72 76 65 72 non-main server
12b0: 2c 20 63 61 6c 6c 20 69 6e 20 61 20 73 74 61 72 , call in a star
12c0: 74 20 75 70 20 72 65 71 75 65 73 74 0a 09 20 28 t up request.. (
12d0: 62 65 67 69 6e 0a 09 20 28 73 65 72 76 65 72 2d begin.. (server-
12e0: 73 74 61 72 74 2d 70 72 6f 63 29 0a 09 20 28 74 start-proc).. (t
12f0: 68 72 65 61 64 2d 73 6c 65 65 70 21 20 31 29 29 hread-sleep! 1))
1300: 29 0a 09 20 28 74 74 3a 68 61 6e 64 6c 65 72 20 ).. (tt:handler
1310: 74 74 64 61 74 20 63 6d 64 20 72 75 6e 2d 69 64 ttdat cmd run-id
1320: 20 70 61 72 61 6d 73 20 61 74 74 65 6d 70 74 6e params attemptn
1330: 75 6d 20 72 65 61 64 6f 6e 6c 79 2d 6d 6f 64 65 um readonly-mode
1340: 20 64 62 66 6e 61 6d 65 20 74 65 73 74 73 75 69 dbfname testsui
1350: 74 65 20 6d 74 65 78 65 20 73 65 72 76 65 72 2d te mtexe server-
1360: 73 74 61 72 74 2d 70 72 6f 63 29 29 29 0a 20 20 start-proc))).
1370: 20 20 20 20 28 28 6e 66 73 29 0a 20 20 20 20 20 ((nfs).
1380: 20 20 28 6e 66 73 2d 74 72 61 6e 73 70 6f 72 74 (nfs-transport
1390: 2d 68 61 6e 64 6c 65 72 20 63 6d 64 20 72 75 6e -handler cmd run
13a0: 2d 69 64 20 70 61 72 61 6d 73 20 61 74 74 65 6d -id params attem
13b0: 70 74 6e 75 6d 20 61 72 65 61 70 61 74 68 20 72 ptnum areapath r
13c0: 65 61 64 6f 6e 6c 79 2d 6d 6f 64 65 20 74 65 73 eadonly-mode tes
13d0: 74 73 75 69 74 65 29 29 0a 20 20 20 20 20 20 28 tsuite)). (
13e0: 65 6c 73 65 0a 20 20 20 20 20 20 20 28 64 65 62 else. (deb
13f0: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 ug:print-info 0
1400: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
1410: 74 2a 20 22 72 6d 74 3a 74 72 61 6e 73 70 6f 72 t* "rmt:transpor
1420: 74 2d 6d 6f 64 65 20 69 73 20 22 28 72 6d 74 3a t-mode is "(rmt:
1430: 74 72 61 6e 73 70 6f 72 74 2d 6d 6f 64 65 29 29 transport-mode))
1440: 0a 20 20 20 20 20 20 20 28 61 73 73 65 72 74 20 . (assert
1450: 23 66 20 22 46 41 54 41 4c 3a 20 72 6d 74 3a 74 #f "FATAL: rmt:t
1460: 72 61 6e 73 70 6f 72 74 2d 6d 6f 64 65 20 73 65 ransport-mode se
1470: 74 20 74 6f 20 69 6e 76 61 6c 69 64 20 76 61 6c t to invalid val
1480: 75 65 2e 22 29 29 29 29 29 0a 0a 28 64 65 66 69 ue.")))))..(defi
1490: 6e 65 20 28 6e 66 73 2d 74 72 61 6e 73 70 6f 72 ne (nfs-transpor
14a0: 74 2d 68 61 6e 64 6c 65 72 20 63 6d 64 20 72 75 t-handler cmd ru
14b0: 6e 2d 69 64 20 70 61 72 61 6d 73 20 61 74 74 65 n-id params atte
14c0: 6d 70 74 6e 75 6d 20 61 72 65 61 70 61 74 68 20 mptnum areapath
14d0: 72 65 61 64 6f 6e 6c 79 2d 6d 6f 64 65 20 74 65 readonly-mode te
14e0: 73 74 73 75 69 74 65 29 0a 20 20 28 6c 65 74 2a stsuite). (let*
14f0: 20 28 28 6b 65 79 73 20 20 20 20 20 28 63 6f 6d ((keys (com
1500: 6d 6f 6e 3a 67 65 74 2d 66 69 65 6c 64 73 20 2a mon:get-fields *
1510: 63 6f 6e 66 69 67 64 61 74 2a 29 29 0a 09 20 28 configdat*)).. (
1520: 64 62 73 74 72 75 63 74 20 28 64 62 6d 6f 64 3a dbstruct (dbmod:
1530: 6e 66 73 2d 67 65 74 2d 64 62 73 74 72 75 63 74 nfs-get-dbstruct
1540: 20 72 75 6e 2d 69 64 20 6b 65 79 73 20 28 64 62 run-id keys (db
1550: 66 69 6c 65 3a 64 62 2d 69 6e 69 74 2d 70 72 6f file:db-init-pro
1560: 63 29 20 61 72 65 61 70 61 74 68 29 29 29 0a 20 c) areapath))).
1570: 20 20 20 28 61 70 69 3a 64 69 73 70 61 74 63 68 (api:dispatch
1580: 2d 72 65 71 75 65 73 74 20 64 62 73 74 72 75 63 -request dbstruc
1590: 74 20 63 6d 64 20 72 75 6e 2d 69 64 20 70 61 72 t cmd run-id par
15a0: 61 6d 73 29 29 29 0a 09 0a 28 64 65 66 69 6e 65 ams)))...(define
15b0: 20 28 72 6d 74 3a 67 65 74 2d 6d 61 78 2d 71 75 (rmt:get-max-qu
15c0: 65 72 79 2d 61 76 65 72 61 67 65 20 72 75 6e 2d ery-average run-
15d0: 69 64 29 0a 20 20 28 6d 75 74 65 78 2d 6c 6f 63 id). (mutex-loc
15e0: 6b 21 20 2a 64 62 2d 73 74 61 74 73 2d 6d 75 74 k! *db-stats-mut
15f0: 65 78 2a 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 ex*). (let* ((r
1600: 75 6e 6b 65 79 20 28 63 6f 6e 63 20 22 72 75 6e unkey (conc "run
1610: 2d 69 64 3d 22 20 72 75 6e 2d 69 64 20 22 20 22 -id=" run-id " "
1620: 29 29 0a 09 20 28 63 6d 64 73 20 20 20 28 66 69 )).. (cmds (fi
1630: 6c 74 65 72 20 28 6c 61 6d 62 64 61 20 28 78 29 lter (lambda (x)
1640: 0a 09 09 09 20 20 20 28 73 75 62 73 74 72 69 6e .... (substrin
1650: 67 2d 69 6e 64 65 78 20 72 75 6e 6b 65 79 20 78 g-index runkey x
1660: 29 29 0a 09 09 09 20 28 68 61 73 68 2d 74 61 62 )).... (hash-tab
1670: 6c 65 2d 6b 65 79 73 20 2a 64 62 2d 73 74 61 74 le-keys *db-stat
1680: 73 2a 29 29 29 0a 09 20 28 72 65 73 20 20 20 20 s*))).. (res
1690: 28 69 66 20 28 6e 75 6c 6c 3f 20 63 6d 64 73 29 (if (null? cmds)
16a0: 0a 09 09 20 20 20 20 20 28 63 6f 6e 73 20 27 6e ... (cons 'n
16b0: 6f 6e 65 20 30 29 0a 09 09 20 20 20 20 20 28 6c one 0)... (l
16c0: 65 74 20 6c 6f 6f 70 20 28 28 63 6d 64 20 28 63 et loop ((cmd (c
16d0: 61 72 20 63 6d 64 73 29 29 0a 09 09 09 09 28 74 ar cmds)).....(t
16e0: 61 6c 20 28 63 64 72 20 63 6d 64 73 29 29 0a 09 al (cdr cmds))..
16f0: 09 09 09 28 6d 61 78 2d 63 6d 64 20 28 63 61 72 ...(max-cmd (car
1700: 20 63 6d 64 73 29 29 0a 09 09 09 09 28 72 65 73 cmds)).....(res
1710: 20 30 29 29 0a 09 09 20 20 20 20 20 20 20 28 6c 0))... (l
1720: 65 74 2a 20 28 28 63 6d 64 2d 64 61 74 20 28 68 et* ((cmd-dat (h
1730: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 2a 64 ash-table-ref *d
1740: 62 2d 73 74 61 74 73 2a 20 63 6d 64 29 29 0a 09 b-stats* cmd))..
1750: 09 09 20 20 20 20 20 20 28 74 6f 74 20 20 20 20 .. (tot
1760: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 63 6d 64 (vector-ref cmd
1770: 2d 64 61 74 20 30 29 29 0a 09 09 09 20 20 20 20 -dat 0))....
1780: 20 20 28 63 75 72 72 61 76 67 20 28 2f 20 28 76 (curravg (/ (v
1790: 65 63 74 6f 72 2d 72 65 66 20 63 6d 64 2d 64 61 ector-ref cmd-da
17a0: 74 20 31 29 20 28 76 65 63 74 6f 72 2d 72 65 66 t 1) (vector-ref
17b0: 20 63 6d 64 2d 64 61 74 20 30 29 29 29 20 3b 3b cmd-dat 0))) ;;
17c0: 20 63 6f 75 6e 74 20 69 73 20 6e 65 76 65 72 20 count is never
17d0: 7a 65 72 6f 20 62 79 20 63 6f 6e 73 74 72 75 63 zero by construc
17e0: 74 69 6f 6e 0a 09 09 09 20 20 20 20 20 20 28 63 tion.... (c
17f0: 75 72 72 6d 61 78 20 28 6d 61 78 20 72 65 73 20 urrmax (max res
1800: 63 75 72 72 61 76 67 29 29 0a 09 09 09 20 20 20 curravg))....
1810: 20 20 20 28 6e 65 77 6d 61 78 2d 63 6d 64 20 28 (newmax-cmd (
1820: 69 66 20 28 3e 20 63 75 72 72 61 76 67 20 72 65 if (> curravg re
1830: 73 29 20 63 6d 64 20 6d 61 78 2d 63 6d 64 29 29 s) cmd max-cmd))
1840: 29 0a 09 09 09 20 28 69 66 20 28 6e 75 6c 6c 3f ).... (if (null?
1850: 20 74 61 6c 29 0a 09 09 09 20 20 20 20 20 28 69 tal).... (i
1860: 66 20 28 3e 20 74 6f 74 20 31 30 29 0a 09 09 09 f (> tot 10)....
1870: 09 20 28 63 6f 6e 73 20 6e 65 77 6d 61 78 2d 63 . (cons newmax-c
1880: 6d 64 20 63 75 72 72 6d 61 78 29 0a 09 09 09 09 md currmax).....
1890: 20 28 63 6f 6e 73 20 27 6e 6f 6e 65 20 30 29 29 (cons 'none 0))
18a0: 0a 09 09 09 20 20 20 20 20 28 6c 6f 6f 70 20 28 .... (loop (
18b0: 63 61 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c car tal)(cdr tal
18c0: 29 20 6e 65 77 6d 61 78 2d 63 6d 64 20 63 75 72 ) newmax-cmd cur
18d0: 72 6d 61 78 29 29 29 29 29 29 29 0a 20 20 20 20 rmax))))))).
18e0: 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 2a (mutex-unlock! *
18f0: 64 62 2d 73 74 61 74 73 2d 6d 75 74 65 78 2a 29 db-stats-mutex*)
1900: 0a 20 20 20 20 72 65 73 29 29 0a 0a 28 64 65 66 . res))..(def
1910: 69 6e 65 20 28 72 6d 74 3a 6f 70 65 6e 2d 71 72 ine (rmt:open-qr
1920: 79 2d 63 6c 6f 73 65 2d 6c 6f 63 61 6c 6c 79 20 y-close-locally
1930: 63 6d 64 20 72 75 6e 2d 69 64 20 70 61 72 61 6d cmd run-id param
1940: 73 20 23 21 6b 65 79 20 28 72 65 6d 72 65 74 72 s #!key (remretr
1950: 69 65 73 20 35 29 29 0a 20 20 28 6c 65 74 2a 20 ies 5)). (let*
1960: 28 28 71 72 79 2d 69 73 2d 77 72 69 74 65 20 20 ((qry-is-write
1970: 20 20 28 6e 6f 74 20 28 6d 65 6d 62 65 72 20 63 (not (member c
1980: 6d 64 20 61 70 69 3a 72 65 61 64 2d 6f 6e 6c 79 md api:read-only
1990: 2d 71 75 65 72 69 65 73 29 29 29 0a 09 20 28 64 -queries))).. (d
19a0: 62 2d 66 69 6c 65 2d 70 61 74 68 20 20 20 20 28 b-file-path (
19b0: 63 6f 6d 6d 6f 6e 3a 6d 61 6b 65 2d 74 6d 70 64 common:make-tmpd
19c0: 69 72 2d 6e 61 6d 65 20 2a 74 6f 70 70 61 74 68 ir-name *toppath
19d0: 2a 20 22 22 29 29 20 3b 3b 20 20 30 29 29 0a 09 * "")) ;; 0))..
19e0: 20 28 64 62 73 74 72 75 63 74 73 2d 6c 6f 63 61 (dbstructs-loca
19f0: 6c 20 28 64 62 3a 73 65 74 75 70 29 29 0a 09 20 l (db:setup))..
1a00: 28 72 65 61 64 2d 6f 6e 6c 79 20 20 20 20 20 20 (read-only
1a10: 20 28 6e 6f 74 20 28 66 69 6c 65 2d 77 72 69 74 (not (file-writ
1a20: 65 2d 61 63 63 65 73 73 3f 20 64 62 2d 66 69 6c e-access? db-fil
1a30: 65 2d 70 61 74 68 29 29 29 0a 09 20 28 73 74 61 e-path))).. (sta
1a40: 72 74 20 20 20 20 20 20 20 20 20 20 20 28 63 75 rt (cu
1a50: 72 72 65 6e 74 2d 6d 69 6c 6c 69 73 65 63 6f 6e rrent-millisecon
1a60: 64 73 29 29 0a 09 20 28 72 65 73 64 61 74 20 20 ds)).. (resdat
1a70: 20 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 (if (not
1a80: 20 28 61 6e 64 20 72 65 61 64 2d 6f 6e 6c 79 20 (and read-only
1a90: 71 72 79 2d 69 73 2d 77 72 69 74 65 29 29 0a 09 qry-is-write))..
1aa0: 09 09 20 20 20 20 20 20 28 6c 65 74 20 28 28 76 .. (let ((v
1ab0: 20 28 61 70 69 3a 65 78 65 63 75 74 65 2d 72 65 (api:execute-re
1ac0: 71 75 65 73 74 73 20 64 62 73 74 72 75 63 74 73 quests dbstructs
1ad0: 2d 6c 6f 63 61 6c 20 28 76 65 63 74 6f 72 20 28 -local (vector (
1ae0: 73 79 6d 62 6f 6c 2d 3e 73 74 72 69 6e 67 20 63 symbol->string c
1af0: 6d 64 29 20 70 61 72 61 6d 73 29 29 29 29 0a 09 md) params))))..
1b00: 09 09 3b 3b 09 28 68 61 6e 64 6c 65 2d 65 78 63 ..;;.(handle-exc
1b10: 65 70 74 69 6f 6e 73 20 3b 3b 20 74 68 65 72 65 eptions ;; there
1b20: 20 68 61 73 20 62 65 65 6e 20 61 20 6c 6f 6e 67 has been a long
1b30: 20 68 69 73 74 6f 72 79 20 6f 66 20 72 65 63 65 history of rece
1b40: 69 76 69 6e 67 20 73 74 72 61 6e 67 65 20 65 72 iving strange er
1b50: 72 6f 72 73 20 66 72 6f 6d 20 76 61 6c 75 65 73 rors from values
1b60: 20 72 65 74 75 72 6e 65 64 20 62 79 20 74 68 65 returned by the
1b70: 20 63 6c 69 65 6e 74 20 77 68 65 6e 20 74 68 69 client when thi
1b80: 6e 67 73 20 67 6f 20 77 72 6f 6e 67 2e 2e 0a 09 ngs go wrong....
1b90: 09 09 3b 3b 09 20 65 78 6e 20 20 20 20 20 20 20 ..;;. exn
1ba0: 20 20 20 20 20 20 20 20 3b 3b 20 20 54 68 69 73 ;; This
1bb0: 20 69 73 20 61 6e 20 61 74 74 65 6d 70 74 20 74 is an attempt t
1bc0: 6f 20 64 65 74 65 63 74 20 74 68 61 74 20 73 69 o detect that si
1bd0: 74 75 61 74 69 6f 6e 20 61 6e 64 20 72 65 63 6f tuation and reco
1be0: 76 65 72 20 67 72 61 63 65 66 75 6c 6c 79 0a 09 ver gracefully..
1bf0: 09 09 3b 3b 09 20 28 62 65 67 69 6e 0a 09 09 09 ..;;. (begin....
1c00: 3b 3b 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 ;;. (debug:pri
1c10: 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
1c20: 67 2d 70 6f 72 74 2a 20 22 45 52 52 4f 52 3a 20 g-port* "ERROR:
1c30: 62 61 64 20 64 61 74 61 20 66 72 6f 6d 20 73 65 bad data from se
1c40: 72 76 65 72 20 22 20 76 20 22 20 6d 65 73 73 61 rver " v " messa
1c50: 67 65 3a 20 22 20 20 28 28 63 6f 6e 64 69 74 69 ge: " ((conditi
1c60: 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 65 on-property-acce
1c70: 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 61 ssor 'exn 'messa
1c80: 67 65 29 20 65 78 6e 29 20 22 2c 20 65 78 6e 3d ge) exn) ", exn=
1c90: 22 20 65 78 6e 29 0a 09 09 09 3b 3b 09 20 20 20 " exn)....;;.
1ca0: 28 76 65 63 74 6f 72 20 23 74 20 27 28 29 29 29 (vector #t '()))
1cb0: 20 3b 3b 20 73 68 6f 75 6c 64 20 61 6c 77 61 79 ;; should alway
1cc0: 73 20 67 65 74 20 61 20 76 65 63 74 6f 72 20 62 s get a vector b
1cd0: 75 74 20 69 66 20 73 6f 6d 65 74 68 69 6e 67 20 ut if something
1ce0: 67 6f 65 73 20 77 72 6f 6e 67 20 72 65 74 75 72 goes wrong retur
1cf0: 6e 20 61 20 64 75 6d 6d 79 0a 09 09 09 09 20 28 n a dummy..... (
1d00: 69 66 20 28 61 6e 64 20 28 76 65 63 74 6f 72 3f if (and (vector?
1d10: 20 76 29 0a 09 09 09 09 09 20 20 28 3e 20 28 76 v)...... (> (v
1d20: 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 76 29 20 ector-length v)
1d30: 31 29 29 0a 09 09 09 09 20 20 20 20 20 28 6c 65 1))..... (le
1d40: 74 20 28 28 6e 65 77 76 65 63 20 28 76 65 63 74 t ((newvec (vect
1d50: 6f 72 20 28 76 65 63 74 6f 72 2d 72 65 66 20 76 or (vector-ref v
1d60: 20 30 29 28 76 65 63 74 6f 72 2d 72 65 66 20 76 0)(vector-ref v
1d70: 20 31 29 29 29 29 0a 09 09 09 09 20 20 20 20 20 1)))).....
1d80: 20 20 6e 65 77 76 65 63 29 20 20 20 20 20 20 20 newvec)
1d90: 20 20 20 20 3b 3b 20 62 79 20 63 6f 70 79 69 6e ;; by copyin
1da0: 67 20 74 68 65 20 76 65 63 74 6f 72 20 77 68 69 g the vector whi
1db0: 6c 65 20 69 6e 73 69 64 65 20 74 68 65 20 65 72 le inside the er
1dc0: 72 6f 72 20 68 61 6e 64 6c 65 72 20 77 65 20 73 ror handler we s
1dd0: 68 6f 75 6c 64 20 66 6f 72 63 65 20 74 68 65 20 hould force the
1de0: 64 65 74 65 63 74 69 6f 6e 20 6f 66 20 61 20 63 detection of a c
1df0: 6f 72 72 75 70 74 65 64 20 72 65 63 6f 72 64 0a orrupted record.
1e00: 09 09 09 09 20 20 20 20 20 28 76 65 63 74 6f 72 .... (vector
1e10: 20 23 74 20 27 28 29 29 29 29 20 3b 3b 20 29 20 #t '()))) ;; )
1e20: 20 3b 3b 20 77 65 20 63 6f 75 6c 64 20 61 6c 73 ;; we could als
1e30: 6f 20 63 68 65 63 6b 20 74 68 61 74 20 74 68 65 o check that the
1e40: 20 72 65 74 75 72 6e 65 64 20 74 79 70 65 73 20 returned types
1e50: 61 72 65 20 76 61 6c 69 64 0a 09 09 09 20 20 20 are valid....
1e60: 20 20 20 28 76 65 63 74 6f 72 20 23 74 20 27 28 (vector #t '(
1e70: 29 29 29 29 0a 09 20 28 73 75 63 63 65 73 73 20 )))).. (success
1e80: 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 (vector-r
1e90: 65 66 20 72 65 73 64 61 74 20 30 29 29 0a 09 20 ef resdat 0))..
1ea0: 28 72 65 73 20 20 20 20 20 20 20 20 20 20 20 20 (res
1eb0: 28 76 65 63 74 6f 72 2d 72 65 66 20 72 65 73 64 (vector-ref resd
1ec0: 61 74 20 31 29 29 0a 09 20 28 64 75 72 61 74 69 at 1)).. (durati
1ed0: 6f 6e 20 20 20 20 20 20 20 28 2d 20 28 63 75 72 on (- (cur
1ee0: 72 65 6e 74 2d 6d 69 6c 6c 69 73 65 63 6f 6e 64 rent-millisecond
1ef0: 73 29 20 73 74 61 72 74 29 29 29 0a 20 20 20 20 s) start))).
1f00: 28 69 66 20 28 61 6e 64 20 72 65 61 64 2d 6f 6e (if (and read-on
1f10: 6c 79 20 71 72 79 2d 69 73 2d 77 72 69 74 65 29 ly qry-is-write)
1f20: 0a 20 20 20 20 20 20 20 20 28 64 65 62 75 67 3a . (debug:
1f30: 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
1f40: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 45 52 52 4f -log-port* "ERRO
1f50: 52 3a 20 61 74 74 65 6d 70 74 20 74 6f 20 77 72 R: attempt to wr
1f60: 69 74 65 20 74 6f 20 72 65 61 64 2d 6f 6e 6c 79 ite to read-only
1f70: 20 64 61 74 61 62 61 73 65 20 69 67 6e 6f 72 65 database ignore
1f80: 64 2e 20 63 6d 64 3d 22 20 63 6d 64 29 29 0a 20 d. cmd=" cmd)).
1f90: 20 20 20 28 69 66 20 28 6e 6f 74 20 73 75 63 63 (if (not succ
1fa0: 65 73 73 29 0a 09 28 69 66 20 28 3e 20 72 65 6d ess)..(if (> rem
1fb0: 72 65 74 72 69 65 73 20 30 29 0a 09 20 20 20 20 retries 0)..
1fc0: 28 62 65 67 69 6e 0a 09 20 20 20 20 20 20 28 64 (begin.. (d
1fd0: 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 ebug:print-error
1fe0: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
1ff0: 70 6f 72 74 2a 20 22 6c 6f 63 61 6c 20 71 75 65 port* "local que
2000: 72 79 20 66 61 69 6c 65 64 2e 20 54 72 79 69 6e ry failed. Tryin
2010: 67 20 61 67 61 69 6e 2e 22 29 0a 09 20 20 20 20 g again.")..
2020: 20 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 (thread-sleep!
2030: 20 28 2f 20 28 72 61 6e 64 6f 6d 20 35 30 30 30 (/ (random 5000
2040: 29 20 31 30 30 30 29 29 20 3b 3b 20 73 6f 6d 65 ) 1000)) ;; some
2050: 20 72 61 6e 64 6f 6d 20 64 65 6c 61 79 20 0a 09 random delay ..
2060: 20 20 20 20 20 20 28 72 6d 74 3a 6f 70 65 6e 2d (rmt:open-
2070: 71 72 79 2d 63 6c 6f 73 65 2d 6c 6f 63 61 6c 6c qry-close-locall
2080: 79 20 63 6d 64 20 72 75 6e 2d 69 64 20 70 61 72 y cmd run-id par
2090: 61 6d 73 20 72 65 6d 72 65 74 72 69 65 73 3a 20 ams remretries:
20a0: 28 2d 20 72 65 6d 72 65 74 72 69 65 73 20 31 29 (- remretries 1)
20b0: 29 29 0a 09 20 20 20 20 28 62 65 67 69 6e 0a 09 )).. (begin..
20c0: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
20d0: 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 nt-error 0 *defa
20e0: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 74 ult-log-port* "t
20f0: 6f 6f 20 6d 61 6e 79 20 72 65 74 72 69 65 73 20 oo many retries
2100: 69 6e 20 72 6d 74 3a 6f 70 65 6e 2d 71 72 79 2d in rmt:open-qry-
2110: 63 6c 6f 73 65 2d 6c 6f 63 61 6c 6c 79 2c 20 67 close-locally, g
2120: 69 76 69 6e 67 20 75 70 22 29 0a 09 20 20 20 20 iving up")..
2130: 20 20 23 66 29 29 0a 09 28 62 65 67 69 6e 0a 09 #f))..(begin..
2140: 20 20 3b 3b 20 28 72 6d 74 3a 75 70 64 61 74 65 ;; (rmt:update
2150: 2d 64 62 2d 73 74 61 74 73 20 72 75 6e 2d 69 64 -db-stats run-id
2160: 20 63 6d 64 20 70 61 72 61 6d 73 20 64 75 72 61 cmd params dura
2170: 74 69 6f 6e 29 0a 09 20 20 3b 3b 20 6d 61 72 6b tion).. ;; mark
2180: 20 74 68 69 73 20 72 75 6e 20 61 73 20 64 69 72 this run as dir
2190: 74 79 20 69 66 20 74 68 69 73 20 77 61 73 20 61 ty if this was a
21a0: 20 77 72 69 74 65 2c 20 74 68 65 20 77 61 74 63 write, the watc
21b0: 68 64 6f 67 20 69 73 20 72 65 73 70 6f 6e 73 69 hdog is responsi
21c0: 62 6c 65 20 66 6f 72 20 73 79 6e 63 69 6e 67 20 ble for syncing
21d0: 69 74 0a 09 20 20 28 69 66 20 71 72 79 2d 69 73 it.. (if qry-is
21e0: 2d 77 72 69 74 65 0a 09 20 20 20 20 20 20 28 6c -write.. (l
21f0: 65 74 20 28 28 73 74 61 72 74 2d 74 69 6d 65 20 et ((start-time
2200: 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 (current-seconds
2210: 29 29 29 0a 09 09 28 6d 75 74 65 78 2d 6c 6f 63 )))...(mutex-loc
2220: 6b 21 20 2a 64 62 2d 6d 75 6c 74 69 2d 73 79 6e k! *db-multi-syn
2230: 63 2d 6d 75 74 65 78 2a 29 0a 09 09 28 73 65 74 c-mutex*)...(set
2240: 21 20 2a 64 62 2d 6c 61 73 74 2d 61 63 63 65 73 ! *db-last-acces
2250: 73 2a 20 73 74 61 72 74 2d 74 69 6d 65 29 20 20 s* start-time)
2260: 3b 3b 20 54 48 49 53 20 49 53 20 50 52 4f 42 41 ;; THIS IS PROBA
2270: 42 4c 59 20 55 53 45 4c 45 53 53 3f 20 28 77 65 BLY USELESS? (we
2280: 20 61 72 65 20 6f 6e 20 61 20 63 6c 69 65 6e 74 are on a client
2290: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
22a0: 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 (mutex-unlock!
22b0: 20 2a 64 62 2d 6d 75 6c 74 69 2d 73 79 6e 63 2d *db-multi-sync-
22c0: 6d 75 74 65 78 2a 29 29 29 29 29 0a 20 20 20 20 mutex*))))).
22d0: 72 65 73 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d res))..;;=======
22e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
22f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2300: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2310: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
2320: 3b 3b 0a 3b 3b 20 41 20 43 20 54 20 55 20 41 20 ;;.;; A C T U A
2330: 4c 20 20 20 41 20 50 20 49 20 20 20 43 20 41 20 L A P I C A
2340: 4c 20 4c 20 53 20 20 0a 3b 3b 0a 3b 3b 3d 3d 3d L L S .;;.;;===
2350: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2390: 3d 3d 3d 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d ===..;;=========
23a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
23b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
23c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
23d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
23e0: 20 20 53 20 45 20 52 20 56 20 45 20 52 0a 3b 3b S E R V E R.;;
23f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2400: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2410: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2420: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2430: 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 ======..(define
2440: 28 72 6d 74 3a 6b 69 6c 6c 2d 73 65 72 76 65 72 (rmt:kill-server
2450: 20 72 75 6e 2d 69 64 29 0a 20 20 28 72 6d 74 3a run-id). (rmt:
2460: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 6b 69 send-receive 'ki
2470: 6c 6c 2d 73 65 72 76 65 72 20 72 75 6e 2d 69 64 ll-server run-id
2480: 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 29 29 29 (list run-id)))
2490: 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 73 ..(define (rmt:s
24a0: 74 61 72 74 2d 73 65 72 76 65 72 20 61 72 65 61 tart-server area
24b0: 70 61 74 68 20 74 65 73 74 73 75 69 74 65 20 6d path testsuite m
24c0: 74 65 78 65 20 72 75 6e 2d 69 64 29 20 3b 3b 20 texe run-id) ;;
24d0: 72 75 6e 20 6f 6e 20 6d 61 69 6e 2e 64 62 20 73 run on main.db s
24e0: 65 72 76 65 72 0a 20 20 28 72 6d 74 3a 73 65 6e erver. (rmt:sen
24f0: 64 2d 72 65 63 65 69 76 65 20 27 73 74 61 72 74 d-receive 'start
2500: 2d 73 65 72 76 65 72 20 23 66 20 28 6c 69 73 74 -server #f (list
2510: 20 61 72 65 61 70 61 74 68 20 74 65 73 74 73 75 areapath testsu
2520: 69 74 65 20 6d 74 65 78 65 20 72 75 6e 2d 69 64 ite mtexe run-id
2530: 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
2540: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2550: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2560: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2570: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
2580: 20 20 4d 20 49 20 53 20 43 0a 3b 3b 3d 3d 3d 3d M I S C.;;====
2590: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
25a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
25b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
25c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
25d0: 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 ==..(define (rmt
25e0: 3a 6c 6f 67 69 6e 20 72 75 6e 2d 69 64 29 0a 20 :login run-id).
25f0: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
2600: 76 65 20 27 6c 6f 67 69 6e 20 72 75 6e 2d 69 64 ve 'login run-id
2610: 20 28 6c 69 73 74 20 2a 74 6f 70 70 61 74 68 2a (list *toppath*
2620: 20 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f megatest-versio
2630: 6e 20 28 63 6c 69 65 6e 74 3a 67 65 74 2d 73 69 n (client:get-si
2640: 67 6e 61 74 75 72 65 29 29 29 29 0a 0a 3b 3b 20 gnature))))..;;
2650: 54 68 69 73 20 6c 6f 67 69 6e 20 64 6f 65 73 20 This login does
2660: 6e 6f 20 72 65 74 72 69 65 73 20 75 6e 64 65 72 no retries under
2670: 20 74 68 65 20 68 6f 6f 64 20 2d 20 69 74 20 61 the hood - it a
2680: 63 74 73 20 61 20 62 69 74 20 6c 69 6b 65 20 61 cts a bit like a
2690: 20 70 69 6e 67 2e 0a 3b 3b 20 44 65 70 72 65 63 ping..;; Deprec
26a0: 61 74 65 64 20 66 6f 72 20 6e 6d 73 67 2d 74 72 ated for nmsg-tr
26b0: 61 6e 73 70 6f 72 74 2e 0a 3b 3b 0a 3b 3b 20 28 ansport..;;.;; (
26c0: 64 65 66 69 6e 65 20 28 72 6d 74 3a 6c 6f 67 69 define (rmt:logi
26d0: 6e 2d 6e 6f 2d 61 75 74 6f 2d 63 6c 69 65 6e 74 n-no-auto-client
26e0: 2d 73 65 74 75 70 20 72 75 6e 72 65 6d 6f 74 65 -setup runremote
26f0: 29 0a 3b 3b 20 20 20 28 72 6d 74 3a 73 65 6e 64 ).;; (rmt:send
2700: 2d 72 65 63 65 69 76 65 2d 6e 6f 2d 61 75 74 6f -receive-no-auto
2710: 2d 63 6c 69 65 6e 74 2d 73 65 74 75 70 20 72 75 -client-setup ru
2720: 6e 72 65 6d 6f 74 65 20 27 6c 6f 67 69 6e 20 23 nremote 'login #
2730: 66 20 28 6c 69 73 74 20 2a 74 6f 70 70 61 74 68 f (list *toppath
2740: 2a 20 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 * megatest-versi
2750: 6f 6e 20 28 63 6c 69 65 6e 74 3a 67 65 74 2d 73 on (client:get-s
2760: 69 67 6e 61 74 75 72 65 29 29 29 29 0a 0a 0a 3b ignature))))...;
2770: 3b 20 67 69 76 65 6e 20 61 20 68 6f 73 74 6e 61 ; given a hostna
2780: 6d 65 2c 20 72 65 74 75 72 6e 20 61 20 70 61 69 me, return a pai
2790: 72 20 6f 66 20 63 70 75 20 6c 6f 61 64 20 61 6e r of cpu load an
27a0: 64 20 75 70 64 61 74 65 20 74 69 6d 65 20 72 65 d update time re
27b0: 70 72 65 73 65 6e 74 69 6e 67 20 6c 61 74 65 73 presenting lates
27c0: 74 20 69 6e 74 65 6c 6c 69 67 65 6e 63 65 20 66 t intelligence f
27d0: 72 6f 6d 20 74 65 73 74 73 20 72 75 6e 6e 69 6e rom tests runnin
27e0: 67 20 6f 6e 20 74 68 61 74 20 68 6f 73 74 0a 28 g on that host.(
27f0: 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d define (rmt:get-
2800: 6c 61 74 65 73 74 2d 68 6f 73 74 2d 6c 6f 61 64 latest-host-load
2810: 20 68 6f 73 74 6e 61 6d 65 29 0a 20 20 28 72 6d hostname). (rm
2820: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
2830: 67 65 74 2d 6c 61 74 65 73 74 2d 68 6f 73 74 2d get-latest-host-
2840: 6c 6f 61 64 20 23 66 20 28 6c 69 73 74 20 68 6f load #f (list ho
2850: 73 74 6e 61 6d 65 29 29 29 0a 0a 28 64 65 66 69 stname)))..(defi
2860: 6e 65 20 28 72 6d 74 3a 73 64 62 2d 71 72 79 20 ne (rmt:sdb-qry
2870: 71 72 79 20 76 61 6c 20 72 75 6e 2d 69 64 29 0a qry val run-id).
2880: 20 20 3b 3b 20 61 64 64 20 63 61 63 68 69 6e 67 ;; add caching
2890: 20 69 66 20 71 72 79 20 69 73 20 27 67 65 74 69 if qry is 'geti
28a0: 64 20 6f 72 20 27 67 65 74 73 74 72 0a 20 20 28 d or 'getstr. (
28b0: 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 rmt:send-receive
28c0: 20 27 73 64 62 2d 71 72 79 20 72 75 6e 2d 69 64 'sdb-qry run-id
28d0: 20 28 6c 69 73 74 20 71 72 79 20 76 61 6c 29 29 (list qry val))
28e0: 29 0a 0a 3b 3b 20 4e 4f 54 20 43 4f 4d 50 4c 45 )..;; NOT COMPLE
28f0: 54 45 44 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 TED.(define (rmt
2900: 3a 72 75 6e 74 65 73 74 73 20 75 73 65 72 20 72 :runtests user r
2910: 75 6e 2d 69 64 20 74 65 73 74 70 61 74 74 20 70 un-id testpatt p
2920: 61 72 61 6d 73 29 0a 20 20 28 72 6d 74 3a 73 65 arams). (rmt:se
2930: 6e 64 2d 72 65 63 65 69 76 65 20 27 72 75 6e 74 nd-receive 'runt
2940: 65 73 74 73 20 72 75 6e 2d 69 64 20 74 65 73 74 ests run-id test
2950: 70 61 74 74 29 29 0a 0a 28 64 65 66 69 6e 65 20 patt))..(define
2960: 28 72 6d 74 3a 67 65 74 2d 72 75 6e 2d 72 65 63 (rmt:get-run-rec
2970: 6f 72 64 2d 69 64 73 20 20 74 61 72 67 65 74 20 ord-ids target
2980: 72 75 6e 20 6b 65 79 6e 61 6d 65 73 20 29 0a 20 run keynames ).
2990: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
29a0: 76 65 20 27 67 65 74 2d 72 75 6e 2d 72 65 63 6f ve 'get-run-reco
29b0: 72 64 2d 69 64 73 20 23 66 20 28 6c 69 73 74 20 rd-ids #f (list
29c0: 74 61 72 67 65 74 20 72 75 6e 20 6b 65 79 6e 61 target run keyna
29d0: 6d 65 73 20 29 29 29 0a 0a 28 64 65 66 69 6e 65 mes )))..(define
29e0: 20 28 72 6d 74 3a 67 65 74 2d 63 68 61 6e 67 65 (rmt:get-change
29f0: 64 2d 72 65 63 6f 72 64 2d 69 64 73 20 73 69 6e d-record-ids sin
2a00: 63 65 2d 74 69 6d 65 29 0a 20 20 28 72 6d 74 3a ce-time). (rmt:
2a10: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 send-receive 'ge
2a20: 74 2d 63 68 61 6e 67 65 64 2d 72 65 63 6f 72 64 t-changed-record
2a30: 2d 69 64 73 20 23 66 20 28 6c 69 73 74 20 73 69 -ids #f (list si
2a40: 6e 63 65 2d 74 69 6d 65 29 29 20 29 0a 0a 28 64 nce-time)) )..(d
2a50: 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 61 efine (rmt:get-a
2a60: 6c 6c 2d 72 75 6e 69 64 73 29 0a 20 20 28 72 6d ll-runids). (rm
2a70: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
2a80: 67 65 74 2d 61 6c 6c 2d 72 75 6e 2d 69 64 73 20 get-all-run-ids
2a90: 23 66 20 27 28 29 29 20 29 0a 0a 28 64 65 66 69 #f '()) )..(defi
2aa0: 6e 65 20 28 72 6d 74 3a 67 65 74 2d 63 68 61 6e ne (rmt:get-chan
2ab0: 67 65 64 2d 72 65 63 6f 72 64 2d 72 75 6e 2d 69 ged-record-run-i
2ac0: 64 73 20 73 69 6e 63 65 2d 74 69 6d 65 29 0a 20 ds since-time).
2ad0: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
2ae0: 76 65 20 27 67 65 74 2d 63 68 61 6e 67 65 64 2d ve 'get-changed-
2af0: 72 65 63 6f 72 64 2d 72 75 6e 2d 69 64 73 20 23 record-run-ids #
2b00: 66 20 28 6c 69 73 74 20 73 69 6e 63 65 2d 74 69 f (list since-ti
2b10: 6d 65 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 me)))..(define (
2b20: 72 6d 74 3a 67 65 74 2d 63 68 61 6e 67 65 64 2d rmt:get-changed-
2b30: 72 65 63 6f 72 64 2d 74 65 73 74 2d 69 64 73 20 record-test-ids
2b40: 72 75 6e 2d 69 64 20 73 69 6e 63 65 2d 74 69 6d run-id since-tim
2b50: 65 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 e). (rmt:send-r
2b60: 65 63 65 69 76 65 20 27 67 65 74 2d 63 68 61 6e eceive 'get-chan
2b70: 67 65 64 2d 72 65 63 6f 72 64 2d 74 65 73 74 2d ged-record-test-
2b80: 69 64 73 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 ids run-id (list
2b90: 20 73 69 6e 63 65 2d 74 69 6d 65 20 72 75 6e 2d since-time run-
2ba0: 69 64 29 29 29 0a 0a 0a 0a 28 64 65 66 69 6e 65 id)))....(define
2bb0: 20 28 72 6d 74 3a 64 72 6f 70 2d 61 6c 6c 2d 74 (rmt:drop-all-t
2bc0: 72 69 67 67 65 72 73 29 0a 20 20 20 20 20 28 72 riggers). (r
2bd0: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
2be0: 27 64 72 6f 70 2d 61 6c 6c 2d 74 72 69 67 67 65 'drop-all-trigge
2bf0: 72 73 20 23 66 20 27 28 29 29 29 0a 0a 28 64 65 rs #f '()))..(de
2c00: 66 69 6e 65 20 28 72 6d 74 3a 63 72 65 61 74 65 fine (rmt:create
2c10: 2d 61 6c 6c 2d 74 72 69 67 67 65 72 73 29 0a 20 -all-triggers).
2c20: 20 20 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 (rmt:send-re
2c30: 63 65 69 76 65 20 27 63 72 65 61 74 65 2d 61 6c ceive 'create-al
2c40: 6c 2d 74 72 69 67 67 65 72 73 20 23 66 20 27 28 l-triggers #f '(
2c50: 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
2c60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2c70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2c80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2c90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
2ca0: 20 20 54 20 45 20 53 20 54 20 20 20 4d 20 45 20 T E S T M E
2cb0: 54 20 41 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d T A .;;=========
2cc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2cd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2ce0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2cf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 =============..(
2d00: 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d define (rmt:get-
2d10: 74 65 73 74 73 2d 74 61 67 73 29 0a 20 20 28 72 tests-tags). (r
2d20: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
2d30: 27 67 65 74 2d 74 65 73 74 73 2d 74 61 67 73 20 'get-tests-tags
2d40: 23 66 20 27 28 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d #f '()))..;;====
2d50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2d60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2d70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2d80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2d90: 3d 3d 0a 3b 3b 20 20 4b 20 45 20 59 20 53 20 0a ==.;; K E Y S .
2da0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
2db0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2dc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2dd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2de0: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 54 68 65 ========..;; The
2df0: 73 65 20 72 65 71 75 69 72 65 20 72 75 6e 2d 69 se require run-i
2e00: 64 20 62 65 63 61 75 73 65 20 74 68 65 20 76 61 d because the va
2e10: 6c 75 65 73 20 63 6f 6d 65 20 66 72 6f 6d 20 74 lues come from t
2e20: 68 65 20 72 75 6e 21 0a 3b 3b 20 68 6f 77 65 76 he run!.;; howev
2e30: 65 72 20 74 68 65 20 71 75 65 72 79 20 6d 75 73 er the query mus
2e40: 74 20 73 74 69 6c 6c 20 61 70 70 6c 79 20 74 6f t still apply to
2e50: 20 6d 61 69 6e 2e 64 62 0a 3b 3b 0a 28 64 65 66 main.db.;;.(def
2e60: 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 6b 65 79 ine (rmt:get-key
2e70: 2d 76 61 6c 2d 70 61 69 72 73 20 72 75 6e 2d 69 -val-pairs run-i
2e80: 64 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 d). (rmt:send-r
2e90: 65 63 65 69 76 65 20 27 67 65 74 2d 6b 65 79 2d eceive 'get-key-
2ea0: 76 61 6c 2d 70 61 69 72 73 20 23 66 20 28 6c 69 val-pairs #f (li
2eb0: 73 74 20 72 75 6e 2d 69 64 29 29 29 0a 0a 28 64 st run-id)))..(d
2ec0: 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 6b efine (rmt:get-k
2ed0: 65 79 73 29 0a 20 20 28 69 66 20 2a 64 62 2d 6b eys). (if *db-k
2ee0: 65 79 73 2a 20 2a 64 62 2d 6b 65 79 73 2a 20 0a eys* *db-keys* .
2ef0: 20 20 20 20 20 28 6c 65 74 20 28 28 72 65 73 20 (let ((res
2f00: 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 (rmt:send-receiv
2f10: 65 20 27 67 65 74 2d 6b 65 79 73 20 23 66 20 27 e 'get-keys #f '
2f20: 28 29 29 29 29 0a 20 20 20 20 20 20 20 28 73 65 ()))). (se
2f30: 74 21 20 2a 64 62 2d 6b 65 79 73 2a 20 72 65 73 t! *db-keys* res
2f40: 29 0a 20 20 20 20 20 20 20 72 65 73 29 29 29 0a ). res))).
2f50: 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 .(define (rmt:ge
2f60: 74 2d 6b 65 79 73 2d 77 72 69 74 65 29 20 3b 3b t-keys-write) ;;
2f70: 20 64 75 6d 6d 79 20 71 75 65 72 79 20 74 6f 20 dummy query to
2f80: 66 6f 72 63 65 20 73 65 72 76 65 72 20 73 74 61 force server sta
2f90: 72 74 0a 20 20 28 6c 65 74 20 28 28 72 65 73 20 rt. (let ((res
2fa0: 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 (rmt:send-receiv
2fb0: 65 20 27 67 65 74 2d 6b 65 79 73 2d 77 72 69 74 e 'get-keys-writ
2fc0: 65 20 23 66 20 27 28 29 29 29 29 0a 20 20 20 20 e #f '()))).
2fd0: 28 73 65 74 21 20 2a 64 62 2d 6b 65 79 73 2a 20 (set! *db-keys*
2fe0: 72 65 73 29 0a 20 20 20 20 72 65 73 29 29 0a 0a res). res))..
2ff0: 3b 3b 20 77 65 20 64 6f 6e 27 74 20 72 65 75 73 ;; we don't reus
3000: 65 20 72 75 6e 2d 69 64 27 73 20 28 65 78 63 65 e run-id's (exce
3010: 70 74 20 70 6f 73 73 69 62 6c 79 20 2a 61 66 74 pt possibly *aft
3020: 65 72 2a 20 61 20 64 62 20 63 6c 65 61 6e 75 70 er* a db cleanup
3030: 29 20 73 6f 20 69 74 20 69 73 20 73 61 66 65 0a ) so it is safe.
3040: 3b 3b 20 74 6f 20 63 61 63 68 65 20 74 68 65 20 ;; to cache the
3050: 72 65 73 75 6c 73 20 69 6e 20 61 20 68 61 73 68 resuls in a hash
3060: 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 .;;.(define (rmt
3070: 3a 67 65 74 2d 6b 65 79 2d 76 61 6c 73 20 72 75 :get-key-vals ru
3080: 6e 2d 69 64 29 0a 20 20 28 6f 72 20 28 68 61 73 n-id). (or (has
3090: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
30a0: 75 6c 74 20 2a 6b 65 79 76 61 6c 73 2a 20 72 75 ult *keyvals* ru
30b0: 6e 2d 69 64 20 23 66 29 0a 20 20 20 20 20 20 28 n-id #f). (
30c0: 6c 65 74 20 28 28 72 65 73 20 28 72 6d 74 3a 73 let ((res (rmt:s
30d0: 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 end-receive 'get
30e0: 2d 6b 65 79 2d 76 61 6c 73 20 23 66 20 28 6c 69 -key-vals #f (li
30f0: 73 74 20 72 75 6e 2d 69 64 29 29 29 29 0a 20 20 st run-id)))).
3100: 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c (hash-tabl
3110: 65 2d 73 65 74 21 20 2a 6b 65 79 76 61 6c 73 2a e-set! *keyvals*
3120: 20 72 75 6e 2d 69 64 20 72 65 73 29 0a 20 20 20 run-id res).
3130: 20 20 20 20 20 72 65 73 29 29 29 0a 0a 28 64 65 res)))..(de
3140: 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 74 61 fine (rmt:get-ta
3150: 72 67 65 74 73 29 0a 20 20 28 72 6d 74 3a 73 65 rgets). (rmt:se
3160: 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d nd-receive 'get-
3170: 74 61 72 67 65 74 73 20 23 66 20 27 28 29 29 29 targets #f '()))
3180: 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 ..(define (rmt:g
3190: 65 74 2d 74 61 72 67 65 74 20 72 75 6e 2d 69 64 et-target run-id
31a0: 29 0a 20 20 28 61 73 73 65 72 74 20 28 6e 75 6d ). (assert (num
31b0: 62 65 72 3f 20 72 75 6e 2d 69 64 29 20 22 46 41 ber? run-id) "FA
31c0: 54 41 4c 3a 20 52 75 6e 20 69 64 20 72 65 71 75 TAL: Run id requ
31d0: 69 72 65 64 2e 22 29 0a 20 20 28 72 6d 74 3a 73 ired."). (rmt:s
31e0: 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 end-receive 'get
31f0: 2d 74 61 72 67 65 74 20 23 66 20 28 6c 69 73 74 -target #f (list
3200: 20 72 75 6e 2d 69 64 29 29 29 0a 0a 28 64 65 66 run-id)))..(def
3210: 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e ine (rmt:get-run
3220: 2d 74 69 6d 65 73 20 72 75 6e 70 61 74 74 20 74 -times runpatt t
3230: 61 72 67 65 74 70 61 74 74 29 0a 20 20 28 72 6d argetpatt). (rm
3240: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
3250: 67 65 74 2d 72 75 6e 2d 74 69 6d 65 73 20 23 66 get-run-times #f
3260: 20 28 6c 69 73 74 20 72 75 6e 70 61 74 74 20 74 (list runpatt t
3270: 61 72 67 65 74 70 61 74 74 20 29 29 29 20 0a 0a argetpatt ))) ..
3280: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
3290: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
32a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
32b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
32c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 20 54 20 =========.;; T
32d0: 45 20 53 20 54 20 53 0a 3b 3b 3d 3d 3d 3d 3d 3d E S T S.;;======
32e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
32f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3300: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3310: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3320: 0a 0a 3b 3b 20 49 44 45 41 3a 20 54 68 72 65 61 ..;; IDEA: Threa
3330: 64 69 66 79 20 74 68 65 73 65 20 2d 20 74 68 65 dify these - the
3340: 79 20 73 70 65 6e 64 20 61 20 6c 6f 74 20 6f 66 y spend a lot of
3350: 20 74 69 6d 65 20 77 61 69 74 69 6e 67 20 2e 2e time waiting ..
3360: 2e 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 72 6d ..;;.(define (rm
3370: 74 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d t:get-tests-for-
3380: 72 75 6e 73 2d 6d 69 6e 64 61 74 61 20 72 75 6e runs-mindata run
3390: 2d 69 64 73 20 74 65 73 74 70 61 74 74 20 73 74 -ids testpatt st
33a0: 61 74 65 73 20 73 74 61 74 75 73 20 6e 6f 74 2d ates status not-
33b0: 69 6e 29 0a 20 20 28 6c 65 74 20 28 28 6d 75 6c in). (let ((mul
33c0: 74 69 2d 72 75 6e 2d 6d 75 74 65 78 20 28 6d 61 ti-run-mutex (ma
33d0: 6b 65 2d 6d 75 74 65 78 29 29 0a 09 28 72 75 6e ke-mutex))..(run
33e0: 2d 69 64 2d 6c 69 73 74 20 28 69 66 20 72 75 6e -id-list (if run
33f0: 2d 69 64 73 0a 09 09 09 20 72 75 6e 2d 69 64 73 -ids.... run-ids
3400: 0a 09 09 09 20 28 72 6d 74 3a 67 65 74 2d 61 6c .... (rmt:get-al
3410: 6c 2d 72 75 6e 2d 69 64 73 29 29 29 0a 09 28 72 l-run-ids)))..(r
3420: 65 73 75 6c 74 20 20 20 20 20 20 27 28 29 29 29 esult '()))
3430: 0a 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 . (if (null?
3440: 72 75 6e 2d 69 64 2d 6c 69 73 74 29 0a 09 27 28 run-id-list)..'(
3450: 29 0a 09 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 )..(let loop ((h
3460: 65 64 20 20 20 20 20 28 63 61 72 20 72 75 6e 2d ed (car run-
3470: 69 64 2d 6c 69 73 74 29 29 0a 09 09 20 20 20 28 id-list))... (
3480: 74 61 6c 20 20 20 20 20 28 63 64 72 20 72 75 6e tal (cdr run
3490: 2d 69 64 2d 6c 69 73 74 29 29 0a 09 09 20 20 20 -id-list))...
34a0: 28 74 68 72 65 61 64 73 20 27 28 29 29 29 0a 09 (threads '()))..
34b0: 20 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 68 (if (> (length
34c0: 20 74 68 72 65 61 64 73 29 20 35 29 0a 09 20 20 threads) 5)..
34d0: 20 20 20 20 28 6c 6f 6f 70 20 68 65 64 20 74 61 (loop hed ta
34e0: 6c 20 28 66 69 6c 74 65 72 20 28 6c 61 6d 62 64 l (filter (lambd
34f0: 61 20 28 74 68 29 28 6e 6f 74 20 28 6d 65 6d 62 a (th)(not (memb
3500: 65 72 20 28 74 68 72 65 61 64 2d 73 74 61 74 65 er (thread-state
3510: 20 74 68 29 20 27 28 74 65 72 6d 69 6e 61 74 65 th) '(terminate
3520: 64 20 64 65 61 64 29 29 29 29 20 74 68 72 65 61 d dead)))) threa
3530: 64 73 29 29 0a 09 20 20 20 20 20 20 28 6c 65 74 ds)).. (let
3540: 2a 20 28 28 6e 65 77 74 68 72 65 61 64 20 28 6d * ((newthread (m
3550: 61 6b 65 2d 74 68 72 65 61 64 0a 09 09 09 09 20 ake-thread.....
3560: 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 09 20 (lambda ().....
3570: 20 20 28 6c 65 74 20 28 28 72 65 73 20 28 72 6d (let ((res (rm
3580: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
3590: 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 get-tests-for-ru
35a0: 6e 2d 6d 69 6e 64 61 74 61 20 68 65 64 20 28 6c n-mindata hed (l
35b0: 69 73 74 20 68 65 64 20 74 65 73 74 70 61 74 74 ist hed testpatt
35c0: 20 73 74 61 74 65 73 20 73 74 61 74 75 73 20 6e states status n
35d0: 6f 74 2d 69 6e 29 29 29 29 0a 09 09 09 09 20 20 ot-in)))).....
35e0: 20 20 20 28 69 66 20 28 6c 69 73 74 3f 20 72 65 (if (list? re
35f0: 73 29 0a 09 09 09 09 09 20 28 62 65 67 69 6e 0a s)...... (begin.
3600: 09 09 09 09 09 20 20 20 28 6d 75 74 65 78 2d 6c ..... (mutex-l
3610: 6f 63 6b 21 20 6d 75 6c 74 69 2d 72 75 6e 2d 6d ock! multi-run-m
3620: 75 74 65 78 29 0a 09 09 09 09 09 20 20 20 28 73 utex)...... (s
3630: 65 74 21 20 72 65 73 75 6c 74 20 28 61 70 70 65 et! result (appe
3640: 6e 64 20 72 65 73 75 6c 74 20 72 65 73 29 29 0a nd result res)).
3650: 09 09 09 09 09 20 20 20 28 6d 75 74 65 78 2d 75 ..... (mutex-u
3660: 6e 6c 6f 63 6b 21 20 6d 75 6c 74 69 2d 72 75 6e nlock! multi-run
3670: 2d 6d 75 74 65 78 29 29 0a 09 09 09 09 09 20 28 -mutex))...... (
3680: 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f debug:print-erro
3690: 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 r 0 *default-log
36a0: 2d 70 6f 72 74 2a 20 22 67 65 74 2d 74 65 73 74 -port* "get-test
36b0: 73 2d 66 6f 72 2d 72 75 6e 2d 6d 69 6e 64 61 74 s-for-run-mindat
36c0: 61 20 66 61 69 6c 65 64 20 66 6f 72 20 72 75 6e a failed for run
36d0: 2d 69 64 20 22 20 68 65 64 20 22 2c 20 74 65 73 -id " hed ", tes
36e0: 74 70 61 74 74 20 22 20 74 65 73 74 70 61 74 74 tpatt " testpatt
36f0: 20 22 2c 20 73 74 61 74 65 73 20 22 20 73 74 61 ", states " sta
3700: 74 65 73 20 22 2c 20 73 74 61 74 75 73 20 22 20 tes ", status "
3710: 73 74 61 74 75 73 20 22 2c 20 6e 6f 74 2d 69 6e status ", not-in
3720: 20 22 20 6e 6f 74 2d 69 6e 29 29 29 29 0a 09 09 " not-in))))...
3730: 09 09 20 28 63 6f 6e 63 20 22 6d 75 6c 74 69 2d .. (conc "multi-
3740: 72 75 6e 2d 74 68 72 65 61 64 20 66 6f 72 20 72 run-thread for r
3750: 75 6e 2d 69 64 20 22 20 68 65 64 29 29 29 0a 09 un-id " hed)))..
3760: 09 20 20 20 20 20 28 6e 65 77 74 68 72 65 61 64 . (newthread
3770: 73 20 28 63 6f 6e 73 20 6e 65 77 74 68 72 65 61 s (cons newthrea
3780: 64 20 74 68 72 65 61 64 73 29 29 29 0a 09 09 28 d threads)))...(
3790: 74 68 72 65 61 64 2d 73 74 61 72 74 21 20 6e 65 thread-start! ne
37a0: 77 74 68 72 65 61 64 29 0a 09 09 28 74 68 72 65 wthread)...(thre
37b0: 61 64 2d 73 6c 65 65 70 21 20 30 2e 30 35 29 20 ad-sleep! 0.05)
37c0: 3b 3b 20 67 69 76 65 20 74 68 61 74 20 74 68 72 ;; give that thr
37d0: 65 61 64 20 73 6f 6d 65 20 74 69 6d 65 20 74 6f ead some time to
37e0: 20 73 74 61 72 74 0a 09 09 28 69 66 20 28 6e 75 start...(if (nu
37f0: 6c 6c 3f 20 74 61 6c 29 0a 09 09 20 20 20 20 6e ll? tal)... n
3800: 65 77 74 68 72 65 61 64 73 0a 09 09 20 20 20 20 ewthreads...
3810: 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 28 (loop (car tal)(
3820: 63 64 72 20 74 61 6c 29 20 6e 65 77 74 68 72 65 cdr tal) newthre
3830: 61 64 73 29 29 29 29 29 29 0a 20 20 20 20 72 65 ads)))))). re
3840: 73 75 6c 74 29 29 0a 0a 3b 3b 20 3b 3b 20 49 44 sult))..;; ;; ID
3850: 45 41 3a 20 54 68 72 65 61 64 69 66 79 20 74 68 EA: Threadify th
3860: 65 73 65 20 2d 20 74 68 65 79 20 73 70 65 6e 64 ese - they spend
3870: 20 61 20 6c 6f 74 20 6f 66 20 74 69 6d 65 20 77 a lot of time w
3880: 61 69 74 69 6e 67 20 2e 2e 2e 0a 3b 3b 20 3b 3b aiting ....;; ;;
3890: 0a 3b 3b 20 28 64 65 66 69 6e 65 20 28 72 6d 74 .;; (define (rmt
38a0: 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 :get-tests-for-r
38b0: 75 6e 73 2d 6d 69 6e 64 61 74 61 20 72 75 6e 2d uns-mindata run-
38c0: 69 64 73 20 74 65 73 74 70 61 74 74 20 73 74 61 ids testpatt sta
38d0: 74 65 73 20 73 74 61 74 75 73 20 6e 6f 74 2d 69 tes status not-i
38e0: 6e 29 0a 3b 3b 20 20 20 28 6c 65 74 20 28 28 72 n).;; (let ((r
38f0: 75 6e 2d 69 64 2d 6c 69 73 74 20 28 69 66 20 72 un-id-list (if r
3900: 75 6e 2d 69 64 73 0a 3b 3b 20 09 09 09 20 72 75 un-ids.;; ... ru
3910: 6e 2d 69 64 73 0a 3b 3b 20 09 09 09 20 28 72 6d n-ids.;; ... (rm
3920: 74 3a 67 65 74 2d 61 6c 6c 2d 72 75 6e 2d 69 64 t:get-all-run-id
3930: 73 29 29 29 29 0a 3b 3b 20 20 20 20 20 28 61 70 s)))).;; (ap
3940: 70 6c 79 20 61 70 70 65 6e 64 20 28 6d 61 70 20 ply append (map
3950: 28 6c 61 6d 62 64 61 20 28 72 75 6e 2d 69 64 29 (lambda (run-id)
3960: 0a 3b 3b 20 09 09 09 20 28 72 6d 74 3a 73 65 6e .;; ... (rmt:sen
3970: 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d 74 d-receive 'get-t
3980: 65 73 74 73 2d 66 6f 72 2d 72 75 6e 2d 6d 69 6e ests-for-run-min
3990: 64 61 74 61 20 72 75 6e 2d 69 64 20 28 6c 69 73 data run-id (lis
39a0: 74 20 72 75 6e 2d 69 64 73 20 74 65 73 74 70 61 t run-ids testpa
39b0: 74 74 20 73 74 61 74 65 73 20 73 74 61 74 75 73 tt states status
39c0: 20 6e 6f 74 2d 69 6e 29 29 29 0a 3b 3b 20 09 09 not-in))).;; ..
39d0: 20 20 20 20 20 20 20 72 75 6e 2d 69 64 2d 6c 69 run-id-li
39e0: 73 74 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 st))))..(define
39f0: 28 72 6d 74 3a 64 65 6c 65 74 65 2d 74 65 73 74 (rmt:delete-test
3a00: 2d 72 65 63 6f 72 64 73 20 72 75 6e 2d 69 64 20 -records run-id
3a10: 74 65 73 74 2d 69 64 29 0a 20 20 28 61 73 73 65 test-id). (asse
3a20: 72 74 20 28 6e 75 6d 62 65 72 3f 20 72 75 6e 2d rt (number? run-
3a30: 69 64 29 20 22 46 41 54 41 4c 3a 20 52 75 6e 20 id) "FATAL: Run
3a40: 69 64 20 72 65 71 75 69 72 65 64 2e 22 29 0a 20 id required.").
3a50: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
3a60: 76 65 20 27 64 65 6c 65 74 65 2d 74 65 73 74 2d ve 'delete-test-
3a70: 72 65 63 6f 72 64 73 20 72 75 6e 2d 69 64 20 28 records run-id (
3a80: 6c 69 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 list run-id test
3a90: 2d 69 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 -id)))..(define
3aa0: 28 72 6d 74 3a 74 65 73 74 2d 73 65 74 2d 73 74 (rmt:test-set-st
3ab0: 61 74 65 2d 73 74 61 74 75 73 20 72 75 6e 2d 69 ate-status run-i
3ac0: 64 20 74 65 73 74 2d 69 64 20 73 74 61 74 65 20 d test-id state
3ad0: 73 74 61 74 75 73 20 6d 73 67 29 0a 20 20 28 61 status msg). (a
3ae0: 73 73 65 72 74 20 28 6e 75 6d 62 65 72 3f 20 72 ssert (number? r
3af0: 75 6e 2d 69 64 29 20 22 46 41 54 41 4c 3a 20 52 un-id) "FATAL: R
3b00: 75 6e 20 69 64 20 72 65 71 75 69 72 65 64 2e 22 un id required."
3b10: 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 ). (rmt:send-re
3b20: 63 65 69 76 65 20 27 74 65 73 74 2d 73 65 74 2d ceive 'test-set-
3b30: 73 74 61 74 65 2d 73 74 61 74 75 73 20 72 75 6e state-status run
3b40: 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 -id (list run-id
3b50: 20 74 65 73 74 2d 69 64 20 73 74 61 74 65 20 73 test-id state s
3b60: 74 61 74 75 73 20 6d 73 67 29 29 29 0a 0a 28 64 tatus msg)))..(d
3b70: 65 66 69 6e 65 20 28 72 6d 74 3a 74 65 73 74 2d efine (rmt:test-
3b80: 74 6f 70 6c 65 76 65 6c 2d 6e 75 6d 2d 69 74 65 toplevel-num-ite
3b90: 6d 73 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e ms run-id test-n
3ba0: 61 6d 65 29 0a 20 20 28 61 73 73 65 72 74 20 28 ame). (assert (
3bb0: 6e 75 6d 62 65 72 3f 20 72 75 6e 2d 69 64 29 20 number? run-id)
3bc0: 22 46 41 54 41 4c 3a 20 52 75 6e 20 69 64 20 72 "FATAL: Run id r
3bd0: 65 71 75 69 72 65 64 2e 22 29 0a 20 20 28 72 6d equired."). (rm
3be0: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
3bf0: 74 65 73 74 2d 74 6f 70 6c 65 76 65 6c 2d 6e 75 test-toplevel-nu
3c00: 6d 2d 69 74 65 6d 73 20 72 75 6e 2d 69 64 20 28 m-items run-id (
3c10: 6c 69 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 list run-id test
3c20: 2d 6e 61 6d 65 29 29 29 0a 0a 3b 3b 20 28 64 65 -name)))..;; (de
3c30: 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 70 72 fine (rmt:get-pr
3c40: 65 76 69 6f 75 73 2d 74 65 73 74 2d 72 75 6e 2d evious-test-run-
3c50: 72 65 63 6f 72 64 20 72 75 6e 2d 69 64 20 74 65 record run-id te
3c60: 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 st-name item-pat
3c70: 68 29 0a 3b 3b 20 20 20 28 72 6d 74 3a 73 65 6e h).;; (rmt:sen
3c80: 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d 70 d-receive 'get-p
3c90: 72 65 76 69 6f 75 73 2d 74 65 73 74 2d 72 75 6e revious-test-run
3ca0: 2d 72 65 63 6f 72 64 20 72 75 6e 2d 69 64 20 28 -record run-id (
3cb0: 6c 69 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 list run-id test
3cc0: 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 -name item-path)
3cd0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 ))..(define (rmt
3ce0: 3a 67 65 74 2d 6d 61 74 63 68 69 6e 67 2d 70 72 :get-matching-pr
3cf0: 65 76 69 6f 75 73 2d 74 65 73 74 2d 72 75 6e 2d evious-test-run-
3d00: 72 65 63 6f 72 64 73 20 72 75 6e 2d 69 64 20 74 records run-id t
3d10: 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 est-name item-pa
3d20: 74 68 29 0a 20 20 28 61 73 73 65 72 74 20 28 6e th). (assert (n
3d30: 75 6d 62 65 72 3f 20 72 75 6e 2d 69 64 29 20 22 umber? run-id) "
3d40: 46 41 54 41 4c 3a 20 52 75 6e 20 69 64 20 72 65 FATAL: Run id re
3d50: 71 75 69 72 65 64 2e 22 29 0a 20 20 28 72 6d 74 quired."). (rmt
3d60: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 :send-receive 'g
3d70: 65 74 2d 6d 61 74 63 68 69 6e 67 2d 70 72 65 76 et-matching-prev
3d80: 69 6f 75 73 2d 74 65 73 74 2d 72 75 6e 2d 72 65 ious-test-run-re
3d90: 63 6f 72 64 73 20 72 75 6e 2d 69 64 20 28 6c 69 cords run-id (li
3da0: 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e st run-id test-n
3db0: 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 29 29 ame item-path)))
3dc0: 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 74 ..(define (rmt:t
3dd0: 65 73 74 2d 67 65 74 2d 6c 6f 67 66 69 6c 65 2d est-get-logfile-
3de0: 69 6e 66 6f 20 72 75 6e 2d 69 64 20 74 65 73 74 info run-id test
3df0: 2d 6e 61 6d 65 29 0a 20 20 28 61 73 73 65 72 74 -name). (assert
3e00: 20 28 6e 75 6d 62 65 72 3f 20 72 75 6e 2d 69 64 (number? run-id
3e10: 29 20 22 46 41 54 41 4c 3a 20 52 75 6e 20 69 64 ) "FATAL: Run id
3e20: 20 72 65 71 75 69 72 65 64 2e 22 29 0a 20 20 28 required."). (
3e30: 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 rmt:send-receive
3e40: 20 27 74 65 73 74 2d 67 65 74 2d 6c 6f 67 66 69 'test-get-logfi
3e50: 6c 65 2d 69 6e 66 6f 20 72 75 6e 2d 69 64 20 28 le-info run-id (
3e60: 6c 69 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 list run-id test
3e70: 2d 6e 61 6d 65 29 29 29 0a 0a 28 64 65 66 69 6e -name)))..(defin
3e80: 65 20 28 72 6d 74 3a 74 65 73 74 2d 67 65 74 2d e (rmt:test-get-
3e90: 72 65 63 6f 72 64 73 2d 66 6f 72 2d 69 6e 64 65 records-for-inde
3ea0: 78 2d 66 69 6c 65 20 72 75 6e 2d 69 64 20 74 65 x-file run-id te
3eb0: 73 74 2d 6e 61 6d 65 29 0a 20 20 28 61 73 73 65 st-name). (asse
3ec0: 72 74 20 28 6e 75 6d 62 65 72 3f 20 72 75 6e 2d rt (number? run-
3ed0: 69 64 29 20 22 46 41 54 41 4c 3a 20 52 75 6e 20 id) "FATAL: Run
3ee0: 69 64 20 72 65 71 75 69 72 65 64 2e 22 29 0a 20 id required.").
3ef0: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
3f00: 76 65 20 27 74 65 73 74 2d 67 65 74 2d 72 65 63 ve 'test-get-rec
3f10: 6f 72 64 73 2d 66 6f 72 2d 69 6e 64 65 78 2d 66 ords-for-index-f
3f20: 69 6c 65 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 ile run-id (list
3f30: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
3f40: 65 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 e)))..(define (r
3f50: 6d 74 3a 67 65 74 2d 74 65 73 74 69 6e 66 6f 2d mt:get-testinfo-
3f60: 73 74 61 74 65 2d 73 74 61 74 75 73 20 72 75 6e state-status run
3f70: 2d 69 64 20 74 65 73 74 2d 69 64 29 0a 20 20 28 -id test-id). (
3f80: 61 73 73 65 72 74 20 28 6e 75 6d 62 65 72 3f 20 assert (number?
3f90: 72 75 6e 2d 69 64 29 20 22 46 41 54 41 4c 3a 20 run-id) "FATAL:
3fa0: 52 75 6e 20 69 64 20 72 65 71 75 69 72 65 64 2e Run id required.
3fb0: 22 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 "). (rmt:send-r
3fc0: 65 63 65 69 76 65 20 27 67 65 74 2d 74 65 73 74 eceive 'get-test
3fd0: 69 6e 66 6f 2d 73 74 61 74 65 2d 73 74 61 74 75 info-state-statu
3fe0: 73 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 s run-id (list r
3ff0: 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 29 29 un-id test-id)))
4000: 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 74 ..(define (rmt:t
4010: 65 73 74 2d 73 65 74 2d 6c 6f 67 21 20 72 75 6e est-set-log! run
4020: 2d 69 64 20 74 65 73 74 2d 69 64 20 6c 6f 67 66 -id test-id logf
4030: 29 0a 20 20 28 61 73 73 65 72 74 20 28 6e 75 6d ). (assert (num
4040: 62 65 72 3f 20 72 75 6e 2d 69 64 29 20 22 46 41 ber? run-id) "FA
4050: 54 41 4c 3a 20 52 75 6e 20 69 64 20 72 65 71 75 TAL: Run id requ
4060: 69 72 65 64 2e 22 29 0a 20 20 28 69 66 20 28 73 ired."). (if (s
4070: 74 72 69 6e 67 3f 20 6c 6f 67 66 29 28 72 6d 74 tring? logf)(rmt
4080: 3a 67 65 6e 65 72 61 6c 2d 63 61 6c 6c 20 27 74 :general-call 't
4090: 65 73 74 2d 73 65 74 2d 6c 6f 67 20 72 75 6e 2d est-set-log run-
40a0: 69 64 20 6c 6f 67 66 20 74 65 73 74 2d 69 64 29 id logf test-id)
40b0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 ))..(define (rmt
40c0: 3a 74 65 73 74 2d 73 65 74 2d 74 6f 70 2d 70 72 :test-set-top-pr
40d0: 6f 63 65 73 73 2d 70 69 64 20 72 75 6e 2d 69 64 ocess-pid run-id
40e0: 20 74 65 73 74 2d 69 64 20 70 69 64 29 0a 20 20 test-id pid).
40f0: 28 61 73 73 65 72 74 20 28 6e 75 6d 62 65 72 3f (assert (number?
4100: 20 72 75 6e 2d 69 64 29 20 22 46 41 54 41 4c 3a run-id) "FATAL:
4110: 20 52 75 6e 20 69 64 20 72 65 71 75 69 72 65 64 Run id required
4120: 2e 22 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d ."). (rmt:send-
4130: 72 65 63 65 69 76 65 20 27 74 65 73 74 2d 73 65 receive 'test-se
4140: 74 2d 74 6f 70 2d 70 72 6f 63 65 73 73 2d 70 69 t-top-process-pi
4150: 64 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 d run-id (list r
4160: 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 70 69 un-id test-id pi
4170: 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 d)))..(define (r
4180: 6d 74 3a 74 65 73 74 2d 67 65 74 2d 74 6f 70 2d mt:test-get-top-
4190: 70 72 6f 63 65 73 73 2d 70 69 64 20 72 75 6e 2d process-pid run-
41a0: 69 64 20 74 65 73 74 2d 69 64 29 0a 20 20 28 61 id test-id). (a
41b0: 73 73 65 72 74 20 28 6e 75 6d 62 65 72 3f 20 72 ssert (number? r
41c0: 75 6e 2d 69 64 29 20 22 46 41 54 41 4c 3a 20 52 un-id) "FATAL: R
41d0: 75 6e 20 69 64 20 72 65 71 75 69 72 65 64 2e 22 un id required."
41e0: 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 ). (rmt:send-re
41f0: 63 65 69 76 65 20 27 74 65 73 74 2d 67 65 74 2d ceive 'test-get-
4200: 74 6f 70 2d 70 72 6f 63 65 73 73 2d 70 69 64 20 top-process-pid
4210: 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e run-id (list run
4220: 2d 69 64 20 74 65 73 74 2d 69 64 29 29 29 0a 0a -id test-id)))..
4230: 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 (define (rmt:get
4240: 2d 72 75 6e 2d 69 64 73 2d 6d 61 74 63 68 69 6e -run-ids-matchin
4250: 67 2d 74 61 72 67 65 74 20 6b 65 79 6e 61 6d 65 g-target keyname
4260: 73 20 74 61 72 67 65 74 20 72 65 73 20 72 75 6e s target res run
4270: 6e 61 6d 65 20 74 65 73 74 70 61 74 74 20 73 74 name testpatt st
4280: 61 74 65 70 61 74 74 20 73 74 61 74 75 73 70 61 atepatt statuspa
4290: 74 74 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d tt). (rmt:send-
42a0: 72 65 63 65 69 76 65 20 27 67 65 74 2d 72 75 6e receive 'get-run
42b0: 2d 69 64 73 2d 6d 61 74 63 68 69 6e 67 2d 74 61 -ids-matching-ta
42c0: 72 67 65 74 20 23 66 20 28 6c 69 73 74 20 6b 65 rget #f (list ke
42d0: 79 6e 61 6d 65 73 20 74 61 72 67 65 74 20 72 65 ynames target re
42e0: 73 20 72 75 6e 6e 61 6d 65 20 74 65 73 74 70 61 s runname testpa
42f0: 74 74 20 73 74 61 74 65 70 61 74 74 20 73 74 61 tt statepatt sta
4300: 74 75 73 70 61 74 74 29 29 29 0a 0a 3b 3b 20 4e tuspatt)))..;; N
4310: 4f 54 45 3a 20 54 68 69 73 20 77 69 6c 6c 20 6f OTE: This will o
4320: 70 65 6e 20 61 6e 64 20 61 63 63 65 73 73 20 41 pen and access A
4330: 4c 4c 20 72 75 6e 20 64 61 74 61 62 61 73 65 73 LL run databases
4340: 2e 20 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 72 . .;;.(define (r
4350: 6d 74 3a 74 65 73 74 2d 67 65 74 2d 70 61 74 68 mt:test-get-path
4360: 73 2d 6d 61 74 63 68 69 6e 67 2d 6b 65 79 6e 61 s-matching-keyna
4370: 6d 65 73 2d 74 61 72 67 65 74 2d 6e 65 77 20 6b mes-target-new k
4380: 65 79 6e 61 6d 65 73 20 74 61 72 67 65 74 20 72 eynames target r
4390: 65 73 20 74 65 73 74 70 61 74 74 20 73 74 61 74 es testpatt stat
43a0: 65 70 61 74 74 20 73 74 61 74 75 73 70 61 74 74 epatt statuspatt
43b0: 20 72 75 6e 6e 61 6d 65 29 0a 20 20 28 6c 65 74 runname). (let
43c0: 20 28 28 72 75 6e 2d 69 64 73 20 28 72 6d 74 3a ((run-ids (rmt:
43d0: 67 65 74 2d 72 75 6e 2d 69 64 73 2d 6d 61 74 63 get-run-ids-matc
43e0: 68 69 6e 67 2d 74 61 72 67 65 74 20 6b 65 79 6e hing-target keyn
43f0: 61 6d 65 73 20 74 61 72 67 65 74 20 72 65 73 20 ames target res
4400: 72 75 6e 6e 61 6d 65 20 74 65 73 74 70 61 74 74 runname testpatt
4410: 20 73 74 61 74 65 70 61 74 74 20 73 74 61 74 75 statepatt statu
4420: 73 70 61 74 74 29 29 29 0a 20 20 20 20 28 61 70 spatt))). (ap
4430: 70 6c 79 20 61 70 70 65 6e 64 20 0a 09 20 20 20 ply append ..
4440: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 72 75 (map (lambda (ru
4450: 6e 2d 69 64 29 0a 09 09 20 20 28 72 6d 74 3a 73 n-id)... (rmt:s
4460: 65 6e 64 2d 72 65 63 65 69 76 65 20 27 74 65 73 end-receive 'tes
4470: 74 2d 67 65 74 2d 70 61 74 68 73 2d 6d 61 74 63 t-get-paths-matc
4480: 68 69 6e 67 2d 6b 65 79 6e 61 6d 65 73 2d 74 61 hing-keynames-ta
4490: 72 67 65 74 2d 6e 65 77 20 72 75 6e 2d 69 64 20 rget-new run-id
44a0: 28 6c 69 73 74 20 72 75 6e 2d 69 64 20 6b 65 79 (list run-id key
44b0: 6e 61 6d 65 73 20 74 61 72 67 65 74 20 72 65 73 names target res
44c0: 20 74 65 73 74 70 61 74 74 20 73 74 61 74 65 70 testpatt statep
44d0: 61 74 74 20 73 74 61 74 75 73 70 61 74 74 20 72 att statuspatt r
44e0: 75 6e 6e 61 6d 65 29 29 29 0a 09 20 20 20 72 75 unname))).. ru
44f0: 6e 2d 69 64 73 29 29 29 29 0a 0a 0a 0a 28 64 65 n-ids))))....(de
4500: 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 70 72 fine (rmt:get-pr
4510: 65 72 65 71 73 2d 6e 6f 74 2d 6d 65 74 20 72 75 ereqs-not-met ru
4520: 6e 2d 69 64 20 77 61 69 74 6f 6e 73 20 72 65 66 n-id waitons ref
4530: 2d 74 65 73 74 2d 6e 61 6d 65 20 72 65 66 2d 69 -test-name ref-i
4540: 74 65 6d 2d 70 61 74 68 20 23 21 6b 65 79 20 28 tem-path #!key (
4550: 6d 6f 64 65 20 27 28 6e 6f 72 6d 61 6c 29 29 28 mode '(normal))(
4560: 69 74 65 6d 6d 61 70 73 20 23 66 29 29 0a 20 20 itemmaps #f)).
4570: 28 61 73 73 65 72 74 20 28 6e 75 6d 62 65 72 3f (assert (number?
4580: 20 72 75 6e 2d 69 64 29 20 22 46 41 54 41 4c 3a run-id) "FATAL:
4590: 20 52 75 6e 20 69 64 20 72 65 71 75 69 72 65 64 Run id required
45a0: 2e 22 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d ."). (rmt:send-
45b0: 72 65 63 65 69 76 65 20 27 67 65 74 2d 70 72 65 receive 'get-pre
45c0: 72 65 71 73 2d 6e 6f 74 2d 6d 65 74 20 72 75 6e reqs-not-met run
45d0: 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 -id (list run-id
45e0: 20 77 61 69 74 6f 6e 73 20 72 65 66 2d 74 65 73 waitons ref-tes
45f0: 74 2d 6e 61 6d 65 20 72 65 66 2d 69 74 65 6d 2d t-name ref-item-
4600: 70 61 74 68 20 6d 6f 64 65 20 69 74 65 6d 6d 61 path mode itemma
4610: 70 73 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 ps)))..(define (
4620: 72 6d 74 3a 67 65 74 2d 63 6f 75 6e 74 2d 74 65 rmt:get-count-te
4630: 73 74 73 2d 72 75 6e 6e 69 6e 67 2d 66 6f 72 2d sts-running-for-
4640: 72 75 6e 2d 69 64 20 72 75 6e 2d 69 64 29 0a 20 run-id run-id).
4650: 20 28 61 73 73 65 72 74 20 28 6e 75 6d 62 65 72 (assert (number
4660: 3f 20 72 75 6e 2d 69 64 29 20 22 46 41 54 41 4c ? run-id) "FATAL
4670: 3a 20 52 75 6e 20 69 64 20 72 65 71 75 69 72 65 : Run id require
4680: 64 2e 22 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 d."). (rmt:send
4690: 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d 63 6f -receive 'get-co
46a0: 75 6e 74 2d 74 65 73 74 73 2d 72 75 6e 6e 69 6e unt-tests-runnin
46b0: 67 2d 66 6f 72 2d 72 75 6e 2d 69 64 20 72 75 6e g-for-run-id run
46c0: 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 -id (list run-id
46d0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d )))..(define (rm
46e0: 74 3a 67 65 74 2d 6e 6f 74 2d 63 6f 6d 70 6c 65 t:get-not-comple
46f0: 74 65 64 2d 63 6e 74 20 72 75 6e 2d 69 64 29 0a ted-cnt run-id).
4700: 20 20 28 61 73 73 65 72 74 20 28 6e 75 6d 62 65 (assert (numbe
4710: 72 3f 20 72 75 6e 2d 69 64 29 20 22 46 41 54 41 r? run-id) "FATA
4720: 4c 3a 20 52 75 6e 20 69 64 20 72 65 71 75 69 72 L: Run id requir
4730: 65 64 2e 22 29 0a 20 20 28 72 6d 74 3a 73 65 6e ed."). (rmt:sen
4740: 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d 6e d-receive 'get-n
4750: 6f 74 2d 63 6f 6d 70 6c 65 74 65 64 2d 63 6e 74 ot-completed-cnt
4760: 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 run-id (list ru
4770: 6e 2d 69 64 29 29 29 0a 0a 0a 3b 3b 20 53 74 61 n-id)))...;; Sta
4780: 74 69 73 74 69 63 61 6c 20 71 75 65 72 69 65 73 tistical queries
4790: 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 ..(define (rmt:g
47a0: 65 74 2d 63 6f 75 6e 74 2d 74 65 73 74 73 2d 72 et-count-tests-r
47b0: 75 6e 6e 69 6e 67 20 72 75 6e 2d 69 64 29 0a 20 unning run-id).
47c0: 20 28 61 73 73 65 72 74 20 28 6e 75 6d 62 65 72 (assert (number
47d0: 3f 20 72 75 6e 2d 69 64 29 20 22 46 41 54 41 4c ? run-id) "FATAL
47e0: 3a 20 52 75 6e 20 69 64 20 72 65 71 75 69 72 65 : Run id require
47f0: 64 2e 22 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 d."). (rmt:send
4800: 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d 63 6f -receive 'get-co
4810: 75 6e 74 2d 74 65 73 74 73 2d 72 75 6e 6e 69 6e unt-tests-runnin
4820: 67 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 g run-id (list r
4830: 75 6e 2d 69 64 29 29 29 0a 0a 28 64 65 66 69 6e un-id)))..(defin
4840: 65 20 28 72 6d 74 3a 67 65 74 2d 63 6f 75 6e 74 e (rmt:get-count
4850: 2d 74 65 73 74 73 2d 72 75 6e 6e 69 6e 67 2d 66 -tests-running-f
4860: 6f 72 2d 74 65 73 74 6e 61 6d 65 20 72 75 6e 2d or-testname run-
4870: 69 64 20 74 65 73 74 6e 61 6d 65 29 0a 20 20 28 id testname). (
4880: 61 73 73 65 72 74 20 28 6e 75 6d 62 65 72 3f 20 assert (number?
4890: 72 75 6e 2d 69 64 29 20 22 46 41 54 41 4c 3a 20 run-id) "FATAL:
48a0: 52 75 6e 20 69 64 20 72 65 71 75 69 72 65 64 2e Run id required.
48b0: 22 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 "). (rmt:send-r
48c0: 65 63 65 69 76 65 20 27 67 65 74 2d 63 6f 75 6e eceive 'get-coun
48d0: 74 2d 74 65 73 74 73 2d 72 75 6e 6e 69 6e 67 2d t-tests-running-
48e0: 66 6f 72 2d 74 65 73 74 6e 61 6d 65 20 72 75 6e for-testname run
48f0: 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 -id (list run-id
4900: 20 74 65 73 74 6e 61 6d 65 29 29 29 0a 0a 28 64 testname)))..(d
4910: 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 63 efine (rmt:get-c
4920: 6f 75 6e 74 2d 74 65 73 74 73 2d 72 75 6e 6e 69 ount-tests-runni
4930: 6e 67 2d 69 6e 2d 6a 6f 62 67 72 6f 75 70 20 72 ng-in-jobgroup r
4940: 75 6e 2d 69 64 20 6a 6f 62 67 72 6f 75 70 29 0a un-id jobgroup).
4950: 20 20 28 61 73 73 65 72 74 20 28 6e 75 6d 62 65 (assert (numbe
4960: 72 3f 20 72 75 6e 2d 69 64 29 20 22 46 41 54 41 r? run-id) "FATA
4970: 4c 3a 20 52 75 6e 20 69 64 20 72 65 71 75 69 72 L: Run id requir
4980: 65 64 2e 22 29 0a 20 20 28 72 6d 74 3a 73 65 6e ed."). (rmt:sen
4990: 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d 63 d-receive 'get-c
49a0: 6f 75 6e 74 2d 74 65 73 74 73 2d 72 75 6e 6e 69 ount-tests-runni
49b0: 6e 67 2d 69 6e 2d 6a 6f 62 67 72 6f 75 70 20 72 ng-in-jobgroup r
49c0: 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d un-id (list run-
49d0: 69 64 20 6a 6f 62 67 72 6f 75 70 29 29 29 0a 0a id jobgroup)))..
49e0: 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 73 65 74 (define (rmt:set
49f0: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d 61 6e -state-status-an
4a00: 64 2d 72 6f 6c 6c 2d 75 70 2d 72 75 6e 20 72 75 d-roll-up-run ru
4a10: 6e 2d 69 64 20 73 74 61 74 65 20 73 74 61 74 75 n-id state statu
4a20: 73 29 0a 20 20 28 61 73 73 65 72 74 20 28 6e 75 s). (assert (nu
4a30: 6d 62 65 72 3f 20 72 75 6e 2d 69 64 29 20 22 46 mber? run-id) "F
4a40: 41 54 41 4c 3a 20 52 75 6e 20 69 64 20 72 65 71 ATAL: Run id req
4a50: 75 69 72 65 64 2e 22 29 0a 20 20 28 72 6d 74 3a uired."). (rmt:
4a60: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 73 65 send-receive 'se
4a70: 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d 61 t-state-status-a
4a80: 6e 64 2d 72 6f 6c 6c 2d 75 70 2d 72 75 6e 20 72 nd-roll-up-run r
4a90: 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d un-id (list run-
4aa0: 69 64 20 73 74 61 74 65 20 73 74 61 74 75 73 29 id state status)
4ab0: 29 29 0a 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d ))...(define (rm
4ac0: 74 3a 75 70 64 61 74 65 2d 70 61 73 73 2d 66 61 t:update-pass-fa
4ad0: 69 6c 2d 63 6f 75 6e 74 73 20 72 75 6e 2d 69 64 il-counts run-id
4ae0: 20 74 65 73 74 2d 6e 61 6d 65 29 0a 20 20 28 61 test-name). (a
4af0: 73 73 65 72 74 20 28 6e 75 6d 62 65 72 3f 20 72 ssert (number? r
4b00: 75 6e 2d 69 64 29 20 22 46 41 54 41 4c 3a 20 52 un-id) "FATAL: R
4b10: 75 6e 20 69 64 20 72 65 71 75 69 72 65 64 2e 22 un id required."
4b20: 29 0a 20 20 28 72 6d 74 3a 67 65 6e 65 72 61 6c ). (rmt:general
4b30: 2d 63 61 6c 6c 20 27 75 70 64 61 74 65 2d 70 61 -call 'update-pa
4b40: 73 73 2d 66 61 69 6c 2d 63 6f 75 6e 74 73 20 72 ss-fail-counts r
4b50: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 un-id test-name
4b60: 74 65 73 74 2d 6e 61 6d 65 20 74 65 73 74 2d 6e test-name test-n
4b70: 61 6d 65 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 ame))..(define (
4b80: 72 6d 74 3a 74 6f 70 2d 74 65 73 74 2d 73 65 74 rmt:top-test-set
4b90: 2d 70 65 72 2d 70 66 2d 63 6f 75 6e 74 73 20 72 -per-pf-counts r
4ba0: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 29 un-id test-name)
4bb0: 0a 20 20 28 61 73 73 65 72 74 20 28 6e 75 6d 62 . (assert (numb
4bc0: 65 72 3f 20 72 75 6e 2d 69 64 29 20 22 46 41 54 er? run-id) "FAT
4bd0: 41 4c 3a 20 52 75 6e 20 69 64 20 72 65 71 75 69 AL: Run id requi
4be0: 72 65 64 2e 22 29 0a 20 20 28 72 6d 74 3a 73 65 red."). (rmt:se
4bf0: 6e 64 2d 72 65 63 65 69 76 65 20 27 74 6f 70 2d nd-receive 'top-
4c00: 74 65 73 74 2d 73 65 74 2d 70 65 72 2d 70 66 2d test-set-per-pf-
4c10: 63 6f 75 6e 74 73 20 72 75 6e 2d 69 64 20 28 6c counts run-id (l
4c20: 69 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d ist run-id test-
4c30: 6e 61 6d 65 29 29 29 0a 0a 28 64 65 66 69 6e 65 name)))..(define
4c40: 20 28 72 6d 74 3a 67 65 74 2d 72 61 77 2d 72 75 (rmt:get-raw-ru
4c50: 6e 2d 73 74 61 74 73 20 72 75 6e 2d 69 64 29 0a n-stats run-id).
4c60: 20 20 28 61 73 73 65 72 74 20 28 6e 75 6d 62 65 (assert (numbe
4c70: 72 3f 20 72 75 6e 2d 69 64 29 20 22 46 41 54 41 r? run-id) "FATA
4c80: 4c 3a 20 52 75 6e 20 69 64 20 72 65 71 75 69 72 L: Run id requir
4c90: 65 64 2e 22 29 0a 20 20 28 72 6d 74 3a 73 65 6e ed."). (rmt:sen
4ca0: 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d 72 d-receive 'get-r
4cb0: 61 77 2d 72 75 6e 2d 73 74 61 74 73 20 72 75 6e aw-run-stats run
4cc0: 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 -id (list run-id
4cd0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d )))..(define (rm
4ce0: 74 3a 67 65 74 2d 74 65 73 74 2d 74 69 6d 65 73 t:get-test-times
4cf0: 20 72 75 6e 6e 61 6d 65 20 74 61 72 67 65 74 29 runname target)
4d00: 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 . (rmt:send-rec
4d10: 65 69 76 65 20 27 67 65 74 2d 74 65 73 74 2d 74 eive 'get-test-t
4d20: 69 6d 65 73 20 23 66 20 28 6c 69 73 74 20 72 75 imes #f (list ru
4d30: 6e 6e 61 6d 65 20 74 61 72 67 65 74 20 29 29 29 nname target )))
4d40: 20 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;===========
4d50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4d60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4d70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4d80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 20 ===========.;;
4d90: 52 20 55 20 4e 20 53 0a 3b 3b 3d 3d 3d 3d 3d 3d R U N S.;;======
4da0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4db0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4dc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4dd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4de0: 0a 0a 3b 3b 20 42 55 47 20 2d 20 4c 4f 4f 4b 20 ..;; BUG - LOOK
4df0: 41 54 20 48 4f 57 20 54 48 49 53 20 57 4f 52 4b AT HOW THIS WORK
4e00: 53 21 21 21 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 S!!!.;;.(define
4e10: 28 72 6d 74 3a 67 65 74 2d 72 75 6e 2d 69 6e 66 (rmt:get-run-inf
4e20: 6f 20 72 75 6e 2d 69 64 29 0a 20 20 28 61 73 73 o run-id). (ass
4e30: 65 72 74 20 28 6e 75 6d 62 65 72 3f 20 72 75 6e ert (number? run
4e40: 2d 69 64 29 20 22 46 41 54 41 4c 3a 20 52 75 6e -id) "FATAL: Run
4e50: 20 69 64 20 72 65 71 75 69 72 65 64 2e 22 29 0a id required.").
4e60: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
4e70: 69 76 65 20 27 67 65 74 2d 72 75 6e 2d 69 6e 66 ive 'get-run-inf
4e80: 6f 20 23 66 20 28 6c 69 73 74 20 72 75 6e 2d 69 o #f (list run-i
4e90: 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 d)))..(define (r
4ea0: 6d 74 3a 67 65 74 2d 6e 75 6d 2d 72 75 6e 73 20 mt:get-num-runs
4eb0: 72 75 6e 70 61 74 74 29 0a 20 20 28 72 6d 74 3a runpatt). (rmt:
4ec0: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 send-receive 'ge
4ed0: 74 2d 6e 75 6d 2d 72 75 6e 73 20 23 66 20 28 6c t-num-runs #f (l
4ee0: 69 73 74 20 72 75 6e 70 61 74 74 29 29 29 0a 0a ist runpatt)))..
4ef0: 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 (define (rmt:get
4f00: 2d 72 75 6e 73 2d 63 6e 74 2d 62 79 2d 70 61 74 -runs-cnt-by-pat
4f10: 74 20 72 75 6e 70 61 74 74 20 74 61 72 67 65 74 t runpatt target
4f20: 70 61 74 74 20 6b 65 79 73 29 0a 20 20 28 72 6d patt keys). (rm
4f30: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
4f40: 67 65 74 2d 72 75 6e 73 2d 63 6e 74 2d 62 79 2d get-runs-cnt-by-
4f50: 70 61 74 74 20 23 66 20 28 6c 69 73 74 20 72 75 patt #f (list ru
4f60: 6e 70 61 74 74 20 20 74 61 72 67 65 74 70 61 74 npatt targetpat
4f70: 74 20 6b 65 79 73 29 29 29 0a 0a 3b 3b 20 55 73 t keys)))..;; Us
4f80: 65 20 74 68 65 20 73 70 65 63 69 61 6c 20 72 75 e the special ru
4f90: 6e 2d 69 64 20 3d 3d 20 23 66 20 73 63 65 6e 61 n-id == #f scena
4fa0: 72 69 6f 20 68 65 72 65 20 73 69 6e 63 65 20 74 rio here since t
4fb0: 68 65 72 65 20 69 73 20 6e 6f 20 72 75 6e 20 79 here is no run y
4fc0: 65 74 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a et.(define (rmt:
4fd0: 72 65 67 69 73 74 65 72 2d 72 75 6e 20 6b 65 79 register-run key
4fe0: 76 61 6c 73 20 72 75 6e 6e 61 6d 65 20 73 74 61 vals runname sta
4ff0: 74 65 20 73 74 61 74 75 73 20 75 73 65 72 20 63 te status user c
5000: 6f 6e 74 6f 75 72 29 0a 20 20 28 72 6d 74 3a 73 ontour). (rmt:s
5010: 65 6e 64 2d 72 65 63 65 69 76 65 20 27 72 65 67 end-receive 'reg
5020: 69 73 74 65 72 2d 72 75 6e 20 23 66 20 28 6c 69 ister-run #f (li
5030: 73 74 20 6b 65 79 76 61 6c 73 20 72 75 6e 6e 61 st keyvals runna
5040: 6d 65 20 73 74 61 74 65 20 73 74 61 74 75 73 20 me state status
5050: 75 73 65 72 20 63 6f 6e 74 6f 75 72 29 29 29 0a user contour))).
5060: 20 20 20 20 0a 28 64 65 66 69 6e 65 20 28 72 6d .(define (rm
5070: 74 3a 67 65 74 2d 72 75 6e 2d 6e 61 6d 65 2d 66 t:get-run-name-f
5080: 72 6f 6d 2d 69 64 20 72 75 6e 2d 69 64 29 0a 20 rom-id run-id).
5090: 20 28 61 73 73 65 72 74 20 28 6e 75 6d 62 65 72 (assert (number
50a0: 3f 20 72 75 6e 2d 69 64 29 20 22 46 41 54 41 4c ? run-id) "FATAL
50b0: 3a 20 52 75 6e 20 69 64 20 72 65 71 75 69 72 65 : Run id require
50c0: 64 2e 22 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 d."). (rmt:send
50d0: 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d 72 75 -receive 'get-ru
50e0: 6e 2d 6e 61 6d 65 2d 66 72 6f 6d 2d 69 64 20 23 n-name-from-id #
50f0: 66 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 29 29 f (list run-id))
5100: 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a )..(define (rmt:
5110: 64 65 6c 65 74 65 2d 72 75 6e 20 72 75 6e 2d 69 delete-run run-i
5120: 64 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 d). (rmt:send-r
5130: 65 63 65 69 76 65 20 27 64 65 6c 65 74 65 2d 72 eceive 'delete-r
5140: 75 6e 20 23 66 20 28 6c 69 73 74 20 72 75 6e 2d un #f (list run-
5150: 69 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 id)))..(define (
5160: 72 6d 74 3a 75 70 64 61 74 65 2d 72 75 6e 2d 73 rmt:update-run-s
5170: 74 61 74 73 20 72 75 6e 2d 69 64 20 73 74 61 74 tats run-id stat
5180: 73 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 s). (rmt:send-r
5190: 65 63 65 69 76 65 20 27 75 70 64 61 74 65 2d 72 eceive 'update-r
51a0: 75 6e 2d 73 74 61 74 73 20 23 66 20 28 6c 69 73 un-stats #f (lis
51b0: 74 20 72 75 6e 2d 69 64 20 73 74 61 74 73 29 29 t run-id stats))
51c0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a )..(define (rmt:
51d0: 64 65 6c 65 74 65 2d 6f 6c 64 2d 64 65 6c 65 74 delete-old-delet
51e0: 65 64 2d 74 65 73 74 2d 72 65 63 6f 72 64 73 20 ed-test-records
51f0: 72 75 6e 2d 69 64 29 0a 20 20 28 72 6d 74 3a 73 run-id). (rmt:s
5200: 65 6e 64 2d 72 65 63 65 69 76 65 20 27 64 65 6c end-receive 'del
5210: 65 74 65 2d 6f 6c 64 2d 64 65 6c 65 74 65 64 2d ete-old-deleted-
5220: 74 65 73 74 2d 72 65 63 6f 72 64 73 20 72 75 6e test-records run
5230: 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 -id (list run-id
5240: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d )))..(define (rm
5250: 74 3a 67 65 74 2d 72 75 6e 73 20 72 75 6e 70 61 t:get-runs runpa
5260: 74 74 20 63 6f 75 6e 74 20 6f 66 66 73 65 74 20 tt count offset
5270: 6b 65 79 70 61 74 74 73 29 0a 20 20 28 72 6d 74 keypatts). (rmt
5280: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 :send-receive 'g
5290: 65 74 2d 72 75 6e 73 20 23 66 20 28 6c 69 73 74 et-runs #f (list
52a0: 20 72 75 6e 70 61 74 74 20 63 6f 75 6e 74 20 6f runpatt count o
52b0: 66 66 73 65 74 20 6b 65 79 70 61 74 74 73 29 29 ffset keypatts))
52c0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a )..(define (rmt:
52d0: 73 69 6d 70 6c 65 2d 67 65 74 2d 72 75 6e 73 20 simple-get-runs
52e0: 72 75 6e 70 61 74 74 20 63 6f 75 6e 74 20 6f 66 runpatt count of
52f0: 66 73 65 74 20 74 61 72 67 65 74 20 6c 61 73 74 fset target last
5300: 2d 75 70 64 61 74 65 29 0a 20 20 28 72 6d 74 3a -update). (rmt:
5310: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 73 69 send-receive 'si
5320: 6d 70 6c 65 2d 67 65 74 2d 72 75 6e 73 20 23 66 mple-get-runs #f
5330: 20 28 6c 69 73 74 20 72 75 6e 70 61 74 74 20 63 (list runpatt c
5340: 6f 75 6e 74 20 6f 66 66 73 65 74 20 74 61 72 67 ount offset targ
5350: 65 74 20 6c 61 73 74 2d 75 70 64 61 74 65 29 29 et last-update))
5360: 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a )..(define (rmt:
5370: 67 65 74 2d 61 6c 6c 2d 72 75 6e 2d 69 64 73 29 get-all-run-ids)
5380: 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 . (rmt:send-rec
5390: 65 69 76 65 20 27 67 65 74 2d 61 6c 6c 2d 72 75 eive 'get-all-ru
53a0: 6e 2d 69 64 73 20 23 66 20 27 28 29 29 29 0a 0a n-ids #f '()))..
53b0: 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 (define (rmt:get
53c0: 2d 70 72 65 76 2d 72 75 6e 2d 69 64 73 20 72 75 -prev-run-ids ru
53d0: 6e 2d 69 64 29 0a 20 20 28 61 73 73 65 72 74 20 n-id). (assert
53e0: 28 6e 75 6d 62 65 72 3f 20 72 75 6e 2d 69 64 29 (number? run-id)
53f0: 20 22 46 41 54 41 4c 3a 20 52 75 6e 20 69 64 20 "FATAL: Run id
5400: 72 65 71 75 69 72 65 64 2e 22 29 0a 20 20 28 72 required."). (r
5410: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
5420: 27 67 65 74 2d 70 72 65 76 2d 72 75 6e 2d 69 64 'get-prev-run-id
5430: 73 20 23 66 20 28 6c 69 73 74 20 72 75 6e 2d 69 s #f (list run-i
5440: 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 d)))..(define (r
5450: 6d 74 3a 6c 6f 63 6b 2f 75 6e 6c 6f 63 6b 2d 72 mt:lock/unlock-r
5460: 75 6e 20 72 75 6e 2d 69 64 20 6c 6f 63 6b 20 75 un run-id lock u
5470: 6e 6c 6f 63 6b 20 75 73 65 72 29 0a 20 20 28 61 nlock user). (a
5480: 73 73 65 72 74 20 28 6e 75 6d 62 65 72 3f 20 72 ssert (number? r
5490: 75 6e 2d 69 64 29 20 22 46 41 54 41 4c 3a 20 52 un-id) "FATAL: R
54a0: 75 6e 20 69 64 20 72 65 71 75 69 72 65 64 2e 22 un id required."
54b0: 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 ). (rmt:send-re
54c0: 63 65 69 76 65 20 27 6c 6f 63 6b 2f 75 6e 6c 6f ceive 'lock/unlo
54d0: 63 6b 2d 72 75 6e 20 23 66 20 28 6c 69 73 74 20 ck-run #f (list
54e0: 72 75 6e 2d 69 64 20 6c 6f 63 6b 20 75 6e 6c 6f run-id lock unlo
54f0: 63 6b 20 75 73 65 72 29 29 29 0a 0a 3b 3b 20 73 ck user)))..;; s
5500: 65 74 2f 67 65 74 20 73 74 61 74 75 73 0a 28 64 et/get status.(d
5510: 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 72 efine (rmt:get-r
5520: 75 6e 2d 73 74 61 74 75 73 20 72 75 6e 2d 69 64 un-status run-id
5530: 29 0a 20 20 28 61 73 73 65 72 74 20 28 6e 75 6d ). (assert (num
5540: 62 65 72 3f 20 72 75 6e 2d 69 64 29 20 22 46 41 ber? run-id) "FA
5550: 54 41 4c 3a 20 52 75 6e 20 69 64 20 72 65 71 75 TAL: Run id requ
5560: 69 72 65 64 2e 22 29 0a 20 20 28 72 6d 74 3a 73 ired."). (rmt:s
5570: 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 end-receive 'get
5580: 2d 72 75 6e 2d 73 74 61 74 75 73 20 23 66 20 28 -run-status #f (
5590: 6c 69 73 74 20 72 75 6e 2d 69 64 29 29 29 0a 0a list run-id)))..
55a0: 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 (define (rmt:get
55b0: 2d 72 75 6e 2d 73 74 61 74 65 20 72 75 6e 2d 69 -run-state run-i
55c0: 64 29 0a 20 20 28 61 73 73 65 72 74 20 28 6e 75 d). (assert (nu
55d0: 6d 62 65 72 3f 20 72 75 6e 2d 69 64 29 20 22 46 mber? run-id) "F
55e0: 41 54 41 4c 3a 20 52 75 6e 20 69 64 20 72 65 71 ATAL: Run id req
55f0: 75 69 72 65 64 2e 22 29 0a 20 20 28 72 6d 74 3a uired."). (rmt:
5600: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 send-receive 'ge
5610: 74 2d 72 75 6e 2d 73 74 61 74 65 20 23 66 20 28 t-run-state #f (
5620: 6c 69 73 74 20 72 75 6e 2d 69 64 29 29 29 0a 0a list run-id)))..
5630: 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 (define (rmt:get
5640: 2d 72 75 6e 2d 73 74 61 74 65 2d 73 74 61 74 75 -run-state-statu
5650: 73 20 72 75 6e 2d 69 64 29 0a 20 20 28 61 73 73 s run-id). (ass
5660: 65 72 74 20 28 6e 75 6d 62 65 72 3f 20 72 75 6e ert (number? run
5670: 2d 69 64 29 20 22 46 41 54 41 4c 3a 20 52 75 6e -id) "FATAL: Run
5680: 20 69 64 20 72 65 71 75 69 72 65 64 2e 22 29 0a id required.").
5690: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
56a0: 69 76 65 20 27 67 65 74 2d 72 75 6e 2d 73 74 61 ive 'get-run-sta
56b0: 74 65 2d 73 74 61 74 75 73 20 23 66 20 28 6c 69 te-status #f (li
56c0: 73 74 20 72 75 6e 2d 69 64 29 29 29 0a 0a 28 64 st run-id)))..(d
56d0: 65 66 69 6e 65 20 28 72 6d 74 3a 73 65 74 2d 72 efine (rmt:set-r
56e0: 75 6e 2d 73 74 61 74 75 73 20 72 75 6e 2d 69 64 un-status run-id
56f0: 20 72 75 6e 2d 73 74 61 74 75 73 20 23 21 6b 65 run-status #!ke
5700: 79 20 28 6d 73 67 20 23 66 29 29 0a 20 20 28 61 y (msg #f)). (a
5710: 73 73 65 72 74 20 28 6e 75 6d 62 65 72 3f 20 72 ssert (number? r
5720: 75 6e 2d 69 64 29 20 22 46 41 54 41 4c 3a 20 52 un-id) "FATAL: R
5730: 75 6e 20 69 64 20 72 65 71 75 69 72 65 64 2e 22 un id required."
5740: 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 ). (rmt:send-re
5750: 63 65 69 76 65 20 27 73 65 74 2d 72 75 6e 2d 73 ceive 'set-run-s
5760: 74 61 74 75 73 20 23 66 20 28 6c 69 73 74 20 72 tatus #f (list r
5770: 75 6e 2d 69 64 20 72 75 6e 2d 73 74 61 74 75 73 un-id run-status
5780: 20 6d 73 67 29 29 29 0a 0a 28 64 65 66 69 6e 65 msg)))..(define
5790: 20 28 72 6d 74 3a 73 65 74 2d 72 75 6e 2d 73 74 (rmt:set-run-st
57a0: 61 74 65 2d 73 74 61 74 75 73 20 72 75 6e 2d 69 ate-status run-i
57b0: 64 20 73 74 61 74 65 20 73 74 61 74 75 73 20 29 d state status )
57c0: 0a 20 20 28 61 73 73 65 72 74 20 28 6e 75 6d 62 . (assert (numb
57d0: 65 72 3f 20 72 75 6e 2d 69 64 29 20 22 46 41 54 er? run-id) "FAT
57e0: 41 4c 3a 20 52 75 6e 20 69 64 20 72 65 71 75 69 AL: Run id requi
57f0: 72 65 64 2e 22 29 0a 20 20 28 72 6d 74 3a 73 65 red."). (rmt:se
5800: 6e 64 2d 72 65 63 65 69 76 65 20 27 73 65 74 2d nd-receive 'set-
5810: 72 75 6e 2d 73 74 61 74 65 2d 73 74 61 74 75 73 run-state-status
5820: 20 23 66 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 #f (list run-id
5830: 20 73 74 61 74 65 20 73 74 61 74 75 73 29 29 29 state status)))
5840: 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 75 ..(define (rmt:u
5850: 70 64 61 74 65 2d 74 65 73 64 61 74 61 2d 6f 6e pdate-tesdata-on
5860: 2d 72 65 70 69 6c 63 61 74 65 2d 64 62 20 6f 6c -repilcate-db ol
5870: 64 2d 6c 74 20 6e 65 77 2d 6c 74 29 0a 28 72 6d d-lt new-lt).(rm
5880: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
5890: 75 70 64 61 74 65 2d 74 65 73 64 61 74 61 2d 6f update-tesdata-o
58a0: 6e 2d 72 65 70 69 6c 63 61 74 65 2d 64 62 20 23 n-repilcate-db #
58b0: 66 20 28 6c 69 73 74 20 6f 6c 64 2d 6c 74 20 6e f (list old-lt n
58c0: 65 77 2d 6c 74 29 29 29 0a 0a 28 64 65 66 69 6e ew-lt)))..(defin
58d0: 65 20 28 72 6d 74 3a 75 70 64 61 74 65 2d 72 75 e (rmt:update-ru
58e0: 6e 2d 65 76 65 6e 74 5f 74 69 6d 65 20 72 75 6e n-event_time run
58f0: 2d 69 64 29 0a 20 20 28 61 73 73 65 72 74 20 28 -id). (assert (
5900: 6e 75 6d 62 65 72 3f 20 72 75 6e 2d 69 64 29 20 number? run-id)
5910: 22 46 41 54 41 4c 3a 20 52 75 6e 20 69 64 20 72 "FATAL: Run id r
5920: 65 71 75 69 72 65 64 2e 22 29 0a 20 20 28 72 6d equired."). (rm
5930: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
5940: 75 70 64 61 74 65 2d 72 75 6e 2d 65 76 65 6e 74 update-run-event
5950: 5f 74 69 6d 65 20 23 66 20 28 6c 69 73 74 20 72 _time #f (list r
5960: 75 6e 2d 69 64 29 29 29 0a 0a 28 64 65 66 69 6e un-id)))..(defin
5970: 65 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e 73 2d e (rmt:get-runs-
5980: 62 79 2d 70 61 74 74 20 20 6b 65 79 73 20 72 75 by-patt keys ru
5990: 6e 6e 61 6d 65 70 61 74 74 20 74 61 72 67 70 61 nnamepatt targpa
59a0: 74 74 20 6f 66 66 73 65 74 20 6c 69 6d 69 74 20 tt offset limit
59b0: 66 69 65 6c 64 73 20 6c 61 73 74 2d 72 75 6e 73 fields last-runs
59c0: 2d 75 70 64 61 74 65 20 20 23 21 6b 65 79 20 20 -update #!key
59d0: 28 73 6f 72 74 2d 6f 72 64 65 72 20 22 61 73 63 (sort-order "asc
59e0: 22 29 29 20 3b 3b 20 66 69 65 6c 64 73 20 6f 66 ")) ;; fields of
59f0: 20 23 66 20 75 73 65 73 20 64 65 66 61 75 6c 74 #f uses default
5a00: 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 . (rmt:send-rec
5a10: 65 69 76 65 20 27 67 65 74 2d 72 75 6e 73 2d 62 eive 'get-runs-b
5a20: 79 2d 70 61 74 74 20 23 66 20 28 6c 69 73 74 20 y-patt #f (list
5a30: 6b 65 79 73 20 72 75 6e 6e 61 6d 65 70 61 74 74 keys runnamepatt
5a40: 20 74 61 72 67 70 61 74 74 20 6f 66 66 73 65 74 targpatt offset
5a50: 20 6c 69 6d 69 74 20 66 69 65 6c 64 73 20 6c 61 limit fields la
5a60: 73 74 2d 72 75 6e 73 2d 75 70 64 61 74 65 20 73 st-runs-update s
5a70: 6f 72 74 2d 6f 72 64 65 72 29 29 29 0a 0a 28 64 ort-order)))..(d
5a80: 65 66 69 6e 65 20 28 72 6d 74 3a 66 69 6e 64 2d efine (rmt:find-
5a90: 61 6e 64 2d 6d 61 72 6b 2d 69 6e 63 6f 6d 70 6c and-mark-incompl
5aa0: 65 74 65 20 72 75 6e 2d 69 64 20 6f 76 72 2d 64 ete run-id ovr-d
5ab0: 65 61 64 74 69 6d 65 29 0a 20 20 28 61 73 73 65 eadtime). (asse
5ac0: 72 74 20 28 6e 75 6d 62 65 72 3f 20 72 75 6e 2d rt (number? run-
5ad0: 69 64 29 20 22 46 41 54 41 4c 3a 20 52 75 6e 20 id) "FATAL: Run
5ae0: 69 64 20 72 65 71 75 69 72 65 64 2e 22 29 0a 20 id required.").
5af0: 20 3b 3b 20 28 69 66 20 28 72 6d 74 3a 73 65 6e ;; (if (rmt:sen
5b00: 64 2d 72 65 63 65 69 76 65 20 27 68 61 76 65 2d d-receive 'have-
5b10: 69 6e 63 6f 6d 70 6c 65 74 65 73 3f 20 72 75 6e incompletes? run
5b20: 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 -id (list run-id
5b30: 20 6f 76 72 2d 64 65 61 64 74 69 6d 65 29 29 0a ovr-deadtime)).
5b40: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
5b50: 69 76 65 20 27 6d 61 72 6b 2d 69 6e 63 6f 6d 70 ive 'mark-incomp
5b60: 6c 65 74 65 20 72 75 6e 2d 69 64 20 28 6c 69 73 lete run-id (lis
5b70: 74 20 72 75 6e 2d 69 64 20 6f 76 72 2d 64 65 61 t run-id ovr-dea
5b80: 64 74 69 6d 65 29 29 29 20 3b 3b 20 29 0a 0a 28 dtime))) ;; )..(
5b90: 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d define (rmt:get-
5ba0: 6d 61 69 6e 2d 72 75 6e 2d 73 74 61 74 73 20 72 main-run-stats r
5bb0: 75 6e 2d 69 64 29 0a 20 20 28 61 73 73 65 72 74 un-id). (assert
5bc0: 20 28 6e 75 6d 62 65 72 3f 20 72 75 6e 2d 69 64 (number? run-id
5bd0: 29 20 22 46 41 54 41 4c 3a 20 52 75 6e 20 69 64 ) "FATAL: Run id
5be0: 20 72 65 71 75 69 72 65 64 2e 22 29 0a 20 20 28 required."). (
5bf0: 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 rmt:send-receive
5c00: 20 27 67 65 74 2d 6d 61 69 6e 2d 72 75 6e 2d 73 'get-main-run-s
5c10: 74 61 74 73 20 23 66 20 28 6c 69 73 74 20 72 75 tats #f (list ru
5c20: 6e 2d 69 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 n-id)))..(define
5c30: 20 28 72 6d 74 3a 67 65 74 2d 76 61 72 20 76 61 (rmt:get-var va
5c40: 72 6e 61 6d 65 29 0a 20 20 28 72 6d 74 3a 73 65 rname). (rmt:se
5c50: 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d nd-receive 'get-
5c60: 76 61 72 20 23 66 20 28 6c 69 73 74 20 76 61 72 var #f (list var
5c70: 6e 61 6d 65 29 29 29 0a 0a 28 64 65 66 69 6e 65 name)))..(define
5c80: 20 28 72 6d 74 3a 64 65 6c 2d 76 61 72 20 76 61 (rmt:del-var va
5c90: 72 6e 61 6d 65 29 0a 20 20 28 72 6d 74 3a 73 65 rname). (rmt:se
5ca0: 6e 64 2d 72 65 63 65 69 76 65 20 27 64 65 6c 2d nd-receive 'del-
5cb0: 76 61 72 20 23 66 20 28 6c 69 73 74 20 76 61 72 var #f (list var
5cc0: 6e 61 6d 65 29 29 29 0a 0a 28 64 65 66 69 6e 65 name)))..(define
5cd0: 20 28 72 6d 74 3a 73 65 74 2d 76 61 72 20 76 61 (rmt:set-var va
5ce0: 72 6e 61 6d 65 20 76 61 6c 75 65 29 0a 20 20 28 rname value). (
5cf0: 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 rmt:send-receive
5d00: 20 27 73 65 74 2d 76 61 72 20 23 66 20 28 6c 69 'set-var #f (li
5d10: 73 74 20 76 61 72 6e 61 6d 65 20 76 61 6c 75 65 st varname value
5d20: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d )))..(define (rm
5d30: 74 3a 69 6e 63 2d 76 61 72 20 76 61 72 6e 61 6d t:inc-var varnam
5d40: 65 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 e). (rmt:send-r
5d50: 65 63 65 69 76 65 20 27 69 6e 63 2d 76 61 72 20 eceive 'inc-var
5d60: 23 66 20 28 6c 69 73 74 20 76 61 72 6e 61 6d 65 #f (list varname
5d70: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d )))..(define (rm
5d80: 74 3a 64 65 63 2d 76 61 72 20 76 61 72 6e 61 6d t:dec-var varnam
5d90: 65 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 e). (rmt:send-r
5da0: 65 63 65 69 76 65 20 27 64 65 63 2d 76 61 72 20 eceive 'dec-var
5db0: 23 66 20 28 6c 69 73 74 20 76 61 72 6e 61 6d 65 #f (list varname
5dc0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d )))..(define (rm
5dd0: 74 3a 61 64 64 2d 76 61 72 20 76 61 72 6e 61 6d t:add-var varnam
5de0: 65 20 76 61 6c 75 65 29 0a 20 20 28 72 6d 74 3a e value). (rmt:
5df0: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 61 64 send-receive 'ad
5e00: 64 2d 76 61 72 20 23 66 20 28 6c 69 73 74 20 76 d-var #f (list v
5e10: 61 72 6e 61 6d 65 20 76 61 6c 75 65 29 29 29 0a arname value))).
5e20: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
5e30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5e40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5e50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5e60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4d 20 55 =========.;; M U
5e70: 20 4c 20 54 20 49 20 52 20 55 20 4e 20 20 20 51 L T I R U N Q
5e80: 20 55 20 45 20 52 20 49 20 45 20 53 0a 3b 3b 3d U E R I E S.;;=
5e90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5ea0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5eb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5ec0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5ed0: 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 4e 65 65 64 20 74 =====..;; Need t
5ee0: 6f 20 6d 6f 76 65 20 74 68 69 73 20 74 6f 20 6d o move this to m
5ef0: 75 6c 74 69 2d 72 75 6e 20 73 65 63 74 69 6f 6e ulti-run section
5f00: 20 61 6e 64 20 6d 61 6b 65 20 61 73 73 6f 63 69 and make associ
5f10: 61 74 65 64 20 63 68 61 6e 67 65 73 0a 28 64 65 ated changes.(de
5f20: 66 69 6e 65 20 28 72 6d 74 3a 66 69 6e 64 2d 61 fine (rmt:find-a
5f30: 6e 64 2d 6d 61 72 6b 2d 69 6e 63 6f 6d 70 6c 65 nd-mark-incomple
5f40: 74 65 2d 61 6c 6c 2d 72 75 6e 73 20 23 21 6b 65 te-all-runs #!ke
5f50: 79 20 28 6f 76 72 2d 64 65 61 64 74 69 6d 65 20 y (ovr-deadtime
5f60: 23 66 29 29 0a 20 20 28 6c 65 74 20 28 28 72 75 #f)). (let ((ru
5f70: 6e 2d 69 64 73 20 28 72 6d 74 3a 67 65 74 2d 61 n-ids (rmt:get-a
5f80: 6c 6c 2d 72 75 6e 2d 69 64 73 29 29 29 0a 20 20 ll-run-ids))).
5f90: 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d (for-each (lam
5fa0: 62 64 61 20 28 72 75 6e 2d 69 64 29 0a 09 20 20 bda (run-id)..
5fb0: 20 20 20 20 20 28 72 6d 74 3a 66 69 6e 64 2d 61 (rmt:find-a
5fc0: 6e 64 2d 6d 61 72 6b 2d 69 6e 63 6f 6d 70 6c 65 nd-mark-incomple
5fd0: 74 65 20 72 75 6e 2d 69 64 20 6f 76 72 2d 64 65 te run-id ovr-de
5fe0: 61 64 74 69 6d 65 29 29 0a 09 20 20 20 20 20 72 adtime)).. r
5ff0: 75 6e 2d 69 64 73 29 29 29 0a 0a 3b 3b 20 67 65 un-ids)))..;; ge
6000: 74 20 74 68 65 20 70 72 65 76 69 6f 75 73 20 72 t the previous r
6010: 65 63 6f 72 64 20 66 6f 72 20 77 68 65 6e 20 74 ecord for when t
6020: 68 69 73 20 74 65 73 74 20 77 61 73 20 72 75 6e his test was run
6030: 20 77 68 65 72 65 20 61 6c 6c 20 6b 65 79 73 20 where all keys
6040: 6d 61 74 63 68 20 62 75 74 20 72 75 6e 6e 61 6d match but runnam
6050: 65 0a 3b 3b 20 72 65 74 75 72 6e 73 20 23 66 20 e.;; returns #f
6060: 69 66 20 6e 6f 20 73 75 63 68 20 74 65 73 74 20 if no such test
6070: 66 6f 75 6e 64 2c 20 72 65 74 75 72 6e 73 20 61 found, returns a
6080: 20 73 69 6e 67 6c 65 20 74 65 73 74 20 72 65 63 single test rec
6090: 6f 72 64 20 69 66 20 66 6f 75 6e 64 0a 3b 3b 20 ord if found.;;
60a0: 0a 3b 3b 20 52 75 6e 20 74 68 69 73 20 61 74 20 .;; Run this at
60b0: 74 68 65 20 63 6c 69 65 6e 74 20 65 6e 64 20 73 the client end s
60c0: 69 6e 63 65 20 77 65 20 68 61 76 65 20 74 6f 20 ince we have to
60d0: 63 6f 6e 6e 65 63 74 20 74 6f 20 6d 75 6c 74 69 connect to multi
60e0: 70 6c 65 20 72 75 6e 2d 69 64 20 64 62 73 0a 3b ple run-id dbs.;
60f0: 3b 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 ;.(define (rmt:g
6100: 65 74 2d 70 72 65 76 69 6f 75 73 2d 74 65 73 74 et-previous-test
6110: 2d 72 75 6e 2d 72 65 63 6f 72 64 20 72 75 6e 2d -run-record run-
6120: 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 id test-name ite
6130: 6d 2d 70 61 74 68 29 0a 20 20 28 6c 65 74 2a 20 m-path). (let*
6140: 28 28 6b 65 79 76 61 6c 73 20 28 72 6d 74 3a 67 ((keyvals (rmt:g
6150: 65 74 2d 6b 65 79 2d 76 61 6c 2d 70 61 69 72 73 et-key-val-pairs
6160: 20 72 75 6e 2d 69 64 29 29 0a 09 20 28 6b 65 79 run-id)).. (key
6170: 73 20 20 20 20 28 72 6d 74 3a 67 65 74 2d 6b 65 s (rmt:get-ke
6180: 79 73 29 29 0a 09 20 28 73 65 6c 73 74 72 20 20 ys)).. (selstr
6190: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
61a0: 72 73 65 20 20 6b 65 79 73 20 22 2c 22 29 29 0a rse keys ",")).
61b0: 09 20 28 71 72 79 73 74 72 20 20 28 73 74 72 69 . (qrystr (stri
61c0: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 ng-intersperse (
61d0: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 78 29 28 map (lambda (x)(
61e0: 63 6f 6e 63 20 78 20 22 3d 3f 22 29 29 20 6b 65 conc x "=?")) ke
61f0: 79 73 29 20 22 20 41 4e 44 20 22 29 29 29 0a 20 ys) " AND "))).
6200: 20 20 20 28 69 66 20 28 6e 6f 74 20 6b 65 79 76 (if (not keyv
6210: 61 6c 73 29 0a 09 23 66 0a 09 28 6c 65 74 20 28 als)..#f..(let (
6220: 28 70 72 65 76 2d 72 75 6e 2d 69 64 73 20 28 72 (prev-run-ids (r
6230: 6d 74 3a 67 65 74 2d 70 72 65 76 2d 72 75 6e 2d mt:get-prev-run-
6240: 69 64 73 20 72 75 6e 2d 69 64 29 29 29 0a 09 20 ids run-id)))..
6250: 20 3b 3b 20 66 6f 72 20 65 61 63 68 20 72 75 6e ;; for each run
6260: 20 73 74 61 72 74 69 6e 67 20 77 69 74 68 20 74 starting with t
6270: 68 65 20 6d 6f 73 74 20 72 65 63 65 6e 74 20 6c he most recent l
6280: 6f 6f 6b 20 74 6f 20 73 65 65 20 69 66 20 74 68 ook to see if th
6290: 65 72 65 20 69 73 20 61 20 6d 61 74 63 68 69 6e ere is a matchin
62a0: 67 20 74 65 73 74 0a 09 20 20 3b 3b 20 69 66 20 g test.. ;; if
62b0: 66 6f 75 6e 64 20 74 68 65 6e 20 72 65 74 75 72 found then retur
62c0: 6e 20 74 68 61 74 20 6d 61 74 63 68 69 6e 67 20 n that matching
62d0: 74 65 73 74 20 72 65 63 6f 72 64 0a 09 20 20 28 test record.. (
62e0: 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 2a 64 debug:print 4 *d
62f0: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
6300: 20 22 73 65 6c 73 74 72 3a 20 22 20 73 65 6c 73 "selstr: " sels
6310: 74 72 20 22 2c 20 71 72 79 73 74 72 3a 20 22 20 tr ", qrystr: "
6320: 71 72 79 73 74 72 20 22 2c 20 6b 65 79 76 61 6c qrystr ", keyval
6330: 73 3a 20 22 20 6b 65 79 76 61 6c 73 20 22 2c 20 s: " keyvals ",
6340: 70 72 65 76 69 6f 75 73 20 72 75 6e 20 69 64 73 previous run ids
6350: 20 66 6f 75 6e 64 3a 20 22 20 70 72 65 76 2d 72 found: " prev-r
6360: 75 6e 2d 69 64 73 29 0a 09 20 20 28 69 66 20 28 un-ids).. (if (
6370: 6e 75 6c 6c 3f 20 70 72 65 76 2d 72 75 6e 2d 69 null? prev-run-i
6380: 64 73 29 20 23 66 0a 09 20 20 20 20 20 20 28 6c ds) #f.. (l
6390: 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 20 28 63 et loop ((hed (c
63a0: 61 72 20 70 72 65 76 2d 72 75 6e 2d 69 64 73 29 ar prev-run-ids)
63b0: 29 0a 09 09 09 20 28 74 61 6c 20 28 63 64 72 20 ).... (tal (cdr
63c0: 70 72 65 76 2d 72 75 6e 2d 69 64 73 29 29 29 0a prev-run-ids))).
63d0: 09 09 28 6c 65 74 20 28 28 72 65 73 75 6c 74 73 ..(let ((results
63e0: 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 73 2d (rmt:get-tests-
63f0: 66 6f 72 2d 72 75 6e 20 68 65 64 20 28 63 6f 6e for-run hed (con
6400: 63 20 74 65 73 74 2d 6e 61 6d 65 20 22 2f 22 20 c test-name "/"
6410: 69 74 65 6d 2d 70 61 74 68 29 20 27 28 29 20 27 item-path) '() '
6420: 28 29 20 3b 3b 20 72 75 6e 2d 69 64 20 74 65 73 () ;; run-id tes
6430: 74 70 61 74 74 20 73 74 61 74 65 73 20 73 74 61 tpatt states sta
6440: 74 75 73 65 73 0a 09 09 09 09 09 09 20 20 20 20 tuses.......
6450: 20 20 23 66 20 23 66 20 23 66 20 20 20 20 20 20 #f #f #f
6460: 20 20 20 20 20 20 20 20 20 3b 3b 20 6f 66 66 73 ;; offs
6470: 65 74 20 6c 69 6d 69 74 20 6e 6f 74 2d 69 6e 20 et limit not-in
6480: 68 69 64 65 2f 6e 6f 74 2d 68 69 64 65 0a 09 09 hide/not-hide...
6490: 09 09 09 09 20 20 20 20 20 20 23 66 20 23 66 20 .... #f #f
64a0: 23 66 20 23 66 20 27 6e 6f 72 6d 61 6c 29 29 29 #f #f 'normal)))
64b0: 20 3b 3b 20 73 6f 72 74 2d 62 79 20 73 6f 72 74 ;; sort-by sort
64c0: 2d 6f 72 64 65 72 20 71 72 79 76 61 6c 73 20 6c -order qryvals l
64d0: 61 73 74 2d 75 70 64 61 74 65 20 6d 6f 64 65 0a ast-update mode.
64e0: 09 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
64f0: 20 34 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 4 *default-log-
6500: 70 6f 72 74 2a 20 22 47 6f 74 20 74 65 73 74 73 port* "Got tests
6510: 20 66 6f 72 20 72 75 6e 2d 69 64 20 22 20 72 75 for run-id " ru
6520: 6e 2d 69 64 20 22 2c 20 74 65 73 74 2d 6e 61 6d n-id ", test-nam
6530: 65 20 22 20 74 65 73 74 2d 6e 61 6d 65 20 22 2c e " test-name ",
6540: 20 69 74 65 6d 2d 70 61 74 68 20 22 20 69 74 65 item-path " ite
6550: 6d 2d 70 61 74 68 20 22 3a 20 22 20 72 65 73 75 m-path ": " resu
6560: 6c 74 73 29 0a 09 09 20 20 28 69 66 20 28 61 6e lts)... (if (an
6570: 64 20 28 6e 75 6c 6c 3f 20 72 65 73 75 6c 74 73 d (null? results
6580: 29 0a 09 09 09 20 20 20 28 6e 6f 74 20 28 6e 75 ).... (not (nu
6590: 6c 6c 3f 20 74 61 6c 29 29 29 0a 09 09 20 20 20 ll? tal)))...
65a0: 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 (loop (car ta
65b0: 6c 29 28 63 64 72 20 74 61 6c 29 29 0a 09 09 20 l)(cdr tal))...
65c0: 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 (if (null?
65d0: 72 65 73 75 6c 74 73 29 20 23 66 0a 09 09 09 20 results) #f....
65e0: 20 28 63 61 72 20 72 65 73 75 6c 74 73 29 29 29 (car results)))
65f0: 29 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 )))))))..(define
6600: 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e 2d 73 74 (rmt:get-run-st
6610: 61 74 73 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 ats). (rmt:send
6620: 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d 72 75 -receive 'get-ru
6630: 6e 2d 73 74 61 74 73 20 23 66 20 27 28 29 29 29 n-stats #f '()))
6640: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
6650: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6660: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6670: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6680: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 20 53 ==========.;; S
6690: 20 54 20 45 20 50 20 53 0a 3b 3b 3d 3d 3d 3d 3d T E P S.;;=====
66a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
66b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
66c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
66d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
66e0: 3d 0a 0a 3b 3b 20 47 65 74 74 69 6e 67 20 73 74 =..;; Getting st
66f0: 65 70 73 20 69 73 20 6d 6f 72 65 20 63 6f 6d 70 eps is more comp
6700: 6c 69 63 61 74 65 64 2e 0a 3b 3b 0a 3b 3b 20 49 licated..;;.;; I
6710: 66 20 67 69 76 65 6e 20 77 6f 72 6b 20 61 72 65 f given work are
6720: 61 20 0a 3b 3b 20 20 31 2e 20 46 69 6e 64 20 74 a .;; 1. Find t
6730: 68 65 20 74 65 73 74 64 61 74 2e 64 62 20 66 69 he testdat.db fi
6740: 6c 65 0a 3b 3b 20 20 32 2e 20 4f 70 65 6e 20 74 le.;; 2. Open t
6750: 68 65 20 74 65 73 74 64 61 74 2e 64 62 20 66 69 he testdat.db fi
6760: 6c 65 20 61 6e 64 20 64 6f 20 74 68 65 20 71 75 le and do the qu
6770: 65 72 79 0a 3b 3b 20 49 66 20 6e 6f 74 20 67 69 ery.;; If not gi
6780: 76 65 6e 20 74 68 65 20 77 6f 72 6b 20 61 72 65 ven the work are
6790: 61 0a 3b 3b 20 20 31 2e 20 44 6f 20 61 20 72 65 a.;; 1. Do a re
67a0: 6d 6f 74 65 20 63 61 6c 6c 20 74 6f 20 67 65 74 mote call to get
67b0: 20 74 68 65 20 74 65 73 74 20 70 61 74 68 0a 3b the test path.;
67c0: 3b 20 20 32 2e 20 43 6f 6e 74 69 6e 75 65 20 61 ; 2. Continue a
67d0: 73 20 61 62 6f 76 65 0a 3b 3b 20 0a 3b 3b 28 64 s above.;; .;;(d
67e0: 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 73 efine (rmt:get-s
67f0: 74 65 70 73 2d 66 6f 72 2d 74 65 73 74 20 72 75 teps-for-test ru
6800: 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 0a 3b 3b n-id test-id).;;
6810: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
6820: 69 76 65 20 27 67 65 74 2d 73 74 65 70 73 2d 64 ive 'get-steps-d
6830: 61 74 61 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 ata run-id (list
6840: 20 74 65 73 74 2d 69 64 29 29 29 0a 0a 28 64 65 test-id)))..(de
6850: 66 69 6e 65 20 28 72 6d 74 3a 74 65 73 74 73 74 fine (rmt:testst
6860: 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 20 72 ep-set-status! r
6870: 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 74 65 un-id test-id te
6880: 73 74 73 74 65 70 2d 6e 61 6d 65 20 73 74 61 74 ststep-name stat
6890: 65 2d 69 6e 20 73 74 61 74 75 73 2d 69 6e 20 63 e-in status-in c
68a0: 6f 6d 6d 65 6e 74 20 6c 6f 67 66 69 6c 65 29 0a omment logfile).
68b0: 20 20 28 61 73 73 65 72 74 20 28 6e 75 6d 62 65 (assert (numbe
68c0: 72 3f 20 72 75 6e 2d 69 64 29 20 22 46 41 54 41 r? run-id) "FATA
68d0: 4c 3a 20 52 75 6e 20 69 64 20 72 65 71 75 69 72 L: Run id requir
68e0: 65 64 2e 22 29 0a 20 20 28 6c 65 74 2a 20 28 28 ed."). (let* ((
68f0: 73 74 61 74 65 20 20 20 20 20 28 69 74 65 6d 73 state (items
6900: 3a 63 68 65 63 6b 2d 76 61 6c 69 64 2d 69 74 65 :check-valid-ite
6910: 6d 73 20 22 73 74 61 74 65 22 20 73 74 61 74 65 ms "state" state
6920: 2d 69 6e 29 29 0a 09 20 28 73 74 61 74 75 73 20 -in)).. (status
6930: 20 20 20 28 69 74 65 6d 73 3a 63 68 65 63 6b 2d (items:check-
6940: 76 61 6c 69 64 2d 69 74 65 6d 73 20 22 73 74 61 valid-items "sta
6950: 74 75 73 22 20 73 74 61 74 75 73 2d 69 6e 29 29 tus" status-in))
6960: 29 0a 20 20 20 20 28 69 66 20 28 6f 72 20 28 6e ). (if (or (n
6970: 6f 74 20 73 74 61 74 65 29 28 6e 6f 74 20 73 74 ot state)(not st
6980: 61 74 75 73 29 29 0a 09 28 64 65 62 75 67 3a 70 atus))..(debug:p
6990: 72 69 6e 74 20 33 20 2a 64 65 66 61 75 6c 74 2d rint 3 *default-
69a0: 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 log-port* "WARNI
69b0: 4e 47 3a 20 49 6e 76 61 6c 69 64 20 22 20 28 69 NG: Invalid " (i
69c0: 66 20 73 74 61 74 75 73 20 22 73 74 61 74 75 73 f status "status
69d0: 22 20 22 73 74 61 74 65 22 29 0a 09 09 20 20 20 " "state")...
69e0: 20 20 22 20 76 61 6c 75 65 20 5c 22 22 20 28 69 " value \"" (i
69f0: 66 20 73 74 61 74 75 73 20 73 74 61 74 65 2d 69 f status state-i
6a00: 6e 20 73 74 61 74 75 73 2d 69 6e 29 20 22 5c 22 n status-in) "\"
6a10: 2c 20 75 70 64 61 74 65 20 79 6f 75 72 20 76 61 , update your va
6a20: 6c 69 64 76 61 6c 75 65 73 20 73 65 63 74 69 6f lidvalues sectio
6a30: 6e 20 69 6e 20 6d 65 67 61 74 65 73 74 2e 63 6f n in megatest.co
6a40: 6e 66 69 67 22 29 29 0a 20 20 20 20 28 72 6d 74 nfig")). (rmt
6a50: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 74 :send-receive 't
6a60: 65 73 74 73 74 65 70 2d 73 65 74 2d 73 74 61 74 eststep-set-stat
6a70: 75 73 21 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 us! run-id (list
6a80: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 run-id test-id
6a90: 74 65 73 74 73 74 65 70 2d 6e 61 6d 65 20 73 74 teststep-name st
6aa0: 61 74 65 2d 69 6e 20 73 74 61 74 75 73 2d 69 6e ate-in status-in
6ab0: 20 63 6f 6d 6d 65 6e 74 20 6c 6f 67 66 69 6c 65 comment logfile
6ac0: 29 29 29 29 0a 0a 0a 28 64 65 66 69 6e 65 20 28 ))))...(define (
6ad0: 72 6d 74 3a 64 65 6c 65 74 65 2d 73 74 65 70 73 rmt:delete-steps
6ae0: 2d 66 6f 72 2d 74 65 73 74 21 20 72 75 6e 2d 69 -for-test! run-i
6af0: 64 20 74 65 73 74 2d 69 64 29 0a 20 20 28 61 73 d test-id). (as
6b00: 73 65 72 74 20 28 6e 75 6d 62 65 72 3f 20 72 75 sert (number? ru
6b10: 6e 2d 69 64 29 20 22 46 41 54 41 4c 3a 20 52 75 n-id) "FATAL: Ru
6b20: 6e 20 69 64 20 72 65 71 75 69 72 65 64 2e 22 29 n id required.")
6b30: 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 . (rmt:send-rec
6b40: 65 69 76 65 20 27 64 65 6c 65 74 65 2d 73 74 65 eive 'delete-ste
6b50: 70 73 2d 66 6f 72 2d 74 65 73 74 21 20 72 75 6e ps-for-test! run
6b60: 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 -id (list run-id
6b70: 20 74 65 73 74 2d 69 64 29 29 29 0a 0a 28 64 65 test-id)))..(de
6b80: 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 73 74 fine (rmt:get-st
6b90: 65 70 73 2d 66 6f 72 2d 74 65 73 74 20 72 75 6e eps-for-test run
6ba0: 2d 69 64 20 74 65 73 74 2d 69 64 29 0a 20 20 28 -id test-id). (
6bb0: 61 73 73 65 72 74 20 28 6e 75 6d 62 65 72 3f 20 assert (number?
6bc0: 72 75 6e 2d 69 64 29 20 22 46 41 54 41 4c 3a 20 run-id) "FATAL:
6bd0: 52 75 6e 20 69 64 20 72 65 71 75 69 72 65 64 2e Run id required.
6be0: 22 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 "). (rmt:send-r
6bf0: 65 63 65 69 76 65 20 27 67 65 74 2d 73 74 65 70 eceive 'get-step
6c00: 73 2d 66 6f 72 2d 74 65 73 74 20 72 75 6e 2d 69 s-for-test run-i
6c10: 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 20 74 d (list run-id t
6c20: 65 73 74 2d 69 64 29 29 29 0a 0a 28 64 65 66 69 est-id)))..(defi
6c30: 6e 65 20 28 72 6d 74 3a 67 65 74 2d 73 74 65 70 ne (rmt:get-step
6c40: 73 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 72 75 6e s-info-by-id run
6c50: 2d 69 64 20 74 65 73 74 2d 73 74 65 70 2d 69 64 -id test-step-id
6c60: 29 0a 20 20 28 61 73 73 65 72 74 20 28 6e 75 6d ). (assert (num
6c70: 62 65 72 3f 20 72 75 6e 2d 69 64 29 20 22 46 41 ber? run-id) "FA
6c80: 54 41 4c 3a 20 52 75 6e 20 69 64 20 72 65 71 75 TAL: Run id requ
6c90: 69 72 65 64 2e 22 29 0a 20 20 28 72 6d 74 3a 73 ired."). (rmt:s
6ca0: 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 end-receive 'get
6cb0: 2d 73 74 65 70 73 2d 69 6e 66 6f 2d 62 79 2d 69 -steps-info-by-i
6cc0: 64 20 23 66 20 28 6c 69 73 74 20 72 75 6e 2d 69 d #f (list run-i
6cd0: 64 20 74 65 73 74 2d 73 74 65 70 2d 69 64 29 29 d test-step-id))
6ce0: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
6cf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6d00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6d10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6d20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 20 ===========.;;
6d30: 54 20 45 20 53 20 54 20 20 20 44 20 41 20 54 20 T E S T D A T
6d40: 41 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d A .;;===========
6d50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6d60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6d70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6d80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 ===========..(de
6d90: 66 69 6e 65 20 28 72 6d 74 3a 72 65 61 64 2d 74 fine (rmt:read-t
6da0: 65 73 74 2d 64 61 74 61 20 72 75 6e 2d 69 64 20 est-data run-id
6db0: 74 65 73 74 2d 69 64 20 63 61 74 65 67 6f 72 79 test-id category
6dc0: 70 61 74 74 20 23 21 6b 65 79 20 28 77 6f 72 6b patt #!key (work
6dd0: 2d 61 72 65 61 20 23 66 29 29 20 0a 20 20 28 61 -area #f)) . (a
6de0: 73 73 65 72 74 20 28 6e 75 6d 62 65 72 3f 20 72 ssert (number? r
6df0: 75 6e 2d 69 64 29 20 22 46 41 54 41 4c 3a 20 52 un-id) "FATAL: R
6e00: 75 6e 20 69 64 20 72 65 71 75 69 72 65 64 2e 22 un id required."
6e10: 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 ). (rmt:send-re
6e20: 63 65 69 76 65 20 27 72 65 61 64 2d 74 65 73 74 ceive 'read-test
6e30: 2d 64 61 74 61 20 72 75 6e 2d 69 64 20 28 6c 69 -data run-id (li
6e40: 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 st run-id test-i
6e50: 64 20 63 61 74 65 67 6f 72 79 70 61 74 74 29 29 d categorypatt))
6e60: 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a )..(define (rmt:
6e70: 72 65 61 64 2d 74 65 73 74 2d 64 61 74 61 2d 76 read-test-data-v
6e80: 61 72 70 61 74 74 20 72 75 6e 2d 69 64 20 74 65 arpatt run-id te
6e90: 73 74 2d 69 64 20 63 61 74 65 67 6f 72 79 70 61 st-id categorypa
6ea0: 74 74 20 76 61 72 70 61 74 74 20 23 21 6b 65 79 tt varpatt #!key
6eb0: 20 28 77 6f 72 6b 2d 61 72 65 61 20 23 66 29 29 (work-area #f))
6ec0: 20 0a 20 20 28 61 73 73 65 72 74 20 28 6e 75 6d . (assert (num
6ed0: 62 65 72 3f 20 72 75 6e 2d 69 64 29 20 22 46 41 ber? run-id) "FA
6ee0: 54 41 4c 3a 20 52 75 6e 20 69 64 20 72 65 71 75 TAL: Run id requ
6ef0: 69 72 65 64 2e 22 29 0a 20 20 28 72 6d 74 3a 73 ired."). (rmt:s
6f00: 65 6e 64 2d 72 65 63 65 69 76 65 20 27 72 65 61 end-receive 'rea
6f10: 64 2d 74 65 73 74 2d 64 61 74 61 2d 76 61 72 70 d-test-data-varp
6f20: 61 74 74 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 att run-id (list
6f30: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 run-id test-id
6f40: 63 61 74 65 67 6f 72 79 70 61 74 74 20 76 61 72 categorypatt var
6f50: 70 61 74 74 29 29 29 0a 0a 28 64 65 66 69 6e 65 patt)))..(define
6f60: 20 28 72 6d 74 3a 67 65 74 2d 64 61 74 61 2d 69 (rmt:get-data-i
6f70: 6e 66 6f 2d 62 79 2d 69 64 20 72 75 6e 2d 69 64 nfo-by-id run-id
6f80: 20 74 65 73 74 2d 64 61 74 61 2d 69 64 29 0a 20 test-data-id).
6f90: 20 28 61 73 73 65 72 74 20 28 6e 75 6d 62 65 72 (assert (number
6fa0: 3f 20 72 75 6e 2d 69 64 29 20 22 46 41 54 41 4c ? run-id) "FATAL
6fb0: 3a 20 52 75 6e 20 69 64 20 72 65 71 75 69 72 65 : Run id require
6fc0: 64 2e 22 29 0a 20 20 20 28 72 6d 74 3a 73 65 6e d."). (rmt:sen
6fd0: 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d 64 d-receive 'get-d
6fe0: 61 74 61 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 23 ata-info-by-id #
6ff0: 66 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 20 74 f (list run-id t
7000: 65 73 74 2d 64 61 74 61 2d 69 64 29 29 29 0a 0a est-data-id)))..
7010: 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 74 65 73 (define (rmt:tes
7020: 74 6d 65 74 61 2d 61 64 64 2d 72 65 63 6f 72 64 tmeta-add-record
7030: 20 74 65 73 74 6e 61 6d 65 29 0a 20 20 28 72 6d testname). (rm
7040: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
7050: 74 65 73 74 6d 65 74 61 2d 61 64 64 2d 72 65 63 testmeta-add-rec
7060: 6f 72 64 20 23 66 20 28 6c 69 73 74 20 74 65 73 ord #f (list tes
7070: 74 6e 61 6d 65 29 29 29 0a 0a 28 64 65 66 69 6e tname)))..(defin
7080: 65 20 28 72 6d 74 3a 74 65 73 74 6d 65 74 61 2d e (rmt:testmeta-
7090: 67 65 74 2d 72 65 63 6f 72 64 20 74 65 73 74 6e get-record testn
70a0: 61 6d 65 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 ame). (rmt:send
70b0: 2d 72 65 63 65 69 76 65 20 27 74 65 73 74 6d 65 -receive 'testme
70c0: 74 61 2d 67 65 74 2d 72 65 63 6f 72 64 20 23 66 ta-get-record #f
70d0: 20 28 6c 69 73 74 20 74 65 73 74 6e 61 6d 65 29 (list testname)
70e0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 ))..(define (rmt
70f0: 3a 74 65 73 74 6d 65 74 61 2d 75 70 64 61 74 65 :testmeta-update
7100: 2d 66 69 65 6c 64 20 74 65 73 74 2d 6e 61 6d 65 -field test-name
7110: 20 66 6c 64 20 76 61 6c 29 0a 20 20 28 72 6d 74 fld val). (rmt
7120: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 74 :send-receive 't
7130: 65 73 74 6d 65 74 61 2d 75 70 64 61 74 65 2d 66 estmeta-update-f
7140: 69 65 6c 64 20 23 66 20 28 6c 69 73 74 20 74 65 ield #f (list te
7150: 73 74 2d 6e 61 6d 65 20 66 6c 64 20 76 61 6c 29 st-name fld val)
7160: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 ))..(define (rmt
7170: 3a 74 65 73 74 2d 64 61 74 61 2d 72 6f 6c 6c 75 :test-data-rollu
7180: 70 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 p run-id test-id
7190: 20 73 74 61 74 75 73 29 0a 20 20 28 61 73 73 65 status). (asse
71a0: 72 74 20 28 6e 75 6d 62 65 72 3f 20 72 75 6e 2d rt (number? run-
71b0: 69 64 29 20 22 46 41 54 41 4c 3a 20 52 75 6e 20 id) "FATAL: Run
71c0: 69 64 20 72 65 71 75 69 72 65 64 2e 22 29 0a 20 id required.").
71d0: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
71e0: 76 65 20 27 74 65 73 74 2d 64 61 74 61 2d 72 6f ve 'test-data-ro
71f0: 6c 6c 75 70 20 72 75 6e 2d 69 64 20 28 6c 69 73 llup run-id (lis
7200: 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 t run-id test-id
7210: 20 73 74 61 74 75 73 29 29 29 0a 0a 28 64 65 66 status)))..(def
7220: 69 6e 65 20 28 72 6d 74 3a 63 73 76 2d 3e 74 65 ine (rmt:csv->te
7230: 73 74 2d 64 61 74 61 20 72 75 6e 2d 69 64 20 74 st-data run-id t
7240: 65 73 74 2d 69 64 20 63 73 76 64 61 74 61 29 0a est-id csvdata).
7250: 20 20 28 61 73 73 65 72 74 20 28 6e 75 6d 62 65 (assert (numbe
7260: 72 3f 20 72 75 6e 2d 69 64 29 20 22 46 41 54 41 r? run-id) "FATA
7270: 4c 3a 20 52 75 6e 20 69 64 20 72 65 71 75 69 72 L: Run id requir
7280: 65 64 2e 22 29 0a 20 20 28 72 6d 74 3a 73 65 6e ed."). (rmt:sen
7290: 64 2d 72 65 63 65 69 76 65 20 27 63 73 76 2d 3e d-receive 'csv->
72a0: 74 65 73 74 2d 64 61 74 61 20 72 75 6e 2d 69 64 test-data run-id
72b0: 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 20 74 65 (list run-id te
72c0: 73 74 2d 69 64 20 63 73 76 64 61 74 61 29 29 29 st-id csvdata)))
72d0: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
72e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
72f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7300: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7310: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 20 54 ==========.;; T
7320: 20 41 20 53 20 4b 20 53 0a 3b 3b 3d 3d 3d 3d 3d A S K S.;;=====
7330: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7340: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7350: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7370: 3d 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a =..(define (rmt:
7380: 74 61 73 6b 73 2d 66 69 6e 64 2d 74 61 73 6b 2d tasks-find-task-
7390: 71 75 65 75 65 2d 72 65 63 6f 72 64 73 20 74 61 queue-records ta
73a0: 72 67 65 74 20 72 75 6e 2d 6e 61 6d 65 20 74 65 rget run-name te
73b0: 73 74 2d 70 61 74 74 20 73 74 61 74 65 2d 70 61 st-patt state-pa
73c0: 74 74 20 61 63 74 69 6f 6e 2d 70 61 74 74 29 0a tt action-patt).
73d0: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
73e0: 69 76 65 20 27 66 69 6e 64 2d 74 61 73 6b 2d 71 ive 'find-task-q
73f0: 75 65 75 65 2d 72 65 63 6f 72 64 73 20 23 66 20 ueue-records #f
7400: 28 6c 69 73 74 20 74 61 72 67 65 74 20 72 75 6e (list target run
7410: 2d 6e 61 6d 65 20 74 65 73 74 2d 70 61 74 74 20 -name test-patt
7420: 73 74 61 74 65 2d 70 61 74 74 20 61 63 74 69 6f state-patt actio
7430: 6e 2d 70 61 74 74 29 29 29 0a 0a 28 64 65 66 69 n-patt)))..(defi
7440: 6e 65 20 28 72 6d 74 3a 74 61 73 6b 73 2d 61 64 ne (rmt:tasks-ad
7450: 64 20 61 63 74 69 6f 6e 20 6f 77 6e 65 72 20 74 d action owner t
7460: 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 74 65 arget runname te
7470: 73 74 70 61 74 74 20 70 61 72 61 6d 73 29 0a 20 stpatt params).
7480: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
7490: 76 65 20 27 74 61 73 6b 73 2d 61 64 64 20 23 66 ve 'tasks-add #f
74a0: 20 28 6c 69 73 74 20 61 63 74 69 6f 6e 20 6f 77 (list action ow
74b0: 6e 65 72 20 74 61 72 67 65 74 20 72 75 6e 6e 61 ner target runna
74c0: 6d 65 20 74 65 73 74 70 61 74 74 20 70 61 72 61 me testpatt para
74d0: 6d 73 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 ms)))..(define (
74e0: 72 6d 74 3a 74 61 73 6b 73 2d 73 65 74 2d 73 74 rmt:tasks-set-st
74f0: 61 74 65 2d 67 69 76 65 6e 2d 70 61 72 61 6d 2d ate-given-param-
7500: 6b 65 79 20 70 61 72 61 6d 2d 6b 65 79 20 6e 65 key param-key ne
7510: 77 2d 73 74 61 74 65 29 0a 20 20 28 72 6d 74 3a w-state). (rmt:
7520: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 74 61 send-receive 'ta
7530: 73 6b 73 2d 73 65 74 2d 73 74 61 74 65 2d 67 69 sks-set-state-gi
7540: 76 65 6e 2d 70 61 72 61 6d 2d 6b 65 79 20 23 66 ven-param-key #f
7550: 20 28 6c 69 73 74 20 20 70 61 72 61 6d 2d 6b 65 (list param-ke
7560: 79 20 6e 65 77 2d 73 74 61 74 65 29 29 29 0a 0a y new-state)))..
7570: 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 74 61 73 (define (rmt:tas
7580: 6b 73 2d 67 65 74 2d 6c 61 73 74 20 74 61 72 67 ks-get-last targ
7590: 65 74 20 72 75 6e 6e 61 6d 65 29 0a 20 20 28 72 et runname). (r
75a0: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
75b0: 27 74 61 73 6b 73 2d 67 65 74 2d 6c 61 73 74 20 'tasks-get-last
75c0: 23 66 20 28 6c 69 73 74 20 74 61 72 67 65 74 20 #f (list target
75d0: 72 75 6e 6e 61 6d 65 29 29 29 0a 0a 3b 3b 3d 3d runname)))..;;==
75e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
75f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7600: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7610: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7620: 3d 3d 3d 3d 0a 3b 3b 20 4e 20 4f 20 20 20 53 20 ====.;; N O S
7630: 59 20 4e 20 43 20 20 20 44 20 42 20 0a 3b 3b 3d Y N C D B .;;=
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 3d 0a 0a 28 64 65 66 69 6e 65 20 28 =====..(define (
7690: 72 6d 74 3a 6e 6f 2d 73 79 6e 63 2d 73 65 74 20 rmt:no-sync-set
76a0: 76 61 72 20 76 61 6c 29 0a 20 20 28 72 6d 74 3a var val). (rmt:
76b0: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 6e 6f send-receive 'no
76c0: 2d 73 79 6e 63 2d 73 65 74 20 23 66 20 60 28 2c -sync-set #f `(,
76d0: 76 61 72 20 2c 76 61 6c 29 29 29 0a 0a 28 64 65 var ,val)))..(de
76e0: 66 69 6e 65 20 28 72 6d 74 3a 6e 6f 2d 73 79 6e fine (rmt:no-syn
76f0: 63 2d 67 65 74 2f 64 65 66 61 75 6c 74 20 76 61 c-get/default va
7700: 72 20 64 65 66 61 75 6c 74 29 0a 20 20 28 72 6d r default). (rm
7710: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
7720: 6e 6f 2d 73 79 6e 63 2d 67 65 74 2f 64 65 66 61 no-sync-get/defa
7730: 75 6c 74 20 23 66 20 60 28 2c 76 61 72 20 2c 64 ult #f `(,var ,d
7740: 65 66 61 75 6c 74 29 29 29 0a 0a 28 64 65 66 69 efault)))..(defi
7750: 6e 65 20 28 72 6d 74 3a 6e 6f 2d 73 79 6e 63 2d ne (rmt:no-sync-
7760: 64 65 6c 21 20 76 61 72 29 0a 20 20 28 72 6d 74 del! var). (rmt
7770: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 6e :send-receive 'n
7780: 6f 2d 73 79 6e 63 2d 64 65 6c 21 20 23 66 20 60 o-sync-del! #f `
7790: 28 2c 76 61 72 29 29 29 0a 0a 28 64 65 66 69 6e (,var)))..(defin
77a0: 65 20 28 72 6d 74 3a 6e 6f 2d 73 79 6e 63 2d 67 e (rmt:no-sync-g
77b0: 65 74 2d 6c 6f 63 6b 20 6b 65 79 6e 61 6d 65 29 et-lock keyname)
77c0: 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 . (rmt:send-rec
77d0: 65 69 76 65 20 27 6e 6f 2d 73 79 6e 63 2d 67 65 eive 'no-sync-ge
77e0: 74 2d 6c 6f 63 6b 20 23 66 20 60 28 2c 6b 65 79 t-lock #f `(,key
77f0: 6e 61 6d 65 29 29 29 0a 0a 28 64 65 66 69 6e 65 name)))..(define
7800: 20 28 72 6d 74 3a 6e 6f 2d 73 79 6e 63 2d 61 64 (rmt:no-sync-ad
7810: 64 2d 6a 6f 62 20 68 6f 73 74 2d 74 79 70 65 20 d-job host-type
7820: 76 61 72 73 2d 6c 69 73 74 20 65 78 65 6b 65 79 vars-list exekey
7830: 20 63 6d 64 6c 69 6e 65 29 0a 20 20 28 72 6d 74 cmdline). (rmt
7840: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 6e :send-receive 'n
7850: 6f 2d 73 79 6e 63 2d 61 64 64 2d 6a 6f 62 20 23 o-sync-add-job #
7860: 66 20 60 28 2c 68 6f 73 74 2d 74 79 70 65 20 2c f `(,host-type ,
7870: 76 61 72 73 2d 6c 69 73 74 20 2c 65 78 65 6b 65 vars-list ,exeke
7880: 79 20 2c 63 6d 64 6c 69 6e 65 29 29 29 0a 0a 28 y ,cmdline)))..(
7890: 64 65 66 69 6e 65 20 28 72 6d 74 3a 6e 6f 2d 73 define (rmt:no-s
78a0: 79 6e 63 2d 74 61 6b 65 2d 6a 6f 62 20 68 6f 73 ync-take-job hos
78b0: 74 2d 74 79 70 65 29 0a 20 20 28 72 6d 74 3a 73 t-type). (rmt:s
78c0: 65 6e 64 2d 72 65 63 65 69 76 65 20 27 6e 6f 2d end-receive 'no-
78d0: 73 79 6e 63 2d 74 61 6b 65 2d 6a 6f 62 20 23 66 sync-take-job #f
78e0: 20 60 28 2c 68 6f 73 74 2d 74 79 70 65 29 29 29 `(,host-type)))
78f0: 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 6e ..(define (rmt:n
7900: 6f 2d 73 79 6e 63 2d 6a 6f 62 2d 72 65 63 6f 72 o-sync-job-recor
7910: 64 73 2d 63 6c 65 61 6e 29 0a 20 20 28 72 6d 74 ds-clean). (rmt
7920: 3a 73 65 74 2d 72 65 63 65 69 76 65 20 27 6e 6f :set-receive 'no
7930: 2d 73 79 6e 63 2d 6a 6f 62 2d 72 65 63 6f 72 64 -sync-job-record
7940: 73 2d 63 6c 65 61 6e 20 23 66 20 27 28 29 29 29 s-clean #f '()))
7950: 0a 0a 3b 3b 20 70 72 6f 63 65 73 73 20 72 65 67 ..;; process reg
7960: 69 73 74 72 61 74 69 6f 6e 0a 0a 28 64 65 66 69 istration..(defi
7970: 6e 65 20 28 72 6d 74 3a 72 65 67 69 73 74 65 72 ne (rmt:register
7980: 2d 70 72 6f 63 65 73 73 20 68 6f 73 74 20 70 6f -process host po
7990: 72 74 20 70 69 64 20 73 74 61 72 74 74 69 6d 65 rt pid starttime
79a0: 20 73 74 61 74 75 73 20 70 75 72 70 6f 73 65 20 status purpose
79b0: 64 62 6e 61 6d 65 20 6d 74 76 65 72 73 69 6f 6e dbname mtversion
79c0: 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 ). (rmt:send-re
79d0: 63 65 69 76 65 20 27 72 65 67 69 73 74 65 72 2d ceive 'register-
79e0: 70 72 6f 63 65 73 73 20 23 66 20 28 6c 69 73 74 process #f (list
79f0: 20 68 6f 73 74 20 70 6f 72 74 20 70 69 64 20 73 host port pid s
7a00: 74 61 72 74 74 69 6d 65 20 73 74 61 74 75 73 20 tarttime status
7a10: 70 75 72 70 6f 73 65 20 64 62 6e 61 6d 65 20 6d purpose dbname m
7a20: 74 76 65 72 73 69 6f 6e 29 29 29 0a 0a 28 64 65 tversion)))..(de
7a30: 66 69 6e 65 20 28 72 6d 74 3a 73 65 74 2d 70 72 fine (rmt:set-pr
7a40: 6f 63 65 73 73 2d 64 6f 6e 65 20 68 6f 73 74 20 ocess-done host
7a50: 70 69 64 20 72 65 61 73 6f 6e 29 0a 20 20 28 72 pid reason). (r
7a60: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
7a70: 27 73 65 74 2d 70 72 6f 63 65 73 73 2d 64 6f 6e 'set-process-don
7a80: 65 20 23 66 20 28 6c 69 73 74 20 68 6f 73 74 20 e #f (list host
7a90: 70 69 64 20 72 65 61 73 6f 6e 29 29 29 0a 0a 28 pid reason)))..(
7aa0: 64 65 66 69 6e 65 20 28 72 6d 74 3a 73 65 74 2d define (rmt:set-
7ab0: 70 72 6f 63 65 73 73 2d 73 74 61 74 75 73 20 68 process-status h
7ac0: 6f 73 74 20 70 69 64 20 6e 65 77 73 74 61 74 75 ost pid newstatu
7ad0: 73 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 s). (rmt:send-r
7ae0: 65 63 65 69 76 65 20 27 73 65 74 2d 70 72 6f 63 eceive 'set-proc
7af0: 65 73 73 2d 73 74 61 74 75 73 20 23 66 20 28 6c ess-status #f (l
7b00: 69 73 74 20 68 6f 73 74 20 70 69 64 20 6e 65 77 ist host pid new
7b10: 73 74 61 74 75 73 29 29 29 0a 0a 28 64 65 66 69 status)))..(defi
7b20: 6e 65 20 28 72 6d 74 3a 67 65 74 2d 70 72 6f 63 ne (rmt:get-proc
7b30: 65 73 73 2d 6f 70 74 69 6f 6e 73 20 70 75 72 70 ess-options purp
7b40: 6f 73 65 20 64 62 6e 61 6d 65 29 0a 20 20 28 72 ose dbname). (r
7b50: 6d 74 3a 67 65 74 2d 70 72 6f 63 65 73 73 2d 6f mt:get-process-o
7b60: 70 74 69 6f 6e 73 20 27 67 65 74 2d 70 72 6f 63 ptions 'get-proc
7b70: 65 73 73 2d 6f 70 74 69 6f 6e 73 20 23 66 20 28 ess-options #f (
7b80: 6c 69 73 74 20 70 75 72 70 6f 73 65 20 64 62 6e list purpose dbn
7b90: 61 6d 65 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d ame)))..;;======
7ba0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7bb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7bc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7bd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7be0: 0a 3b 3b 20 41 20 52 20 43 20 48 20 49 20 56 20 .;; A R C H I V
7bf0: 45 20 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d E S.;;==========
7c00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7c10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7c20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7c30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 ============..(d
7c40: 65 66 69 6e 65 20 28 72 6d 74 3a 61 72 63 68 69 efine (rmt:archi
7c50: 76 65 2d 67 65 74 2d 61 6c 6c 6f 63 61 74 69 6f ve-get-allocatio
7c60: 6e 73 20 20 74 65 73 74 6e 61 6d 65 20 69 74 65 ns testname ite
7c70: 6d 70 61 74 68 20 64 6e 65 65 64 65 64 29 0a 20 mpath dneeded).
7c80: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
7c90: 76 65 20 27 61 72 63 68 69 76 65 2d 67 65 74 2d ve 'archive-get-
7ca0: 61 6c 6c 6f 63 61 74 69 6f 6e 73 20 23 66 20 28 allocations #f (
7cb0: 6c 69 73 74 20 74 65 73 74 6e 61 6d 65 20 69 74 list testname it
7cc0: 65 6d 70 61 74 68 20 64 6e 65 65 64 65 64 29 29 empath dneeded))
7cd0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a )..(define (rmt:
7ce0: 61 72 63 68 69 76 65 2d 72 65 67 69 73 74 65 72 archive-register
7cf0: 2d 62 6c 6f 63 6b 2d 6e 61 6d 65 20 62 64 69 73 -block-name bdis
7d00: 6b 2d 69 64 20 61 72 63 68 69 76 65 2d 70 61 74 k-id archive-pat
7d10: 68 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 h). (rmt:send-r
7d20: 65 63 65 69 76 65 20 27 61 72 63 68 69 76 65 2d eceive 'archive-
7d30: 72 65 67 69 73 74 65 72 2d 62 6c 6f 63 6b 2d 6e register-block-n
7d40: 61 6d 65 20 23 66 20 28 6c 69 73 74 20 62 64 69 ame #f (list bdi
7d50: 73 6b 2d 69 64 20 61 72 63 68 69 76 65 2d 70 61 sk-id archive-pa
7d60: 74 68 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 th)))..(define (
7d70: 72 6d 74 3a 61 72 63 68 69 76 65 2d 61 6c 6c 6f rmt:archive-allo
7d80: 63 61 74 65 2d 74 65 73 74 73 75 69 74 65 2f 61 cate-testsuite/a
7d90: 72 65 61 2d 74 6f 2d 62 6c 6f 63 6b 20 62 6c 6f rea-to-block blo
7da0: 63 6b 2d 69 64 20 74 65 73 74 73 75 69 74 65 2d ck-id testsuite-
7db0: 6e 61 6d 65 20 61 72 65 61 6b 65 79 29 0a 20 20 name areakey).
7dc0: 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 (rmt:send-receiv
7dd0: 65 20 27 61 72 63 68 69 76 65 2d 61 6c 6c 6f 63 e 'archive-alloc
7de0: 61 74 65 2d 74 65 73 74 2d 74 6f 2d 62 6c 6f 63 ate-test-to-bloc
7df0: 6b 20 23 66 20 28 6c 69 73 74 20 20 62 6c 6f 63 k #f (list bloc
7e00: 6b 2d 69 64 20 74 65 73 74 73 75 69 74 65 2d 6e k-id testsuite-n
7e10: 61 6d 65 20 61 72 65 61 6b 65 79 29 29 29 0a 0a ame areakey)))..
7e20: 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 61 72 63 (define (rmt:arc
7e30: 68 69 76 65 2d 72 65 67 69 73 74 65 72 2d 64 69 hive-register-di
7e40: 73 6b 20 62 64 69 73 6b 2d 6e 61 6d 65 20 62 64 sk bdisk-name bd
7e50: 69 73 6b 2d 70 61 74 68 20 64 66 29 0a 20 20 28 isk-path df). (
7e60: 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 rmt:send-receive
7e70: 20 27 61 72 63 68 69 76 65 2d 72 65 67 69 73 74 'archive-regist
7e80: 65 72 2d 64 69 73 6b 20 23 66 20 28 6c 69 73 74 er-disk #f (list
7e90: 20 62 64 69 73 6b 2d 6e 61 6d 65 20 62 64 69 73 bdisk-name bdis
7ea0: 6b 2d 70 61 74 68 20 64 66 29 29 29 0a 0a 28 64 k-path df)))..(d
7eb0: 65 66 69 6e 65 20 28 72 6d 74 3a 74 65 73 74 2d efine (rmt:test-
7ec0: 73 65 74 2d 61 72 63 68 69 76 65 2d 62 6c 6f 63 set-archive-bloc
7ed0: 6b 2d 69 64 20 72 75 6e 2d 69 64 20 74 65 73 74 k-id run-id test
7ee0: 2d 69 64 20 61 72 63 68 69 76 65 2d 62 6c 6f 63 -id archive-bloc
7ef0: 6b 2d 69 64 29 0a 20 20 28 61 73 73 65 72 74 20 k-id). (assert
7f00: 28 6e 75 6d 62 65 72 3f 20 72 75 6e 2d 69 64 29 (number? run-id)
7f10: 20 22 46 41 54 41 4c 3a 20 52 75 6e 20 69 64 20 "FATAL: Run id
7f20: 72 65 71 75 69 72 65 64 2e 22 29 0a 20 20 28 72 required."). (r
7f30: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
7f40: 27 74 65 73 74 2d 73 65 74 2d 61 72 63 68 69 76 'test-set-archiv
7f50: 65 2d 62 6c 6f 63 6b 2d 69 64 20 72 75 6e 2d 69 e-block-id run-i
7f60: 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 20 74 d (list run-id t
7f70: 65 73 74 2d 69 64 20 61 72 63 68 69 76 65 2d 62 est-id archive-b
7f80: 6c 6f 63 6b 2d 69 64 29 29 29 0a 0a 28 64 65 66 lock-id)))..(def
7f90: 69 6e 65 20 28 72 6d 74 3a 74 65 73 74 2d 67 65 ine (rmt:test-ge
7fa0: 74 2d 61 72 63 68 69 76 65 2d 62 6c 6f 63 6b 2d t-archive-block-
7fb0: 69 6e 66 6f 20 61 72 63 68 69 76 65 2d 62 6c 6f info archive-blo
7fc0: 63 6b 2d 69 64 29 0a 20 20 28 72 6d 74 3a 73 65 ck-id). (rmt:se
7fd0: 6e 64 2d 72 65 63 65 69 76 65 20 27 74 65 73 74 nd-receive 'test
7fe0: 2d 67 65 74 2d 61 72 63 68 69 76 65 2d 62 6c 6f -get-archive-blo
7ff0: 63 6b 2d 69 6e 66 6f 20 23 66 20 28 6c 69 73 74 ck-info #f (list
8000: 20 61 72 63 68 69 76 65 2d 62 6c 6f 63 6b 2d 69 archive-block-i
8010: 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 d)))..(define (r
8020: 6d 74 6d 6f 64 3a 63 61 6c 63 2d 72 6f 2d 6d 6f mtmod:calc-ro-mo
8030: 64 65 20 72 75 6e 72 65 6d 6f 74 65 20 2a 74 6f de runremote *to
8040: 70 70 61 74 68 2a 29 0a 20 20 28 63 61 73 65 20 ppath*). (case
8050: 28 72 6d 74 3a 74 72 61 6e 73 70 6f 72 74 2d 6d (rmt:transport-m
8060: 6f 64 65 29 0a 20 20 20 20 28 28 68 74 74 70 29 ode). ((http)
8070: 0a 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 72 . (if (and r
8080: 75 6e 72 65 6d 6f 74 65 0a 09 20 20 20 20 20 20 unremote..
8090: 28 72 65 6d 6f 74 65 2d 72 6f 2d 6d 6f 64 65 2d (remote-ro-mode-
80a0: 63 68 65 63 6b 65 64 20 72 75 6e 72 65 6d 6f 74 checked runremot
80b0: 65 29 29 0a 09 20 28 72 65 6d 6f 74 65 2d 72 6f e)).. (remote-ro
80c0: 2d 6d 6f 64 65 20 72 75 6e 72 65 6d 6f 74 65 29 -mode runremote)
80d0: 0a 09 20 28 6c 65 74 2a 20 28 28 6d 74 63 66 67 .. (let* ((mtcfg
80e0: 66 69 6c 65 20 20 28 63 6f 6e 63 20 2a 74 6f 70 file (conc *top
80f0: 70 61 74 68 2a 20 22 2f 6d 65 67 61 74 65 73 74 path* "/megatest
8100: 2e 63 6f 6e 66 69 67 22 29 29 0a 09 09 28 72 6f .config"))...(ro
8110: 2d 6d 6f 64 65 20 28 6e 6f 74 20 28 66 69 6c 65 -mode (not (file
8120: 2d 77 72 69 74 65 2d 61 63 63 65 73 73 3f 20 6d -write-access? m
8130: 74 63 66 67 66 69 6c 65 29 29 29 29 20 3b 3b 20 tcfgfile)))) ;;
8140: 54 4f 44 4f 3a 20 75 73 65 20 64 62 73 74 72 75 TODO: use dbstru
8150: 63 74 20 6f 72 20 72 75 6e 72 65 6d 6f 74 65 20 ct or runremote
8160: 74 6f 20 66 69 67 75 72 65 20 74 68 69 73 20 6f to figure this o
8170: 75 74 20 69 6e 20 66 75 74 75 72 65 0a 09 20 20 ut in future..
8180: 20 28 69 66 20 72 75 6e 72 65 6d 6f 74 65 0a 09 (if runremote..
8190: 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 (begin...
81a0: 20 28 72 65 6d 6f 74 65 2d 72 6f 2d 6d 6f 64 65 (remote-ro-mode
81b0: 2d 73 65 74 21 20 72 75 6e 72 65 6d 6f 74 65 20 -set! runremote
81c0: 72 6f 2d 6d 6f 64 65 29 0a 09 09 20 28 72 65 6d ro-mode)... (rem
81d0: 6f 74 65 2d 72 6f 2d 6d 6f 64 65 2d 63 68 65 63 ote-ro-mode-chec
81e0: 6b 65 64 2d 73 65 74 21 20 72 75 6e 72 65 6d 6f ked-set! runremo
81f0: 74 65 20 23 74 29 0a 09 09 20 72 6f 2d 6d 6f 64 te #t)... ro-mod
8200: 65 29 0a 09 20 20 20 20 20 20 20 72 6f 2d 6d 6f e).. ro-mo
8210: 64 65 29 29 29 29 0a 20 20 20 20 28 28 74 63 70 de)))). ((tcp
8220: 29 0a 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 ). (if (and
8230: 72 75 6e 72 65 6d 6f 74 65 0a 09 20 20 20 20 20 runremote..
8240: 20 28 74 74 2d 72 6f 2d 6d 6f 64 65 2d 63 68 65 (tt-ro-mode-che
8250: 63 6b 65 64 20 72 75 6e 72 65 6d 6f 74 65 29 29 cked runremote))
8260: 0a 09 20 28 74 74 2d 72 6f 2d 6d 6f 64 65 20 72 .. (tt-ro-mode r
8270: 75 6e 72 65 6d 6f 74 65 29 0a 09 20 28 6c 65 74 unremote).. (let
8280: 2a 20 28 28 6d 74 63 66 67 66 69 6c 65 20 20 28 * ((mtcfgfile (
8290: 63 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 conc *toppath* "
82a0: 2f 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 /megatest.config
82b0: 22 29 29 0a 09 09 28 72 6f 2d 6d 6f 64 65 20 28 "))...(ro-mode (
82c0: 6e 6f 74 20 28 66 69 6c 65 2d 77 72 69 74 65 2d not (file-write-
82d0: 61 63 63 65 73 73 3f 20 6d 74 63 66 67 66 69 6c access? mtcfgfil
82e0: 65 29 29 29 29 20 3b 3b 20 54 4f 44 4f 3a 20 75 e)))) ;; TODO: u
82f0: 73 65 20 64 62 73 74 72 75 63 74 20 6f 72 20 72 se dbstruct or r
8300: 75 6e 72 65 6d 6f 74 65 20 74 6f 20 66 69 67 75 unremote to figu
8310: 72 65 20 74 68 69 73 20 6f 75 74 20 69 6e 20 66 re this out in f
8320: 75 74 75 72 65 0a 09 20 20 20 28 69 66 20 72 75 uture.. (if ru
8330: 6e 72 65 6d 6f 74 65 0a 09 20 20 20 20 20 20 20 nremote..
8340: 28 62 65 67 69 6e 0a 09 09 20 28 74 74 2d 72 6f (begin... (tt-ro
8350: 2d 6d 6f 64 65 2d 73 65 74 21 20 72 75 6e 72 65 -mode-set! runre
8360: 6d 6f 74 65 20 72 6f 2d 6d 6f 64 65 29 0a 09 09 mote ro-mode)...
8370: 20 28 74 74 2d 72 6f 2d 6d 6f 64 65 2d 63 68 65 (tt-ro-mode-che
8380: 63 6b 65 64 2d 73 65 74 21 20 72 75 6e 72 65 6d cked-set! runrem
8390: 6f 74 65 20 23 74 29 0a 09 09 20 72 6f 2d 6d 6f ote #t)... ro-mo
83a0: 64 65 29 0a 09 20 20 20 20 20 20 20 72 6f 2d 6d de).. ro-m
83b0: 6f 64 65 29 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d ode))))))..;;===
83c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
83d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
83e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
83f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8400: 3d 3d 3d 0a 3b 3b 20 4d 61 69 6e 74 65 6e 61 6e ===.;; Maintenan
8410: 63 65 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ce.;;===========
8420: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8430: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8440: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8450: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 ===========..(de
8460: 66 69 6e 65 20 28 72 6d 74 3a 66 69 6e 64 2d 61 fine (rmt:find-a
8470: 6e 64 2d 6d 61 72 6b 2d 69 6e 63 6f 6d 70 6c 65 nd-mark-incomple
8480: 74 65 20 72 75 6e 2d 69 64 20 6f 76 72 2d 64 65 te run-id ovr-de
8490: 61 64 74 69 6d 65 29 0a 20 20 28 6c 65 74 2a 20 adtime). (let*
84a0: 28 28 63 66 67 2d 64 65 61 64 74 69 6d 65 20 20 ((cfg-deadtime
84b0: 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 66 (conf
84c0: 69 67 66 3a 6c 6f 6f 6b 75 70 2d 6e 75 6d 62 65 igf:lookup-numbe
84d0: 72 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 r *configdat* "s
84e0: 65 74 75 70 22 20 22 64 65 61 64 74 69 6d 65 22 etup" "deadtime"
84f0: 29 29 0a 09 20 28 74 65 73 74 2d 73 74 61 74 73 )).. (test-stats
8500: 2d 75 70 64 61 74 65 2d 70 65 72 69 6f 64 20 28 -update-period (
8510: 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 2d 6e configf:lookup-n
8520: 75 6d 62 65 72 20 2a 63 6f 6e 66 69 67 64 61 74 umber *configdat
8530: 2a 20 22 73 65 74 75 70 22 20 22 74 65 73 74 2d * "setup" "test-
8540: 73 74 61 74 73 2d 75 70 64 61 74 65 2d 70 65 72 stats-update-per
8550: 69 6f 64 22 29 29 29 0a 20 20 20 28 72 6d 74 3a iod"))). (rmt:
8560: 66 69 6e 64 2d 61 6e 64 2d 6d 61 72 6b 2d 69 6e find-and-mark-in
8570: 63 6f 6d 70 6c 65 74 65 2d 65 6e 67 69 6e 65 20 complete-engine
8580: 72 75 6e 2d 69 64 20 6f 76 72 2d 64 65 61 64 74 run-id ovr-deadt
8590: 69 6d 65 20 63 66 67 2d 64 65 61 64 74 69 6d 65 ime cfg-deadtime
85a0: 20 74 65 73 74 2d 73 74 61 74 73 2d 75 70 64 61 test-stats-upda
85b0: 74 65 2d 70 65 72 69 6f 64 29 0a 20 20 20 3b 3b te-period). ;;
85c0: 63 61 6c 6c 20 65 6e 64 20 6f 66 20 65 75 64 20 call end of eud
85d0: 6f 66 20 72 75 6e 20 64 65 74 65 63 74 69 6f 6e of run detection
85e0: 20 66 6f 72 20 70 6f 73 74 68 6f 6f 6b 0a 20 20 for posthook.
85f0: 20 28 6c 61 75 6e 63 68 3a 65 6e 64 2d 6f 66 2d (launch:end-of-
8600: 72 75 6e 2d 63 68 65 63 6b 20 72 75 6e 2d 69 64 run-check run-id
8610: 29 29 29 0a 0a 3b 3b 20 6f 72 70 68 61 6e 65 64 )))..;; orphaned
8620: 20 66 72 6f 6d 20 63 68 65 72 72 79 70 69 63 6b from cherrypick
8630: 20 6d 65 72 67 65 0a 3b 3b 20 20 20 20 20 20 20 merge.;;
8640: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
8650: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
8660: 72 74 2a 20 22 49 6e 73 65 72 74 69 6e 67 20 22 rt* "Inserting "
8670: 20 28 6c 65 6e 67 74 68 20 74 65 73 74 73 2d 64 (length tests-d
8680: 61 74 61 29 20 22 20 74 65 73 74 73 20 69 6e 20 ata) " tests in
8690: 72 75 6e 20 22 20 72 75 6e 6e 61 6d 65 29 0a run " runname).