Artifact
23e97ebe5e2acfa2df9ed9aff0bb8d75ec28ff6a:
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 32 32 2c 20 4d 61 74 74 right 2022, Matt
0060: 68 65 77 20 57 65 6c 6c 61 6e 64 2e 0a 3b 3b 20 hew Welland..;;
0070: 0a 3b 3b 20 54 68 69 73 20 66 69 6c 65 20 69 73 .;; This file is
0080: 20 70 61 72 74 20 6f 66 20 4d 65 67 61 74 65 73 part of Megates
0090: 74 2e 0a 3b 3b 20 0a 3b 3b 20 20 20 20 20 4d 65 t..;; .;; Me
00a0: 67 61 74 65 73 74 20 69 73 20 66 72 65 65 20 73 gatest is free s
00b0: 6f 66 74 77 61 72 65 3a 20 79 6f 75 20 63 61 6e oftware: you can
00c0: 20 72 65 64 69 73 74 72 69 62 75 74 65 20 69 74 redistribute it
00d0: 20 61 6e 64 2f 6f 72 20 6d 6f 64 69 66 79 0a 3b and/or modify.;
00e0: 3b 20 20 20 20 20 69 74 20 75 6e 64 65 72 20 74 ; it under t
00f0: 68 65 20 74 65 72 6d 73 20 6f 66 20 74 68 65 20 he terms of the
0100: 47 4e 55 20 47 65 6e 65 72 61 6c 20 50 75 62 6c GNU General Publ
0110: 69 63 20 4c 69 63 65 6e 73 65 20 61 73 20 70 75 ic License as pu
0120: 62 6c 69 73 68 65 64 20 62 79 0a 3b 3b 20 20 20 blished by.;;
0130: 20 20 74 68 65 20 46 72 65 65 20 53 6f 66 74 77 the Free Softw
0140: 61 72 65 20 46 6f 75 6e 64 61 74 69 6f 6e 2c 20 are Foundation,
0150: 65 69 74 68 65 72 20 76 65 72 73 69 6f 6e 20 33 either version 3
0160: 20 6f 66 20 74 68 65 20 4c 69 63 65 6e 73 65 2c of the License,
0170: 20 6f 72 0a 3b 3b 20 20 20 20 20 28 61 74 20 79 or.;; (at y
0180: 6f 75 72 20 6f 70 74 69 6f 6e 29 20 61 6e 79 20 our option) any
0190: 6c 61 74 65 72 20 76 65 72 73 69 6f 6e 2e 0a 3b later version..;
01a0: 3b 20 0a 3b 3b 20 20 20 20 20 4d 65 67 61 74 65 ; .;; Megate
01b0: 73 74 20 69 73 20 64 69 73 74 72 69 62 75 74 65 st is distribute
01c0: 64 20 69 6e 20 74 68 65 20 68 6f 70 65 20 74 68 d in the hope th
01d0: 61 74 20 69 74 20 77 69 6c 6c 20 62 65 20 75 73 at it will be us
01e0: 65 66 75 6c 2c 0a 3b 3b 20 20 20 20 20 62 75 74 eful,.;; but
01f0: 20 57 49 54 48 4f 55 54 20 41 4e 59 20 57 41 52 WITHOUT ANY WAR
0200: 52 41 4e 54 59 3b 20 77 69 74 68 6f 75 74 20 65 RANTY; without e
0210: 76 65 6e 20 74 68 65 20 69 6d 70 6c 69 65 64 20 ven the implied
0220: 77 61 72 72 61 6e 74 79 20 6f 66 0a 3b 3b 20 20 warranty of.;;
0230: 20 20 20 4d 45 52 43 48 41 4e 54 41 42 49 4c 49 MERCHANTABILI
0240: 54 59 20 6f 72 20 46 49 54 4e 45 53 53 20 46 4f TY or FITNESS FO
0250: 52 20 41 20 50 41 52 54 49 43 55 4c 41 52 20 50 R A PARTICULAR P
0260: 55 52 50 4f 53 45 2e 20 20 53 65 65 20 74 68 65 URPOSE. See the
0270: 0a 3b 3b 20 20 20 20 20 47 4e 55 20 47 65 6e 65 .;; GNU Gene
0280: 72 61 6c 20 50 75 62 6c 69 63 20 4c 69 63 65 6e ral Public Licen
0290: 73 65 20 66 6f 72 20 6d 6f 72 65 20 64 65 74 61 se for more deta
02a0: 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b 20 20 20 20 20 ils..;; .;;
02b0: 59 6f 75 20 73 68 6f 75 6c 64 20 68 61 76 65 20 You should have
02c0: 72 65 63 65 69 76 65 64 20 61 20 63 6f 70 79 20 received a copy
02d0: 6f 66 20 74 68 65 20 47 4e 55 20 47 65 6e 65 72 of the GNU Gener
02e0: 61 6c 20 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 al Public Licens
02f0: 65 0a 3b 3b 20 20 20 20 20 61 6c 6f 6e 67 20 77 e.;; along w
0300: 69 74 68 20 4d 65 67 61 74 65 73 74 2e 20 20 49 ith Megatest. I
0310: 66 20 6e 6f 74 2c 20 73 65 65 20 3c 68 74 74 70 f not, see <http
0320: 3a 2f 2f 77 77 77 2e 67 6e 75 2e 6f 72 67 2f 6c ://www.gnu.org/l
0330: 69 63 65 6e 73 65 73 2f 3e 2e 0a 0a 3b 3b 3d 3d icenses/>...;;==
0340: 3d 3d 3d 3d 3d 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 0a 0a 3b 3b 20 67 65 6e 65 72 61 74 ====..;; generat
0390: 65 20 65 6e 74 72 69 65 73 20 66 6f 72 20 7e 2f e entries for ~/
03a0: 2e 6d 65 67 61 74 65 73 74 72 63 20 77 69 74 68 .megatestrc with
03b0: 20 74 68 65 20 66 6f 6c 6c 6f 77 69 6e 67 0a 3b the following.;
03c0: 3b 0a 3b 3b 20 20 67 72 65 70 20 64 65 66 69 6e ;.;; grep defin
03d0: 65 20 2e 2e 2f 72 6d 74 2e 73 63 6d 20 7c 20 67 e ../rmt.scm | g
03e0: 72 65 70 20 72 6d 74 3a 20 7c 70 65 72 6c 20 2d rep rmt: |perl -
03f0: 70 69 20 2d 65 20 27 73 2f 5c 28 64 65 66 69 6e pi -e 's/\(defin
0400: 65 5c 73 2b 5c 28 28 5c 53 2b 29 5c 57 2e 2a 24 e\s+\((\S+)\W.*$
0410: 2f 5c 31 2f 27 7c 73 6f 72 74 20 2d 75 0a 0a 28 /\1/'|sort -u..(
0420: 64 65 63 6c 61 72 65 20 28 75 6e 69 74 20 72 6d declare (unit rm
0430: 74 6d 6f 64 29 29 0a 0a 28 64 65 63 6c 61 72 65 tmod))..(declare
0440: 20 28 75 73 65 73 20 61 70 69 6d 6f 64 29 29 0a (uses apimod)).
0450: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 63 (declare (uses c
0460: 6f 6d 6d 6f 6e 6d 6f 64 29 29 0a 28 64 65 63 6c ommonmod)).(decl
0470: 61 72 65 20 28 75 73 65 73 20 63 6f 6e 66 69 67 are (uses config
0480: 66 6d 6f 64 29 29 0a 28 64 65 63 6c 61 72 65 20 fmod)).(declare
0490: 28 75 73 65 73 20 64 62 6d 6f 64 29 29 0a 28 64 (uses dbmod)).(d
04a0: 65 63 6c 61 72 65 20 28 75 73 65 73 20 64 65 62 eclare (uses deb
04b0: 75 67 70 72 69 6e 74 29 29 0a 28 64 65 63 6c 61 ugprint)).(decla
04c0: 72 65 20 28 75 73 65 73 20 69 74 65 6d 73 6d 6f re (uses itemsmo
04d0: 64 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 d)).(declare (us
04e0: 65 73 20 6d 74 61 72 67 73 29 29 0a 28 64 65 63 es mtargs)).(dec
04f0: 6c 61 72 65 20 28 75 73 65 73 20 6d 74 76 65 72 lare (uses mtver
0500: 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 )).(declare (use
0510: 73 20 70 67 64 62 29 29 0a 28 64 65 63 6c 61 72 s pgdb)).(declar
0520: 65 20 28 75 73 65 73 20 70 6f 72 74 6c 6f 67 67 e (uses portlogg
0530: 65 72 6d 6f 64 29 29 0a 28 64 65 63 6c 61 72 65 ermod)).(declare
0540: 20 28 75 73 65 73 20 73 65 72 76 65 72 6d 6f 64 (uses servermod
0550: 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 )).(declare (use
0560: 73 20 74 61 73 6b 73 6d 6f 64 29 29 0a 28 64 65 s tasksmod)).(de
0570: 63 6c 61 72 65 20 28 75 73 65 73 20 75 6c 65 78 clare (uses ulex
0580: 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 )).(declare (use
0590: 73 20 64 62 6d 67 72 6d 6f 64 29 29 0a 0a 28 6d s dbmgrmod))..(m
05a0: 6f 64 75 6c 65 20 72 6d 74 6d 6f 64 0a 09 2a 0a odule rmtmod..*.
05b0: 09 0a 28 69 6d 70 6f 72 74 20 73 63 68 65 6d 65 ..(import scheme
05c0: 0a 09 09 0a 09 63 68 69 63 6b 65 6e 2e 62 61 73 .....chicken.bas
05d0: 65 0a 09 63 68 69 63 6b 65 6e 2e 63 6f 6e 64 69 e..chicken.condi
05e0: 74 69 6f 6e 0a 09 63 68 69 63 6b 65 6e 2e 66 69 tion..chicken.fi
05f0: 6c 65 0a 09 63 68 69 63 6b 65 6e 2e 66 69 6c 65 le..chicken.file
0600: 2e 70 6f 73 69 78 0a 09 3b 3b 20 63 68 69 63 6b .posix..;; chick
0610: 65 6e 2e 66 6f 72 6d 61 74 0a 09 63 68 69 63 6b en.format..chick
0620: 65 6e 2e 69 6f 0a 09 63 68 69 63 6b 65 6e 2e 70 en.io..chicken.p
0630: 61 74 68 6e 61 6d 65 0a 09 63 68 69 63 6b 65 6e athname..chicken
0640: 2e 70 6f 72 74 0a 09 63 68 69 63 6b 65 6e 2e 70 .port..chicken.p
0650: 72 65 74 74 79 2d 70 72 69 6e 74 0a 09 63 68 69 retty-print..chi
0660: 63 6b 65 6e 2e 70 72 6f 63 65 73 73 0a 09 63 68 cken.process..ch
0670: 69 63 6b 65 6e 2e 70 72 6f 63 65 73 73 2d 63 6f icken.process-co
0680: 6e 74 65 78 74 0a 09 63 68 69 63 6b 65 6e 2e 70 ntext..chicken.p
0690: 72 6f 63 65 73 73 2d 63 6f 6e 74 65 78 74 2e 70 rocess-context.p
06a0: 6f 73 69 78 0a 09 63 68 69 63 6b 65 6e 2e 73 6f osix..chicken.so
06b0: 72 74 0a 09 63 68 69 63 6b 65 6e 2e 73 74 72 69 rt..chicken.stri
06c0: 6e 67 0a 09 3b 3b 20 63 68 69 63 6b 65 6e 2e 74 ng..;; chicken.t
06d0: 63 70 0a 09 63 68 69 63 6b 65 6e 2e 72 61 6e 64 cp..chicken.rand
06e0: 6f 6d 0a 09 63 68 69 63 6b 65 6e 2e 74 69 6d 65 om..chicken.time
06f0: 0a 09 63 68 69 63 6b 65 6e 2e 74 69 6d 65 2e 70 ..chicken.time.p
0700: 6f 73 69 78 0a 09 0a 09 64 69 72 65 63 74 6f 72 osix....director
0710: 79 2d 75 74 69 6c 73 0a 09 66 6f 72 6d 61 74 0a y-utils..format.
0720: 09 3b 3b 20 68 74 74 70 2d 63 6c 69 65 6e 74 0a .;; http-client.
0730: 09 3b 3b 20 69 6e 74 61 72 77 65 62 0a 09 6d 61 .;; intarweb..ma
0740: 74 63 68 61 62 6c 65 0a 09 6d 64 35 0a 09 6d 65 tchable..md5..me
0750: 73 73 61 67 65 2d 64 69 67 65 73 74 0a 09 3b 3b ssage-digest..;;
0760: 20 6e 6e 67 20 3b 3b 20 6e 61 6e 6f 6d 73 67 0a nng ;; nanomsg.
0770: 09 28 70 72 65 66 69 78 20 62 61 73 65 36 34 20 .(prefix base64
0780: 62 61 73 65 36 34 3a 29 0a 09 28 70 72 65 66 69 base64:)..(prefi
0790: 78 20 73 71 6c 69 74 65 33 20 73 71 6c 69 74 65 x sqlite3 sqlite
07a0: 33 3a 29 0a 09 72 65 67 65 78 0a 09 73 31 31 6e 3:)..regex..s11n
07b0: 0a 09 3b 3b 20 73 70 69 66 66 79 0a 09 3b 3b 20 ..;; spiffy..;;
07c0: 73 70 69 66 66 79 2d 64 69 72 65 63 74 6f 72 79 spiffy-directory
07d0: 2d 6c 69 73 74 69 6e 67 0a 09 3b 3b 20 73 70 69 -listing..;; spi
07e0: 66 66 79 2d 72 65 71 75 65 73 74 2d 76 61 72 73 ffy-request-vars
07f0: 0a 09 73 72 66 69 2d 31 0a 09 73 72 66 69 2d 31 ..srfi-1..srfi-1
0800: 33 0a 09 73 72 66 69 2d 31 38 0a 09 73 72 66 69 3..srfi-18..srfi
0810: 2d 36 39 0a 09 73 74 61 63 6b 0a 09 73 79 73 74 -69..stack..syst
0820: 65 6d 2d 69 6e 66 6f 72 6d 61 74 69 6f 6e 0a 09 em-information..
0830: 3b 3b 20 74 63 70 36 0a 09 74 79 70 65 64 2d 72 ;; tcp6..typed-r
0840: 65 63 6f 72 64 73 0a 09 75 72 69 2d 63 6f 6d 6d ecords..uri-comm
0850: 6f 6e 0a 09 7a 33 0a 20 20 20 20 20 20 20 0a 09 on..z3. ..
0860: 61 70 69 6d 6f 64 0a 09 63 6f 6d 6d 6f 6e 6d 6f apimod..commonmo
0870: 64 0a 09 63 6f 6e 66 69 67 66 6d 6f 64 0a 09 64 d..configfmod..d
0880: 62 6d 6f 64 0a 09 64 65 62 75 67 70 72 69 6e 74 bmod..debugprint
0890: 0a 09 69 74 65 6d 73 6d 6f 64 0a 09 6d 74 76 65 ..itemsmod..mtve
08a0: 72 0a 09 70 67 64 62 0a 09 70 6b 74 73 0a 09 70 r..pgdb..pkts..p
08b0: 6f 72 74 6c 6f 67 67 65 72 6d 6f 64 0a 09 28 70 ortloggermod..(p
08c0: 72 65 66 69 78 20 6d 74 61 72 67 73 20 61 72 67 refix mtargs arg
08d0: 73 3a 29 0a 09 73 65 72 76 65 72 6d 6f 64 0a 09 s:)..servermod..
08e0: 73 74 6d 6c 32 0a 09 74 61 73 6b 73 6d 6f 64 0a stml2..tasksmod.
08f0: 0a 09 64 62 6d 67 72 6d 6f 64 0a 09 75 6c 65 78 ..dbmgrmod..ulex
0900: 0a 09 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d ..)..;;=========
0910: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0920: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0930: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0940: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
0950: 0a 3b 3b 20 41 20 43 20 54 20 55 20 41 20 4c 20 .;; A C T U A L
0960: 20 20 41 20 50 20 49 20 20 20 43 20 41 20 4c 20 A P I C A L
0970: 4c 20 53 20 20 0a 3b 3b 0a 3b 3b 3d 3d 3d 3d 3d L S .;;.;;=====
0980: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0990: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
09a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
09b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
09c0: 3d 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d =..;;===========
09d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
09e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
09f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0a00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 20 ===========.;;
0a10: 4d 20 49 20 53 20 43 0a 3b 3b 3d 3d 3d 3d 3d 3d M I S C.;;======
0a20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0a30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0a40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0a50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0a60: 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 6c ..(define (rmt:l
0a70: 6f 67 69 6e 20 72 75 6e 2d 69 64 29 0a 20 20 28 ogin run-id). (
0a80: 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 rmt:send-receive
0a90: 20 27 6c 6f 67 69 6e 20 72 75 6e 2d 69 64 20 28 'login run-id (
0aa0: 6c 69 73 74 20 2a 74 6f 70 70 61 74 68 2a 20 6d list *toppath* m
0ab0: 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 20 egatest-version
0ac0: 2a 6d 79 2d 73 69 67 6e 61 74 75 72 65 2a 29 29 *my-signature*))
0ad0: 29 0a 0a 3b 3b 20 72 6d 74 3a 6c 6f 67 69 6e 2d )..;; rmt:login-
0ae0: 6e 6f 2d 61 75 74 6f 2d 63 6c 69 65 6e 74 2d 73 no-auto-client-s
0af0: 65 74 75 70 0a 3b 3b 20 72 6d 74 3a 73 65 6e 64 etup.;; rmt:send
0b00: 2d 72 65 63 65 69 76 65 2d 6e 6f 2d 61 75 74 6f -receive-no-auto
0b10: 2d 63 6c 69 65 6e 74 2d 73 65 74 75 70 0a 0a 3b -client-setup..;
0b20: 3b 20 68 61 6e 64 20 6f 66 66 20 61 20 63 61 6c ; hand off a cal
0b30: 6c 20 74 6f 20 6f 6e 65 20 6f 66 20 74 68 65 20 l to one of the
0b40: 64 62 3a 71 75 65 72 69 65 73 20 73 74 61 74 65 db:queries state
0b50: 6d 65 6e 74 73 0a 3b 3b 20 61 64 64 65 64 20 72 ments.;; added r
0b60: 75 6e 2d 69 64 20 74 6f 20 6d 61 6b 65 20 6c 6f un-id to make lo
0b70: 6f 6b 69 6e 67 20 75 70 20 74 68 65 20 63 6f 72 oking up the cor
0b80: 72 65 63 74 20 64 62 20 70 6f 73 73 69 62 6c 65 rect db possible
0b90: 20 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 72 6d .;;.(define (rm
0ba0: 74 3a 67 65 6e 65 72 61 6c 2d 63 61 6c 6c 20 73 t:general-call s
0bb0: 74 6d 74 6e 61 6d 65 20 72 75 6e 2d 69 64 20 2e tmtname run-id .
0bc0: 20 70 61 72 61 6d 73 29 0a 20 20 28 72 6d 74 3a params). (rmt:
0bd0: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 send-receive 'ge
0be0: 6e 65 72 61 6c 2d 63 61 6c 6c 20 72 75 6e 2d 69 neral-call run-i
0bf0: 64 20 28 61 70 70 65 6e 64 20 28 6c 69 73 74 20 d (append (list
0c00: 73 74 6d 74 6e 61 6d 65 20 72 75 6e 2d 69 64 29 stmtname run-id)
0c10: 20 70 61 72 61 6d 73 29 29 29 0a 0a 0a 3b 3b 20 params)))...;;
0c20: 67 69 76 65 6e 20 61 20 68 6f 73 74 6e 61 6d 65 given a hostname
0c30: 2c 20 72 65 74 75 72 6e 20 61 20 70 61 69 72 20 , return a pair
0c40: 6f 66 20 63 70 75 20 6c 6f 61 64 20 61 6e 64 20 of cpu load and
0c50: 75 70 64 61 74 65 20 74 69 6d 65 20 72 65 70 72 update time repr
0c60: 65 73 65 6e 74 69 6e 67 20 6c 61 74 65 73 74 20 esenting latest
0c70: 69 6e 74 65 6c 6c 69 67 65 6e 63 65 20 66 72 6f intelligence fro
0c80: 6d 20 74 65 73 74 73 20 72 75 6e 6e 69 6e 67 20 m tests running
0c90: 6f 6e 20 74 68 61 74 20 68 6f 73 74 0a 28 64 65 on that host.(de
0ca0: 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 6c 61 fine (rmt:get-la
0cb0: 74 65 73 74 2d 68 6f 73 74 2d 6c 6f 61 64 20 68 test-host-load h
0cc0: 6f 73 74 6e 61 6d 65 29 0a 20 20 28 72 6d 74 3a ostname). (rmt:
0cd0: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 send-receive 'ge
0ce0: 74 2d 6c 61 74 65 73 74 2d 68 6f 73 74 2d 6c 6f t-latest-host-lo
0cf0: 61 64 20 30 20 28 6c 69 73 74 20 68 6f 73 74 6e ad 0 (list hostn
0d00: 61 6d 65 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 ame)))..(define
0d10: 28 72 6d 74 3a 73 64 62 2d 71 72 79 20 71 72 79 (rmt:sdb-qry qry
0d20: 20 76 61 6c 20 72 75 6e 2d 69 64 29 0a 20 20 3b val run-id). ;
0d30: 3b 20 61 64 64 20 63 61 63 68 69 6e 67 20 69 66 ; add caching if
0d40: 20 71 72 79 20 69 73 20 27 67 65 74 69 64 20 6f qry is 'getid o
0d50: 72 20 27 67 65 74 73 74 72 0a 20 20 28 72 6d 74 r 'getstr. (rmt
0d60: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 73 :send-receive 's
0d70: 64 62 2d 71 72 79 20 72 75 6e 2d 69 64 20 28 6c db-qry run-id (l
0d80: 69 73 74 20 71 72 79 20 76 61 6c 29 29 29 0a 0a ist qry val)))..
0d90: 3b 3b 20 4e 4f 54 20 43 4f 4d 50 4c 45 54 45 44 ;; NOT COMPLETED
0da0: 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 72 75 .(define (rmt:ru
0db0: 6e 74 65 73 74 73 20 75 73 65 72 20 72 75 6e 2d ntests user run-
0dc0: 69 64 20 74 65 73 74 70 61 74 74 20 70 61 72 61 id testpatt para
0dd0: 6d 73 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d ms). (rmt:send-
0de0: 72 65 63 65 69 76 65 20 27 72 75 6e 74 65 73 74 receive 'runtest
0df0: 73 20 72 75 6e 2d 69 64 20 74 65 73 74 70 61 74 s run-id testpat
0e00: 74 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d t))..(define (rm
0e10: 74 3a 67 65 74 2d 72 75 6e 2d 72 65 63 6f 72 64 t:get-run-record
0e20: 2d 69 64 73 20 20 74 61 72 67 65 74 20 72 75 6e -ids target run
0e30: 20 6b 65 79 6e 61 6d 65 73 20 74 65 73 74 2d 70 keynames test-p
0e40: 61 74 74 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 att). (rmt:send
0e50: 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d 72 75 -receive 'get-ru
0e60: 6e 2d 72 65 63 6f 72 64 2d 69 64 73 20 23 66 20 n-record-ids #f
0e70: 28 6c 69 73 74 20 74 61 72 67 65 74 20 72 75 6e (list target run
0e80: 20 6b 65 79 6e 61 6d 65 73 20 74 65 73 74 2d 70 keynames test-p
0e90: 61 74 74 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 att)))..(define
0ea0: 28 72 6d 74 3a 67 65 74 2d 63 68 61 6e 67 65 64 (rmt:get-changed
0eb0: 2d 72 65 63 6f 72 64 2d 69 64 73 20 73 69 6e 63 -record-ids sinc
0ec0: 65 2d 74 69 6d 65 29 0a 20 20 28 72 6d 74 3a 73 e-time). (rmt:s
0ed0: 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 end-receive 'get
0ee0: 2d 63 68 61 6e 67 65 64 2d 72 65 63 6f 72 64 2d -changed-record-
0ef0: 69 64 73 20 23 66 20 28 6c 69 73 74 20 73 69 6e ids #f (list sin
0f00: 63 65 2d 74 69 6d 65 29 29 20 29 0a 0a 28 64 65 ce-time)) )..(de
0f10: 66 69 6e 65 20 28 72 6d 74 3a 64 72 6f 70 2d 61 fine (rmt:drop-a
0f20: 6c 6c 2d 74 72 69 67 67 65 72 73 29 0a 20 20 20 ll-triggers).
0f30: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
0f40: 69 76 65 20 27 64 72 6f 70 2d 61 6c 6c 2d 74 72 ive 'drop-all-tr
0f50: 69 67 67 65 72 73 20 23 66 20 27 28 29 29 29 0a iggers #f '())).
0f60: 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 63 72 .(define (rmt:cr
0f70: 65 61 74 65 2d 61 6c 6c 2d 74 72 69 67 67 65 72 eate-all-trigger
0f80: 73 29 0a 20 20 20 20 20 28 72 6d 74 3a 73 65 6e s). (rmt:sen
0f90: 64 2d 72 65 63 65 69 76 65 20 27 63 72 65 61 74 d-receive 'creat
0fa0: 65 2d 61 6c 6c 2d 74 72 69 67 67 65 72 73 20 23 e-all-triggers #
0fb0: 66 20 27 28 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d f '()))..;;=====
0fc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0fd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0fe0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0ff0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1000: 3d 0a 3b 3b 20 20 54 20 45 20 53 20 54 20 20 20 =.;; T E S T
1010: 4d 20 45 20 54 20 41 20 0a 3b 3b 3d 3d 3d 3d 3d M E T A .;;=====
1020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1040: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1050: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1060: 3d 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a =..(define (rmt:
1070: 67 65 74 2d 74 65 73 74 73 2d 74 61 67 73 29 0a get-tests-tags).
1080: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
1090: 69 76 65 20 27 67 65 74 2d 74 65 73 74 73 2d 74 ive 'get-tests-t
10a0: 61 67 73 20 23 66 20 27 28 29 29 29 0a 0a 3b 3b ags #f '()))..;;
10b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10f0: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 20 4b 20 45 20 59 ======.;; K E Y
1100: 20 53 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d S .;;==========
1110: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1120: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1130: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1140: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b ============..;;
1150: 20 54 68 65 73 65 20 72 65 71 75 69 72 65 20 72 These require r
1160: 75 6e 2d 69 64 20 62 65 63 61 75 73 65 20 74 68 un-id because th
1170: 65 20 76 61 6c 75 65 73 20 63 6f 6d 65 20 66 72 e values come fr
1180: 6f 6d 20 74 68 65 20 72 75 6e 21 0a 3b 3b 0a 28 om the run!.;;.(
1190: 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d define (rmt:get-
11a0: 6b 65 79 2d 76 61 6c 2d 70 61 69 72 73 20 72 75 key-val-pairs ru
11b0: 6e 2d 69 64 29 0a 20 20 28 72 6d 74 3a 73 65 6e n-id). (rmt:sen
11c0: 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d 6b d-receive 'get-k
11d0: 65 79 2d 76 61 6c 2d 70 61 69 72 73 20 72 75 6e ey-val-pairs run
11e0: 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 -id (list run-id
11f0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d )))..(define (rm
1200: 74 3a 67 65 74 2d 6b 65 79 73 29 0a 20 20 28 69 t:get-keys). (i
1210: 66 20 2a 64 62 2d 6b 65 79 73 2a 20 2a 64 62 2d f *db-keys* *db-
1220: 6b 65 79 73 2a 20 0a 20 20 20 20 20 28 6c 65 74 keys* . (let
1230: 20 28 28 72 65 73 20 28 72 6d 74 3a 73 65 6e 64 ((res (rmt:send
1240: 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d 6b 65 -receive 'get-ke
1250: 79 73 20 23 66 20 27 28 29 29 29 29 0a 20 20 20 ys #f '()))).
1260: 20 20 20 20 28 73 65 74 21 20 2a 64 62 2d 6b 65 (set! *db-ke
1270: 79 73 2a 20 72 65 73 29 0a 20 20 20 20 20 20 20 ys* res).
1280: 72 65 73 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 res)))..(define
1290: 28 72 6d 74 3a 67 65 74 2d 6b 65 79 73 2d 77 72 (rmt:get-keys-wr
12a0: 69 74 65 29 20 3b 3b 20 64 75 6d 6d 79 20 71 75 ite) ;; dummy qu
12b0: 65 72 79 20 74 6f 20 66 6f 72 63 65 20 73 65 72 ery to force ser
12c0: 76 65 72 20 73 74 61 72 74 0a 20 20 28 6c 65 74 ver start. (let
12d0: 20 28 28 72 65 73 20 28 72 6d 74 3a 73 65 6e 64 ((res (rmt:send
12e0: 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d 6b 65 -receive 'get-ke
12f0: 79 73 2d 77 72 69 74 65 20 23 66 20 27 28 29 29 ys-write #f '())
1300: 29 29 0a 20 20 20 20 28 73 65 74 21 20 2a 64 62 )). (set! *db
1310: 2d 6b 65 79 73 2a 20 72 65 73 29 0a 20 20 20 20 -keys* res).
1320: 72 65 73 29 29 0a 0a 3b 3b 20 77 65 20 64 6f 6e res))..;; we don
1330: 27 74 20 72 65 75 73 65 20 72 75 6e 2d 69 64 27 't reuse run-id'
1340: 73 20 28 65 78 63 65 70 74 20 70 6f 73 73 69 62 s (except possib
1350: 6c 79 20 2a 61 66 74 65 72 2a 20 61 20 64 62 20 ly *after* a db
1360: 63 6c 65 61 6e 75 70 29 20 73 6f 20 69 74 20 69 cleanup) so it i
1370: 73 20 73 61 66 65 0a 3b 3b 20 74 6f 20 63 61 63 s safe.;; to cac
1380: 68 65 20 74 68 65 20 72 65 73 75 6c 73 20 69 6e he the resuls in
1390: 20 61 20 68 61 73 68 0a 3b 3b 0a 28 64 65 66 69 a hash.;;.(defi
13a0: 6e 65 20 28 72 6d 74 3a 67 65 74 2d 6b 65 79 2d ne (rmt:get-key-
13b0: 76 61 6c 73 20 72 75 6e 2d 69 64 29 0a 20 20 28 vals run-id). (
13c0: 6f 72 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 or (hash-table-r
13d0: 65 66 2f 64 65 66 61 75 6c 74 20 2a 6b 65 79 76 ef/default *keyv
13e0: 61 6c 73 2a 20 72 75 6e 2d 69 64 20 23 66 29 0a als* run-id #f).
13f0: 20 20 20 20 20 20 28 6c 65 74 20 28 28 72 65 73 (let ((res
1400: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
1410: 76 65 20 27 67 65 74 2d 6b 65 79 2d 76 61 6c 73 ve 'get-key-vals
1420: 20 23 66 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 #f (list run-id
1430: 29 29 29 29 0a 20 20 20 20 20 20 20 20 28 68 61 )))). (ha
1440: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 6b sh-table-set! *k
1450: 65 79 76 61 6c 73 2a 20 72 75 6e 2d 69 64 20 72 eyvals* run-id r
1460: 65 73 29 0a 20 20 20 20 20 20 20 20 72 65 73 29 es). res)
1470: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 ))..(define (rmt
1480: 3a 67 65 74 2d 74 61 72 67 65 74 73 29 0a 20 20 :get-targets).
1490: 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 (rmt:send-receiv
14a0: 65 20 27 67 65 74 2d 74 61 72 67 65 74 73 20 23 e 'get-targets #
14b0: 66 20 27 28 29 29 29 0a 0a 28 64 65 66 69 6e 65 f '()))..(define
14c0: 20 28 72 6d 74 3a 67 65 74 2d 74 61 72 67 65 74 (rmt:get-target
14d0: 20 72 75 6e 2d 69 64 29 0a 20 20 28 72 6d 74 3a run-id). (rmt:
14e0: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 send-receive 'ge
14f0: 74 2d 74 61 72 67 65 74 20 72 75 6e 2d 69 64 20 t-target run-id
1500: 28 6c 69 73 74 20 72 75 6e 2d 69 64 29 29 29 0a (list run-id))).
1510: 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 .(define (rmt:ge
1520: 74 2d 72 75 6e 2d 74 69 6d 65 73 20 72 75 6e 70 t-run-times runp
1530: 61 74 74 20 74 61 72 67 65 74 70 61 74 74 29 0a att targetpatt).
1540: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
1550: 69 76 65 20 27 67 65 74 2d 72 75 6e 2d 74 69 6d ive 'get-run-tim
1560: 65 73 20 23 66 20 28 6c 69 73 74 20 72 75 6e 70 es #f (list runp
1570: 61 74 74 20 74 61 72 67 65 74 70 61 74 74 20 29 att targetpatt )
1580: 29 29 20 0a 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d )) ...;;========
1590: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
15d0: 3b 20 20 54 20 45 20 53 20 54 20 53 0a 3b 3b 3d ; T E S T S.;;=
15e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1600: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1610: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1620: 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 4a 75 73 74 20 73 =====..;; Just s
1630: 6f 6d 65 20 73 79 6e 74 61 74 69 63 20 73 75 67 ome syntatic sug
1640: 61 72 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a ar.(define (rmt:
1650: 72 65 67 69 73 74 65 72 2d 74 65 73 74 20 72 75 register-test ru
1660: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 n-id test-name i
1670: 74 65 6d 2d 70 61 74 68 29 0a 20 20 28 72 6d 74 tem-path). (rmt
1680: 3a 67 65 6e 65 72 61 6c 2d 63 61 6c 6c 20 27 72 :general-call 'r
1690: 65 67 69 73 74 65 72 2d 74 65 73 74 20 72 75 6e egister-test run
16a0: 2d 69 64 20 72 75 6e 2d 69 64 20 74 65 73 74 2d -id run-id test-
16b0: 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 29 name item-path))
16c0: 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 ..(define (rmt:g
16d0: 65 74 2d 74 65 73 74 2d 69 64 20 72 75 6e 2d 69 et-test-id run-i
16e0: 64 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d 2d d testname item-
16f0: 70 61 74 68 29 0a 20 20 28 72 6d 74 3a 73 65 6e path). (rmt:sen
1700: 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d 74 d-receive 'get-t
1710: 65 73 74 2d 69 64 20 72 75 6e 2d 69 64 20 28 6c est-id run-id (l
1720: 69 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 6e ist run-id testn
1730: 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 29 29 ame item-path)))
1740: 0a 0a 3b 3b 20 72 75 6e 2d 69 64 20 69 73 20 4e ..;; run-id is N
1750: 4f 54 20 75 73 65 64 0a 3b 3b 0a 28 64 65 66 69 OT used.;;.(defi
1760: 6e 65 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 ne (rmt:get-test
1770: 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 72 75 6e 2d -info-by-id run-
1780: 69 64 20 74 65 73 74 2d 69 64 29 0a 20 20 28 69 id test-id). (i
1790: 66 20 28 6e 75 6d 62 65 72 3f 20 74 65 73 74 2d f (number? test-
17a0: 69 64 29 0a 20 20 20 20 20 20 28 72 6d 74 3a 73 id). (rmt:s
17b0: 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 end-receive 'get
17c0: 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 -test-info-by-id
17d0: 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 run-id (list ru
17e0: 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 29 0a 20 n-id test-id)).
17f0: 20 20 20 20 20 28 62 65 67 69 6e 0a 09 28 64 65 (begin..(de
1800: 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 bug:print 0 *def
1810: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
1820: 57 41 52 4e 49 4e 47 3a 20 42 61 64 20 64 61 74 WARNING: Bad dat
1830: 61 20 68 61 6e 64 65 64 20 74 6f 20 72 6d 74 3a a handed to rmt:
1840: 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 79 get-test-info-by
1850: 2d 69 64 20 72 75 6e 2d 69 64 3d 22 20 72 75 6e -id run-id=" run
1860: 2d 69 64 20 22 2c 20 74 65 73 74 2d 69 64 3d 22 -id ", test-id="
1870: 20 74 65 73 74 2d 69 64 29 0a 09 28 70 72 69 6e test-id)..(prin
1880: 74 2d 63 61 6c 6c 2d 63 68 61 69 6e 20 28 63 75 t-call-chain (cu
1890: 72 72 65 6e 74 2d 65 72 72 6f 72 2d 70 6f 72 74 rrent-error-port
18a0: 29 29 0a 09 23 66 29 29 29 0a 0a 28 64 65 66 69 ))..#f)))..(defi
18b0: 6e 65 20 28 72 6d 74 3a 74 65 73 74 2d 67 65 74 ne (rmt:test-get
18c0: 2d 72 75 6e 64 69 72 2d 66 72 6f 6d 2d 74 65 73 -rundir-from-tes
18d0: 74 2d 69 64 20 72 75 6e 2d 69 64 20 74 65 73 74 t-id run-id test
18e0: 2d 69 64 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 -id). (rmt:send
18f0: 2d 72 65 63 65 69 76 65 20 27 74 65 73 74 2d 67 -receive 'test-g
1900: 65 74 2d 72 75 6e 64 69 72 2d 66 72 6f 6d 2d 74 et-rundir-from-t
1910: 65 73 74 2d 69 64 20 72 75 6e 2d 69 64 20 28 6c est-id run-id (l
1920: 69 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d ist run-id test-
1930: 69 64 29 29 29 0a 0a 3b 3b 20 28 64 65 66 69 6e id)))..;; (defin
1940: 65 20 28 72 6d 74 3a 6f 70 65 6e 2d 74 65 73 74 e (rmt:open-test
1950: 2d 64 62 2d 62 79 2d 74 65 73 74 2d 69 64 20 72 -db-by-test-id r
1960: 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 23 21 un-id test-id #!
1970: 6b 65 79 20 28 77 6f 72 6b 2d 61 72 65 61 20 23 key (work-area #
1980: 66 29 29 0a 3b 3b 20 20 20 28 6c 65 74 2a 20 28 f)).;; (let* (
1990: 28 74 65 73 74 2d 70 61 74 68 20 28 69 66 20 28 (test-path (if (
19a0: 73 74 72 69 6e 67 3f 20 77 6f 72 6b 2d 61 72 65 string? work-are
19b0: 61 29 0a 3b 3b 20 09 09 09 77 6f 72 6b 2d 61 72 a).;; ...work-ar
19c0: 65 61 0a 3b 3b 20 09 09 09 28 72 6d 74 3a 74 65 ea.;; ...(rmt:te
19d0: 73 74 2d 67 65 74 2d 72 75 6e 64 69 72 2d 66 72 st-get-rundir-fr
19e0: 6f 6d 2d 74 65 73 74 2d 69 64 20 72 75 6e 2d 69 om-test-id run-i
19f0: 64 20 74 65 73 74 2d 69 64 29 29 29 29 0a 3b 3b d test-id)))).;;
1a00: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
1a10: 74 20 33 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 3 *default-log
1a20: 2d 70 6f 72 74 2a 20 22 54 45 53 54 20 50 41 54 -port* "TEST PAT
1a30: 48 3a 20 22 20 74 65 73 74 2d 70 61 74 68 29 0a H: " test-path).
1a40: 3b 3b 20 20 20 20 20 28 6f 70 65 6e 2d 74 65 73 ;; (open-tes
1a50: 74 2d 64 62 20 74 65 73 74 2d 70 61 74 68 29 29 t-db test-path))
1a60: 29 0a 0a 3b 3b 20 57 41 52 4e 49 4e 47 3a 20 54 )..;; WARNING: T
1a70: 68 69 73 20 63 75 72 72 65 6e 74 6c 79 20 62 79 his currently by
1a80: 70 61 73 73 65 73 20 74 68 65 20 74 72 61 6e 73 passes the trans
1a90: 61 63 74 69 6f 6e 20 77 72 61 70 70 65 64 20 77 action wrapped w
1aa0: 72 69 74 65 73 20 73 79 73 74 65 6d 0a 28 64 65 rites system.(de
1ab0: 66 69 6e 65 20 28 72 6d 74 3a 74 65 73 74 2d 73 fine (rmt:test-s
1ac0: 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d et-state-status-
1ad0: 62 79 2d 69 64 20 72 75 6e 2d 69 64 20 74 65 73 by-id run-id tes
1ae0: 74 2d 69 64 20 6e 65 77 73 74 61 74 65 20 6e 65 t-id newstate ne
1af0: 77 73 74 61 74 75 73 20 6e 65 77 63 6f 6d 6d 65 wstatus newcomme
1b00: 6e 74 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d nt). (rmt:send-
1b10: 72 65 63 65 69 76 65 20 27 74 65 73 74 2d 73 65 receive 'test-se
1b20: 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d 62 t-state-status-b
1b30: 79 2d 69 64 20 72 75 6e 2d 69 64 20 28 6c 69 73 y-id run-id (lis
1b40: 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 t run-id test-id
1b50: 20 6e 65 77 73 74 61 74 65 20 6e 65 77 73 74 61 newstate newsta
1b60: 74 75 73 20 6e 65 77 63 6f 6d 6d 65 6e 74 29 29 tus newcomment))
1b70: 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a )..(define (rmt:
1b80: 73 65 74 2d 74 65 73 74 73 2d 73 74 61 74 65 2d set-tests-state-
1b90: 73 74 61 74 75 73 20 72 75 6e 2d 69 64 20 20 20 status run-id
1ba0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1bb0: 20 20 20 74 65 73 74 6e 61 6d 65 73 20 63 75 72 testnames cur
1bc0: 72 73 74 61 74 65 20 63 75 72 72 73 74 61 74 75 rstate currstatu
1bd0: 73 20 6e 65 77 73 74 61 74 65 20 6e 65 77 73 74 s newstate newst
1be0: 61 74 75 73 29 0a 20 20 28 72 6d 74 3a 73 65 6e atus). (rmt:sen
1bf0: 64 2d 72 65 63 65 69 76 65 20 27 73 65 74 2d 74 d-receive 'set-t
1c00: 65 73 74 73 2d 73 74 61 74 65 2d 73 74 61 74 75 ests-state-statu
1c10: 73 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 s run-id (list r
1c20: 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 73 20 un-id testnames
1c30: 63 75 72 72 73 74 61 74 65 20 63 75 72 72 73 74 currstate currst
1c40: 61 74 75 73 20 6e 65 77 73 74 61 74 65 20 6e 65 atus newstate ne
1c50: 77 73 74 61 74 75 73 29 29 29 0a 0a 28 64 65 66 wstatus)))..(def
1c60: 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 ine (rmt:get-tes
1c70: 74 73 2d 66 6f 72 2d 72 75 6e 20 72 75 6e 2d 69 ts-for-run run-i
1c80: 64 20 74 65 73 74 70 61 74 74 20 73 74 61 74 65 d testpatt state
1c90: 73 20 73 74 61 74 75 73 65 73 20 6f 66 66 73 65 s statuses offse
1ca0: 74 20 6c 69 6d 69 74 20 6e 6f 74 2d 69 6e 20 73 t limit not-in s
1cb0: 6f 72 74 2d 62 79 20 73 6f 72 74 2d 6f 72 64 65 ort-by sort-orde
1cc0: 72 20 71 72 79 76 61 6c 73 20 6c 61 73 74 2d 75 r qryvals last-u
1cd0: 70 64 61 74 65 20 6d 6f 64 65 29 0a 20 20 3b 3b pdate mode). ;;
1ce0: 20 28 69 66 20 28 6e 75 6d 62 65 72 3f 20 72 75 (if (number? ru
1cf0: 6e 2d 69 64 29 0a 20 20 28 72 6d 74 3a 73 65 6e n-id). (rmt:sen
1d00: 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d 74 d-receive 'get-t
1d10: 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 72 75 6e ests-for-run run
1d20: 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 -id (list run-id
1d30: 20 74 65 73 74 70 61 74 74 20 73 74 61 74 65 73 testpatt states
1d40: 20 73 74 61 74 75 73 65 73 20 6f 66 66 73 65 74 statuses offset
1d50: 20 6c 69 6d 69 74 20 6e 6f 74 2d 69 6e 20 73 6f limit not-in so
1d60: 72 74 2d 62 79 20 73 6f 72 74 2d 6f 72 64 65 72 rt-by sort-order
1d70: 20 71 72 79 76 61 6c 73 20 6c 61 73 74 2d 75 70 qryvals last-up
1d80: 64 61 74 65 20 6d 6f 64 65 29 29 29 0a 20 20 3b date mode))). ;
1d90: 3b 20 20 20 20 28 62 65 67 69 6e 0a 20 20 3b 3b ; (begin. ;;
1da0: 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 .(debug:print-er
1db0: 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
1dc0: 6f 67 2d 70 6f 72 74 2a 20 22 72 6d 74 3a 67 65 og-port* "rmt:ge
1dd0: 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 t-tests-for-run
1de0: 63 61 6c 6c 65 64 20 77 69 74 68 20 62 61 64 20 called with bad
1df0: 72 75 6e 2d 69 64 3d 22 20 72 75 6e 2d 69 64 29 run-id=" run-id)
1e00: 0a 20 20 3b 3b 09 28 70 72 69 6e 74 2d 63 61 6c . ;;.(print-cal
1e10: 6c 2d 63 68 61 69 6e 20 28 63 75 72 72 65 6e 74 l-chain (current
1e20: 2d 65 72 72 6f 72 2d 70 6f 72 74 29 29 0a 20 20 -error-port)).
1e30: 3b 3b 09 27 28 29 29 29 29 0a 0a 28 64 65 66 69 ;;.'())))..(defi
1e40: 6e 65 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 ne (rmt:get-test
1e50: 73 2d 66 6f 72 2d 72 75 6e 2d 73 74 61 74 65 2d s-for-run-state-
1e60: 73 74 61 74 75 73 20 72 75 6e 2d 69 64 20 74 65 status run-id te
1e70: 73 74 70 61 74 74 20 6c 61 73 74 2d 75 70 64 61 stpatt last-upda
1e80: 74 65 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d te). (rmt:send-
1e90: 72 65 63 65 69 76 65 20 27 67 65 74 2d 74 65 73 receive 'get-tes
1ea0: 74 73 2d 66 6f 72 2d 72 75 6e 2d 73 74 61 74 65 ts-for-run-state
1eb0: 2d 73 74 61 74 75 73 20 72 75 6e 2d 69 64 20 28 -status run-id (
1ec0: 6c 69 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 list run-id test
1ed0: 70 61 74 74 20 6c 61 73 74 2d 75 70 64 61 74 65 patt last-update
1ee0: 29 29 29 0a 0a 3b 3b 20 67 65 74 20 73 74 75 66 )))..;; get stuf
1ef0: 66 20 76 69 61 20 73 79 6e 63 68 61 73 68 20 0a f via synchash .
1f00: 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 73 79 6e (define (rmt:syn
1f10: 63 68 61 73 68 2d 67 65 74 20 72 75 6e 2d 69 64 chash-get run-id
1f20: 20 70 72 6f 63 20 73 79 6e 63 6b 65 79 20 6b 65 proc synckey ke
1f30: 79 6e 75 6d 20 70 61 72 61 6d 73 29 0a 20 20 28 ynum params). (
1f40: 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 rmt:send-receive
1f50: 20 27 73 79 6e 63 68 61 73 68 2d 67 65 74 20 72 'synchash-get r
1f60: 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d un-id (list run-
1f70: 69 64 20 70 72 6f 63 20 73 79 6e 63 6b 65 79 20 id proc synckey
1f80: 6b 65 79 6e 75 6d 20 70 61 72 61 6d 73 29 29 29 keynum params)))
1f90: 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 ..(define (rmt:g
1fa0: 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e et-tests-for-run
1fb0: 2d 6d 69 6e 64 61 74 61 20 72 75 6e 2d 69 64 20 -mindata run-id
1fc0: 74 65 73 74 70 61 74 74 20 73 74 61 74 65 73 20 testpatt states
1fd0: 73 74 61 74 75 73 20 6e 6f 74 2d 69 6e 29 0a 20 status not-in).
1fe0: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
1ff0: 76 65 20 27 67 65 74 2d 74 65 73 74 73 2d 66 6f ve 'get-tests-fo
2000: 72 2d 72 75 6e 2d 6d 69 6e 64 61 74 61 20 72 75 r-run-mindata ru
2010: 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 n-id (list run-i
2020: 64 20 74 65 73 74 70 61 74 74 20 73 74 61 74 65 d testpatt state
2030: 73 20 73 74 61 74 75 73 20 6e 6f 74 2d 69 6e 29 s status not-in)
2040: 29 29 0a 20 20 0a 3b 3b 20 49 44 45 41 3a 20 54 )). .;; IDEA: T
2050: 68 72 65 61 64 69 66 79 20 74 68 65 73 65 20 2d hreadify these -
2060: 20 74 68 65 79 20 73 70 65 6e 64 20 61 20 6c 6f they spend a lo
2070: 74 20 6f 66 20 74 69 6d 65 20 77 61 69 74 69 6e t of time waitin
2080: 67 20 2e 2e 2e 0a 3b 3b 0a 28 64 65 66 69 6e 65 g ....;;.(define
2090: 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 73 2d (rmt:get-tests-
20a0: 66 6f 72 2d 72 75 6e 73 2d 6d 69 6e 64 61 74 61 for-runs-mindata
20b0: 20 72 75 6e 2d 69 64 73 20 74 65 73 74 70 61 74 run-ids testpat
20c0: 74 20 73 74 61 74 65 73 20 73 74 61 74 75 73 20 t states status
20d0: 6e 6f 74 2d 69 6e 29 0a 20 20 28 6c 65 74 20 28 not-in). (let (
20e0: 28 6d 75 6c 74 69 2d 72 75 6e 2d 6d 75 74 65 78 (multi-run-mutex
20f0: 20 28 6d 61 6b 65 2d 6d 75 74 65 78 29 29 0a 09 (make-mutex))..
2100: 28 72 75 6e 2d 69 64 2d 6c 69 73 74 20 28 69 66 (run-id-list (if
2110: 20 72 75 6e 2d 69 64 73 0a 09 09 09 20 72 75 6e run-ids.... run
2120: 2d 69 64 73 0a 09 09 09 20 28 72 6d 74 3a 67 65 -ids.... (rmt:ge
2130: 74 2d 61 6c 6c 2d 72 75 6e 2d 69 64 73 29 29 29 t-all-run-ids)))
2140: 0a 09 28 72 65 73 75 6c 74 20 20 20 20 20 20 27 ..(result '
2150: 28 29 29 29 0a 20 20 20 20 28 69 66 20 28 6e 75 ())). (if (nu
2160: 6c 6c 3f 20 72 75 6e 2d 69 64 2d 6c 69 73 74 29 ll? run-id-list)
2170: 0a 09 27 28 29 0a 09 28 6c 65 74 20 6c 6f 6f 70 ..'()..(let loop
2180: 20 28 28 68 65 64 20 20 20 20 20 28 63 61 72 20 ((hed (car
2190: 72 75 6e 2d 69 64 2d 6c 69 73 74 29 29 0a 09 09 run-id-list))...
21a0: 20 20 20 28 74 61 6c 20 20 20 20 20 28 63 64 72 (tal (cdr
21b0: 20 72 75 6e 2d 69 64 2d 6c 69 73 74 29 29 0a 09 run-id-list))..
21c0: 09 20 20 20 28 74 68 72 65 61 64 73 20 27 28 29 . (threads '()
21d0: 29 29 0a 09 20 20 28 69 66 20 28 3e 20 28 6c 65 )).. (if (> (le
21e0: 6e 67 74 68 20 74 68 72 65 61 64 73 29 20 35 29 ngth threads) 5)
21f0: 0a 09 20 20 20 20 20 20 28 6c 6f 6f 70 20 68 65 .. (loop he
2200: 64 20 74 61 6c 20 28 66 69 6c 74 65 72 20 28 6c d tal (filter (l
2210: 61 6d 62 64 61 20 28 74 68 29 28 6e 6f 74 20 28 ambda (th)(not (
2220: 6d 65 6d 62 65 72 20 28 74 68 72 65 61 64 2d 73 member (thread-s
2230: 74 61 74 65 20 74 68 29 20 27 28 74 65 72 6d 69 tate th) '(termi
2240: 6e 61 74 65 64 20 64 65 61 64 29 29 29 29 20 74 nated dead)))) t
2250: 68 72 65 61 64 73 29 29 0a 09 20 20 20 20 20 20 hreads))..
2260: 28 6c 65 74 2a 20 28 28 6e 65 77 74 68 72 65 61 (let* ((newthrea
2270: 64 20 28 6d 61 6b 65 2d 74 68 72 65 61 64 0a 09 d (make-thread..
2280: 09 09 09 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 ... (lambda ()..
2290: 09 09 09 20 20 20 28 6c 65 74 20 28 28 72 65 73 ... (let ((res
22a0: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
22b0: 76 65 20 27 67 65 74 2d 74 65 73 74 73 2d 66 6f ve 'get-tests-fo
22c0: 72 2d 72 75 6e 2d 6d 69 6e 64 61 74 61 20 68 65 r-run-mindata he
22d0: 64 20 28 6c 69 73 74 20 68 65 64 20 74 65 73 74 d (list hed test
22e0: 70 61 74 74 20 73 74 61 74 65 73 20 73 74 61 74 patt states stat
22f0: 75 73 20 6e 6f 74 2d 69 6e 29 29 29 29 0a 09 09 us not-in))))...
2300: 09 09 20 20 20 20 20 28 69 66 20 28 6c 69 73 74 .. (if (list
2310: 3f 20 72 65 73 29 0a 09 09 09 09 09 20 28 62 65 ? res)...... (be
2320: 67 69 6e 0a 09 09 09 09 09 20 20 20 28 6d 75 74 gin...... (mut
2330: 65 78 2d 6c 6f 63 6b 21 20 6d 75 6c 74 69 2d 72 ex-lock! multi-r
2340: 75 6e 2d 6d 75 74 65 78 29 0a 09 09 09 09 09 20 un-mutex)......
2350: 20 20 28 73 65 74 21 20 72 65 73 75 6c 74 20 28 (set! result (
2360: 61 70 70 65 6e 64 20 72 65 73 75 6c 74 20 72 65 append result re
2370: 73 29 29 0a 09 09 09 09 09 20 20 20 28 6d 75 74 s))...... (mut
2380: 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d 75 6c 74 69 ex-unlock! multi
2390: 2d 72 75 6e 2d 6d 75 74 65 78 29 29 0a 09 09 09 -run-mutex))....
23a0: 09 09 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d .. (debug:print-
23b0: 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 error 0 *default
23c0: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 67 65 74 2d -log-port* "get-
23d0: 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 2d 6d 69 tests-for-run-mi
23e0: 6e 64 61 74 61 20 66 61 69 6c 65 64 20 66 6f 72 ndata failed for
23f0: 20 72 75 6e 2d 69 64 20 22 20 68 65 64 20 22 2c run-id " hed ",
2400: 20 74 65 73 74 70 61 74 74 20 22 20 74 65 73 74 testpatt " test
2410: 70 61 74 74 20 22 2c 20 73 74 61 74 65 73 20 22 patt ", states "
2420: 20 73 74 61 74 65 73 20 22 2c 20 73 74 61 74 75 states ", statu
2430: 73 20 22 20 73 74 61 74 75 73 20 22 2c 20 6e 6f s " status ", no
2440: 74 2d 69 6e 20 22 20 6e 6f 74 2d 69 6e 29 29 29 t-in " not-in)))
2450: 29 0a 09 09 09 09 20 28 63 6f 6e 63 20 22 6d 75 )..... (conc "mu
2460: 6c 74 69 2d 72 75 6e 2d 74 68 72 65 61 64 20 66 lti-run-thread f
2470: 6f 72 20 72 75 6e 2d 69 64 20 22 20 68 65 64 29 or run-id " hed)
2480: 29 29 0a 09 09 20 20 20 20 20 28 6e 65 77 74 68 ))... (newth
2490: 72 65 61 64 73 20 28 63 6f 6e 73 20 6e 65 77 74 reads (cons newt
24a0: 68 72 65 61 64 20 74 68 72 65 61 64 73 29 29 29 hread threads)))
24b0: 0a 09 09 28 74 68 72 65 61 64 2d 73 74 61 72 74 ...(thread-start
24c0: 21 20 6e 65 77 74 68 72 65 61 64 29 0a 09 09 28 ! newthread)...(
24d0: 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 30 2e thread-sleep! 0.
24e0: 30 35 34 29 20 3b 3b 20 67 69 76 65 20 74 68 61 054) ;; give tha
24f0: 74 20 74 68 72 65 61 64 20 73 6f 6d 65 20 74 69 t thread some ti
2500: 6d 65 20 74 6f 20 73 74 61 72 74 0a 09 09 28 69 me to start...(i
2510: 66 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 0a 09 09 f (null? tal)...
2520: 20 20 20 20 6e 65 77 74 68 72 65 61 64 73 0a 09 newthreads..
2530: 09 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 . (loop (car
2540: 74 61 6c 29 28 63 64 72 20 74 61 6c 29 20 6e 65 tal)(cdr tal) ne
2550: 77 74 68 72 65 61 64 73 29 29 29 29 29 29 0a 20 wthreads)))))).
2560: 20 20 20 72 65 73 75 6c 74 29 29 0a 0a 3b 3b 20 result))..;;
2570: 3b 3b 20 49 44 45 41 3a 20 54 68 72 65 61 64 69 ;; IDEA: Threadi
2580: 66 79 20 74 68 65 73 65 20 2d 20 74 68 65 79 20 fy these - they
2590: 73 70 65 6e 64 20 61 20 6c 6f 74 20 6f 66 20 74 spend a lot of t
25a0: 69 6d 65 20 77 61 69 74 69 6e 67 20 2e 2e 2e 0a ime waiting ....
25b0: 3b 3b 20 3b 3b 0a 3b 3b 20 28 64 65 66 69 6e 65 ;; ;;.;; (define
25c0: 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 73 2d (rmt:get-tests-
25d0: 66 6f 72 2d 72 75 6e 73 2d 6d 69 6e 64 61 74 61 for-runs-mindata
25e0: 20 72 75 6e 2d 69 64 73 20 74 65 73 74 70 61 74 run-ids testpat
25f0: 74 20 73 74 61 74 65 73 20 73 74 61 74 75 73 20 t states status
2600: 6e 6f 74 2d 69 6e 29 0a 3b 3b 20 20 20 28 6c 65 not-in).;; (le
2610: 74 20 28 28 72 75 6e 2d 69 64 2d 6c 69 73 74 20 t ((run-id-list
2620: 28 69 66 20 72 75 6e 2d 69 64 73 0a 3b 3b 20 09 (if run-ids.;; .
2630: 09 09 20 72 75 6e 2d 69 64 73 0a 3b 3b 20 09 09 .. run-ids.;; ..
2640: 09 20 28 72 6d 74 3a 67 65 74 2d 61 6c 6c 2d 72 . (rmt:get-all-r
2650: 75 6e 2d 69 64 73 29 29 29 29 0a 3b 3b 20 20 20 un-ids)))).;;
2660: 20 20 28 61 70 70 6c 79 20 61 70 70 65 6e 64 20 (apply append
2670: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 72 75 (map (lambda (ru
2680: 6e 2d 69 64 29 0a 3b 3b 20 09 09 09 20 28 72 6d n-id).;; ... (rm
2690: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
26a0: 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 get-tests-for-ru
26b0: 6e 2d 6d 69 6e 64 61 74 61 20 72 75 6e 2d 69 64 n-mindata run-id
26c0: 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 73 20 74 (list run-ids t
26d0: 65 73 74 70 61 74 74 20 73 74 61 74 65 73 20 73 estpatt states s
26e0: 74 61 74 75 73 20 6e 6f 74 2d 69 6e 29 29 29 0a tatus not-in))).
26f0: 3b 3b 20 09 09 20 20 20 20 20 20 20 72 75 6e 2d ;; .. run-
2700: 69 64 2d 6c 69 73 74 29 29 29 29 0a 0a 28 64 65 id-list))))..(de
2710: 66 69 6e 65 20 28 72 6d 74 3a 64 65 6c 65 74 65 fine (rmt:delete
2720: 2d 74 65 73 74 2d 72 65 63 6f 72 64 73 20 72 75 -test-records ru
2730: 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 0a 20 20 n-id test-id).
2740: 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 (rmt:send-receiv
2750: 65 20 27 64 65 6c 65 74 65 2d 74 65 73 74 2d 72 e 'delete-test-r
2760: 65 63 6f 72 64 73 20 72 75 6e 2d 69 64 20 28 6c ecords run-id (l
2770: 69 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d ist run-id test-
2780: 69 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 id)))..(define (
2790: 72 6d 74 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 rmt:test-set-sta
27a0: 74 65 2d 73 74 61 74 75 73 20 72 75 6e 2d 69 64 te-status run-id
27b0: 20 74 65 73 74 2d 69 64 20 73 74 61 74 65 20 73 test-id state s
27c0: 74 61 74 75 73 20 6d 73 67 29 0a 20 20 28 72 6d tatus msg). (rm
27d0: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
27e0: 74 65 73 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 test-set-state-s
27f0: 74 61 74 75 73 20 72 75 6e 2d 69 64 20 28 6c 69 tatus run-id (li
2800: 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 st run-id test-i
2810: 64 20 73 74 61 74 65 20 73 74 61 74 75 73 20 6d d state status m
2820: 73 67 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 sg)))..(define (
2830: 72 6d 74 3a 74 65 73 74 2d 74 6f 70 6c 65 76 65 rmt:test-topleve
2840: 6c 2d 6e 75 6d 2d 69 74 65 6d 73 20 72 75 6e 2d l-num-items run-
2850: 69 64 20 74 65 73 74 2d 6e 61 6d 65 29 0a 20 20 id test-name).
2860: 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 (rmt:send-receiv
2870: 65 20 27 74 65 73 74 2d 74 6f 70 6c 65 76 65 6c e 'test-toplevel
2880: 2d 6e 75 6d 2d 69 74 65 6d 73 20 72 75 6e 2d 69 -num-items run-i
2890: 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 20 74 d (list run-id t
28a0: 65 73 74 2d 6e 61 6d 65 29 29 29 0a 0a 3b 3b 20 est-name)))..;;
28b0: 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 (define (rmt:get
28c0: 2d 70 72 65 76 69 6f 75 73 2d 74 65 73 74 2d 72 -previous-test-r
28d0: 75 6e 2d 72 65 63 6f 72 64 20 72 75 6e 2d 69 64 un-record run-id
28e0: 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d test-name item-
28f0: 70 61 74 68 29 0a 3b 3b 20 20 20 28 72 6d 74 3a path).;; (rmt:
2900: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 send-receive 'ge
2910: 74 2d 70 72 65 76 69 6f 75 73 2d 74 65 73 74 2d t-previous-test-
2920: 72 75 6e 2d 72 65 63 6f 72 64 20 72 75 6e 2d 69 run-record run-i
2930: 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 20 74 d (list run-id t
2940: 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 est-name item-pa
2950: 74 68 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 th)))..(define (
2960: 72 6d 74 3a 67 65 74 2d 6d 61 74 63 68 69 6e 67 rmt:get-matching
2970: 2d 70 72 65 76 69 6f 75 73 2d 74 65 73 74 2d 72 -previous-test-r
2980: 75 6e 2d 72 65 63 6f 72 64 73 20 72 75 6e 2d 69 un-records run-i
2990: 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d d test-name item
29a0: 2d 70 61 74 68 29 0a 20 20 28 72 6d 74 3a 73 65 -path). (rmt:se
29b0: 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d nd-receive 'get-
29c0: 6d 61 74 63 68 69 6e 67 2d 70 72 65 76 69 6f 75 matching-previou
29d0: 73 2d 74 65 73 74 2d 72 75 6e 2d 72 65 63 6f 72 s-test-run-recor
29e0: 64 73 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 ds run-id (list
29f0: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
2a00: 20 69 74 65 6d 2d 70 61 74 68 29 29 29 0a 0a 28 item-path)))..(
2a10: 64 65 66 69 6e 65 20 28 72 6d 74 3a 74 65 73 74 define (rmt:test
2a20: 2d 67 65 74 2d 6c 6f 67 66 69 6c 65 2d 69 6e 66 -get-logfile-inf
2a30: 6f 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 o run-id test-na
2a40: 6d 65 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d me). (rmt:send-
2a50: 72 65 63 65 69 76 65 20 27 74 65 73 74 2d 67 65 receive 'test-ge
2a60: 74 2d 6c 6f 67 66 69 6c 65 2d 69 6e 66 6f 20 72 t-logfile-info r
2a70: 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d un-id (list run-
2a80: 69 64 20 74 65 73 74 2d 6e 61 6d 65 29 29 29 0a id test-name))).
2a90: 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 74 65 .(define (rmt:te
2aa0: 73 74 2d 67 65 74 2d 72 65 63 6f 72 64 73 2d 66 st-get-records-f
2ab0: 6f 72 2d 69 6e 64 65 78 2d 66 69 6c 65 20 72 75 or-index-file ru
2ac0: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 29 0a n-id test-name).
2ad0: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
2ae0: 69 76 65 20 27 74 65 73 74 2d 67 65 74 2d 72 65 ive 'test-get-re
2af0: 63 6f 72 64 73 2d 66 6f 72 2d 69 6e 64 65 78 2d cords-for-index-
2b00: 66 69 6c 65 20 72 75 6e 2d 69 64 20 28 6c 69 73 file run-id (lis
2b10: 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 t run-id test-na
2b20: 6d 65 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 me)))..(define (
2b30: 72 6d 74 3a 67 65 74 2d 74 65 73 74 69 6e 66 6f rmt:get-testinfo
2b40: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 20 72 75 -state-status ru
2b50: 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 0a 20 20 n-id test-id).
2b60: 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 (rmt:send-receiv
2b70: 65 20 27 67 65 74 2d 74 65 73 74 69 6e 66 6f 2d e 'get-testinfo-
2b80: 73 74 61 74 65 2d 73 74 61 74 75 73 20 72 75 6e state-status run
2b90: 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 -id (list run-id
2ba0: 20 74 65 73 74 2d 69 64 29 29 29 0a 0a 28 64 65 test-id)))..(de
2bb0: 66 69 6e 65 20 28 72 6d 74 3a 74 65 73 74 2d 73 fine (rmt:test-s
2bc0: 65 74 2d 6c 6f 67 21 20 72 75 6e 2d 69 64 20 74 et-log! run-id t
2bd0: 65 73 74 2d 69 64 20 6c 6f 67 66 29 0a 20 20 28 est-id logf). (
2be0: 69 66 20 28 73 74 72 69 6e 67 3f 20 6c 6f 67 66 if (string? logf
2bf0: 29 28 72 6d 74 3a 67 65 6e 65 72 61 6c 2d 63 61 )(rmt:general-ca
2c00: 6c 6c 20 27 74 65 73 74 2d 73 65 74 2d 6c 6f 67 ll 'test-set-log
2c10: 20 72 75 6e 2d 69 64 20 6c 6f 67 66 20 74 65 73 run-id logf tes
2c20: 74 2d 69 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 t-id)))..(define
2c30: 20 28 72 6d 74 3a 74 65 73 74 2d 73 65 74 2d 74 (rmt:test-set-t
2c40: 6f 70 2d 70 72 6f 63 65 73 73 2d 70 69 64 20 72 op-process-pid r
2c50: 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 70 69 un-id test-id pi
2c60: 64 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 d). (rmt:send-r
2c70: 65 63 65 69 76 65 20 27 74 65 73 74 2d 73 65 74 eceive 'test-set
2c80: 2d 74 6f 70 2d 70 72 6f 63 65 73 73 2d 70 69 64 -top-process-pid
2c90: 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 run-id (list ru
2ca0: 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 70 69 64 n-id test-id pid
2cb0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d )))..(define (rm
2cc0: 74 3a 74 65 73 74 2d 67 65 74 2d 74 6f 70 2d 70 t:test-get-top-p
2cd0: 72 6f 63 65 73 73 2d 70 69 64 20 72 75 6e 2d 69 rocess-pid run-i
2ce0: 64 20 74 65 73 74 2d 69 64 29 0a 20 20 28 72 6d d test-id). (rm
2cf0: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
2d00: 74 65 73 74 2d 67 65 74 2d 74 6f 70 2d 70 72 6f test-get-top-pro
2d10: 63 65 73 73 2d 70 69 64 20 72 75 6e 2d 69 64 20 cess-pid run-id
2d20: 28 6c 69 73 74 20 72 75 6e 2d 69 64 20 74 65 73 (list run-id tes
2d30: 74 2d 69 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 t-id)))..(define
2d40: 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e 2d 69 64 (rmt:get-run-id
2d50: 73 2d 6d 61 74 63 68 69 6e 67 2d 74 61 72 67 65 s-matching-targe
2d60: 74 20 6b 65 79 6e 61 6d 65 73 20 74 61 72 67 65 t keynames targe
2d70: 74 20 72 65 73 20 72 75 6e 6e 61 6d 65 20 74 65 t res runname te
2d80: 73 74 70 61 74 74 20 73 74 61 74 65 70 61 74 74 stpatt statepatt
2d90: 20 73 74 61 74 75 73 70 61 74 74 29 0a 20 20 28 statuspatt). (
2da0: 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 rmt:send-receive
2db0: 20 27 67 65 74 2d 72 75 6e 2d 69 64 73 2d 6d 61 'get-run-ids-ma
2dc0: 74 63 68 69 6e 67 2d 74 61 72 67 65 74 20 23 66 tching-target #f
2dd0: 20 28 6c 69 73 74 20 6b 65 79 6e 61 6d 65 73 20 (list keynames
2de0: 74 61 72 67 65 74 20 72 65 73 20 72 75 6e 6e 61 target res runna
2df0: 6d 65 20 74 65 73 74 70 61 74 74 20 73 74 61 74 me testpatt stat
2e00: 65 70 61 74 74 20 73 74 61 74 75 73 70 61 74 74 epatt statuspatt
2e10: 29 29 29 0a 0a 3b 3b 20 4e 4f 54 45 3a 20 54 68 )))..;; NOTE: Th
2e20: 69 73 20 77 69 6c 6c 20 6f 70 65 6e 20 61 6e 64 is will open and
2e30: 20 61 63 63 65 73 73 20 41 4c 4c 20 72 75 6e 20 access ALL run
2e40: 64 61 74 61 62 61 73 65 73 2e 20 0a 3b 3b 0a 28 databases. .;;.(
2e50: 64 65 66 69 6e 65 20 28 72 6d 74 3a 74 65 73 74 define (rmt:test
2e60: 2d 67 65 74 2d 70 61 74 68 73 2d 6d 61 74 63 68 -get-paths-match
2e70: 69 6e 67 2d 6b 65 79 6e 61 6d 65 73 2d 74 61 72 ing-keynames-tar
2e80: 67 65 74 2d 6e 65 77 20 6b 65 79 6e 61 6d 65 73 get-new keynames
2e90: 20 74 61 72 67 65 74 20 72 65 73 20 74 65 73 74 target res test
2ea0: 70 61 74 74 20 73 74 61 74 65 70 61 74 74 20 73 patt statepatt s
2eb0: 74 61 74 75 73 70 61 74 74 20 72 75 6e 6e 61 6d tatuspatt runnam
2ec0: 65 29 0a 20 20 28 6c 65 74 20 28 28 72 75 6e 2d e). (let ((run-
2ed0: 69 64 73 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e ids (rmt:get-run
2ee0: 2d 69 64 73 2d 6d 61 74 63 68 69 6e 67 2d 74 61 -ids-matching-ta
2ef0: 72 67 65 74 20 6b 65 79 6e 61 6d 65 73 20 74 61 rget keynames ta
2f00: 72 67 65 74 20 72 65 73 20 72 75 6e 6e 61 6d 65 rget res runname
2f10: 20 74 65 73 74 70 61 74 74 20 73 74 61 74 65 70 testpatt statep
2f20: 61 74 74 20 73 74 61 74 75 73 70 61 74 74 29 29 att statuspatt))
2f30: 29 0a 20 20 20 20 28 61 70 70 6c 79 20 61 70 70 ). (apply app
2f40: 65 6e 64 20 0a 09 20 20 20 28 6d 61 70 20 28 6c end .. (map (l
2f50: 61 6d 62 64 61 20 28 72 75 6e 2d 69 64 29 0a 09 ambda (run-id)..
2f60: 09 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 . (rmt:send-rec
2f70: 65 69 76 65 20 27 74 65 73 74 2d 67 65 74 2d 70 eive 'test-get-p
2f80: 61 74 68 73 2d 6d 61 74 63 68 69 6e 67 2d 6b 65 aths-matching-ke
2f90: 79 6e 61 6d 65 73 2d 74 61 72 67 65 74 2d 6e 65 ynames-target-ne
2fa0: 77 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 w run-id (list r
2fb0: 75 6e 2d 69 64 20 6b 65 79 6e 61 6d 65 73 20 74 un-id keynames t
2fc0: 61 72 67 65 74 20 72 65 73 20 74 65 73 74 70 61 arget res testpa
2fd0: 74 74 20 73 74 61 74 65 70 61 74 74 20 73 74 61 tt statepatt sta
2fe0: 74 75 73 70 61 74 74 20 72 75 6e 6e 61 6d 65 29 tuspatt runname)
2ff0: 29 29 0a 09 20 20 20 72 75 6e 2d 69 64 73 29 29 )).. run-ids))
3000: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 ))..(define (rmt
3010: 3a 67 65 74 2d 70 72 65 72 65 71 73 2d 6e 6f 74 :get-prereqs-not
3020: 2d 6d 65 74 20 72 75 6e 2d 69 64 20 77 61 69 74 -met run-id wait
3030: 6f 6e 73 20 72 65 66 2d 74 65 73 74 2d 6e 61 6d ons ref-test-nam
3040: 65 20 72 65 66 2d 69 74 65 6d 2d 70 61 74 68 20 e ref-item-path
3050: 23 21 6b 65 79 20 28 6d 6f 64 65 20 27 28 6e 6f #!key (mode '(no
3060: 72 6d 61 6c 29 29 28 69 74 65 6d 6d 61 70 73 20 rmal))(itemmaps
3070: 23 66 29 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 #f)). (rmt:send
3080: 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d 70 72 -receive 'get-pr
3090: 65 72 65 71 73 2d 6e 6f 74 2d 6d 65 74 20 72 75 ereqs-not-met ru
30a0: 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 n-id (list run-i
30b0: 64 20 77 61 69 74 6f 6e 73 20 72 65 66 2d 74 65 d waitons ref-te
30c0: 73 74 2d 6e 61 6d 65 20 72 65 66 2d 69 74 65 6d st-name ref-item
30d0: 2d 70 61 74 68 20 6d 6f 64 65 20 69 74 65 6d 6d -path mode itemm
30e0: 61 70 73 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 aps)))..(define
30f0: 28 72 6d 74 3a 67 65 74 2d 63 6f 75 6e 74 2d 74 (rmt:get-count-t
3100: 65 73 74 73 2d 72 75 6e 6e 69 6e 67 2d 66 6f 72 ests-running-for
3110: 2d 72 75 6e 2d 69 64 20 72 75 6e 2d 69 64 29 0a -run-id run-id).
3120: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
3130: 69 76 65 20 27 67 65 74 2d 63 6f 75 6e 74 2d 74 ive 'get-count-t
3140: 65 73 74 73 2d 72 75 6e 6e 69 6e 67 2d 66 6f 72 ests-running-for
3150: 2d 72 75 6e 2d 69 64 20 72 75 6e 2d 69 64 20 28 -run-id run-id (
3160: 6c 69 73 74 20 72 75 6e 2d 69 64 29 29 29 0a 0a list run-id)))..
3170: 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 (define (rmt:get
3180: 2d 6e 6f 74 2d 63 6f 6d 70 6c 65 74 65 64 2d 63 -not-completed-c
3190: 6e 74 20 72 75 6e 2d 69 64 29 0a 20 20 28 72 6d nt run-id). (rm
31a0: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
31b0: 67 65 74 2d 6e 6f 74 2d 63 6f 6d 70 6c 65 74 65 get-not-complete
31c0: 64 2d 63 6e 74 20 72 75 6e 2d 69 64 20 28 6c 69 d-cnt run-id (li
31d0: 73 74 20 72 75 6e 2d 69 64 29 29 29 0a 0a 0a 3b st run-id)))...;
31e0: 3b 20 53 74 61 74 69 73 74 69 63 61 6c 20 71 75 ; Statistical qu
31f0: 65 72 69 65 73 0a 0a 28 64 65 66 69 6e 65 20 28 eries..(define (
3200: 72 6d 74 3a 67 65 74 2d 63 6f 75 6e 74 2d 74 65 rmt:get-count-te
3210: 73 74 73 2d 72 75 6e 6e 69 6e 67 20 72 75 6e 2d sts-running run-
3220: 69 64 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d id). (rmt:send-
3230: 72 65 63 65 69 76 65 20 27 67 65 74 2d 63 6f 75 receive 'get-cou
3240: 6e 74 2d 74 65 73 74 73 2d 72 75 6e 6e 69 6e 67 nt-tests-running
3250: 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 run-id (list ru
3260: 6e 2d 69 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 n-id)))..(define
3270: 20 28 72 6d 74 3a 67 65 74 2d 63 6f 75 6e 74 2d (rmt:get-count-
3280: 74 65 73 74 73 2d 72 75 6e 6e 69 6e 67 2d 66 6f tests-running-fo
3290: 72 2d 74 65 73 74 6e 61 6d 65 20 72 75 6e 2d 69 r-testname run-i
32a0: 64 20 74 65 73 74 6e 61 6d 65 29 0a 20 20 28 72 d testname). (r
32b0: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
32c0: 27 67 65 74 2d 63 6f 75 6e 74 2d 74 65 73 74 73 'get-count-tests
32d0: 2d 72 75 6e 6e 69 6e 67 2d 66 6f 72 2d 74 65 73 -running-for-tes
32e0: 74 6e 61 6d 65 20 72 75 6e 2d 69 64 20 28 6c 69 tname run-id (li
32f0: 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 st run-id testna
3300: 6d 65 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 me)))..(define (
3310: 72 6d 74 3a 67 65 74 2d 63 6f 75 6e 74 2d 74 65 rmt:get-count-te
3320: 73 74 73 2d 72 75 6e 6e 69 6e 67 2d 69 6e 2d 6a sts-running-in-j
3330: 6f 62 67 72 6f 75 70 20 72 75 6e 2d 69 64 20 6a obgroup run-id j
3340: 6f 62 67 72 6f 75 70 29 0a 20 20 28 72 6d 74 3a obgroup). (rmt:
3350: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 send-receive 'ge
3360: 74 2d 63 6f 75 6e 74 2d 74 65 73 74 73 2d 72 75 t-count-tests-ru
3370: 6e 6e 69 6e 67 2d 69 6e 2d 6a 6f 62 67 72 6f 75 nning-in-jobgrou
3380: 70 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 p run-id (list r
3390: 75 6e 2d 69 64 20 6a 6f 62 67 72 6f 75 70 29 29 un-id jobgroup))
33a0: 29 0a 0a 3b 3b 20 73 74 61 74 65 20 61 6e 64 20 )..;; state and
33b0: 73 74 61 74 75 73 20 61 72 65 20 65 78 74 72 61 status are extra
33c0: 20 68 69 6e 74 73 20 6e 6f 74 20 75 73 75 61 6c hints not usual
33d0: 6c 79 20 75 73 65 64 20 69 6e 20 74 68 65 20 63 ly used in the c
33e0: 61 6c 63 75 6c 61 74 69 6f 6e 0a 3b 3b 0a 28 64 alculation.;;.(d
33f0: 65 66 69 6e 65 20 28 72 6d 74 3a 73 65 74 2d 73 efine (rmt:set-s
3400: 74 61 74 65 2d 73 74 61 74 75 73 2d 61 6e 64 2d tate-status-and-
3410: 72 6f 6c 6c 2d 75 70 2d 69 74 65 6d 73 20 72 75 roll-up-items ru
3420: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 n-id test-name i
3430: 74 65 6d 2d 70 61 74 68 20 73 74 61 74 65 20 73 tem-path state s
3440: 74 61 74 75 73 20 63 6f 6d 6d 65 6e 74 29 0a 20 tatus comment).
3450: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
3460: 76 65 20 27 73 65 74 2d 73 74 61 74 65 2d 73 74 ve 'set-state-st
3470: 61 74 75 73 2d 61 6e 64 2d 72 6f 6c 6c 2d 75 70 atus-and-roll-up
3480: 2d 69 74 65 6d 73 20 72 75 6e 2d 69 64 20 28 6c -items run-id (l
3490: 69 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d ist run-id test-
34a0: 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 20 73 name item-path s
34b0: 74 61 74 65 20 73 74 61 74 75 73 20 63 6f 6d 6d tate status comm
34c0: 65 6e 74 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 ent)))..(define
34d0: 28 72 6d 74 3a 73 65 74 2d 73 74 61 74 65 2d 73 (rmt:set-state-s
34e0: 74 61 74 75 73 2d 61 6e 64 2d 72 6f 6c 6c 2d 75 tatus-and-roll-u
34f0: 70 2d 72 75 6e 20 72 75 6e 2d 69 64 20 73 74 61 p-run run-id sta
3500: 74 65 20 73 74 61 74 75 73 29 0a 20 20 28 72 6d te status). (rm
3510: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
3520: 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 set-state-status
3530: 2d 61 6e 64 2d 72 6f 6c 6c 2d 75 70 2d 72 75 6e -and-roll-up-run
3540: 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 run-id (list ru
3550: 6e 2d 69 64 20 73 74 61 74 65 20 73 74 61 74 75 n-id state statu
3560: 73 29 29 29 0a 0a 0a 28 64 65 66 69 6e 65 20 28 s)))...(define (
3570: 72 6d 74 3a 75 70 64 61 74 65 2d 70 61 73 73 2d rmt:update-pass-
3580: 66 61 69 6c 2d 63 6f 75 6e 74 73 20 72 75 6e 2d fail-counts run-
3590: 69 64 20 74 65 73 74 2d 6e 61 6d 65 29 0a 20 20 id test-name).
35a0: 28 72 6d 74 3a 67 65 6e 65 72 61 6c 2d 63 61 6c (rmt:general-cal
35b0: 6c 20 27 75 70 64 61 74 65 2d 70 61 73 73 2d 66 l 'update-pass-f
35c0: 61 69 6c 2d 63 6f 75 6e 74 73 20 72 75 6e 2d 69 ail-counts run-i
35d0: 64 20 74 65 73 74 2d 6e 61 6d 65 20 74 65 73 74 d test-name test
35e0: 2d 6e 61 6d 65 20 74 65 73 74 2d 6e 61 6d 65 29 -name test-name)
35f0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a )..(define (rmt:
3600: 74 6f 70 2d 74 65 73 74 2d 73 65 74 2d 70 65 72 top-test-set-per
3610: 2d 70 66 2d 63 6f 75 6e 74 73 20 72 75 6e 2d 69 -pf-counts run-i
3620: 64 20 74 65 73 74 2d 6e 61 6d 65 29 0a 20 20 28 d test-name). (
3630: 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 rmt:send-receive
3640: 20 27 74 6f 70 2d 74 65 73 74 2d 73 65 74 2d 70 'top-test-set-p
3650: 65 72 2d 70 66 2d 63 6f 75 6e 74 73 20 72 75 6e er-pf-counts run
3660: 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 -id (list run-id
3670: 20 74 65 73 74 2d 6e 61 6d 65 29 29 29 0a 0a 28 test-name)))..(
3680: 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d define (rmt:get-
3690: 72 61 77 2d 72 75 6e 2d 73 74 61 74 73 20 72 75 raw-run-stats ru
36a0: 6e 2d 69 64 29 0a 20 20 28 72 6d 74 3a 73 65 6e n-id). (rmt:sen
36b0: 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d 72 d-receive 'get-r
36c0: 61 77 2d 72 75 6e 2d 73 74 61 74 73 20 72 75 6e aw-run-stats run
36d0: 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 -id (list run-id
36e0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d )))..(define (rm
36f0: 74 3a 67 65 74 2d 74 65 73 74 2d 74 69 6d 65 73 t:get-test-times
3700: 20 72 75 6e 6e 61 6d 65 20 74 61 72 67 65 74 29 runname target)
3710: 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 . (rmt:send-rec
3720: 65 69 76 65 20 27 67 65 74 2d 74 65 73 74 2d 74 eive 'get-test-t
3730: 69 6d 65 73 20 23 66 20 28 6c 69 73 74 20 72 75 imes #f (list ru
3740: 6e 6e 61 6d 65 20 74 61 72 67 65 74 20 29 29 29 nname target )))
3750: 20 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;===========
3760: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3770: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3780: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3790: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 20 ===========.;;
37a0: 52 20 55 20 4e 20 53 0a 3b 3b 3d 3d 3d 3d 3d 3d R U N S.;;======
37b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
37c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
37d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
37e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
37f0: 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 ..(define (rmt:g
3800: 65 74 2d 72 75 6e 2d 69 6e 66 6f 20 72 75 6e 2d et-run-info run-
3810: 69 64 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d id). (rmt:send-
3820: 72 65 63 65 69 76 65 20 27 67 65 74 2d 72 75 6e receive 'get-run
3830: 2d 69 6e 66 6f 20 72 75 6e 2d 69 64 20 28 6c 69 -info run-id (li
3840: 73 74 20 72 75 6e 2d 69 64 29 29 29 0a 0a 28 64 st run-id)))..(d
3850: 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 6e efine (rmt:get-n
3860: 75 6d 2d 72 75 6e 73 20 72 75 6e 70 61 74 74 29 um-runs runpatt)
3870: 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 . (rmt:send-rec
3880: 65 69 76 65 20 27 67 65 74 2d 6e 75 6d 2d 72 75 eive 'get-num-ru
3890: 6e 73 20 23 66 20 28 6c 69 73 74 20 72 75 6e 70 ns #f (list runp
38a0: 61 74 74 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 att)))..(define
38b0: 28 72 6d 74 3a 67 65 74 2d 72 75 6e 73 2d 63 6e (rmt:get-runs-cn
38c0: 74 2d 62 79 2d 70 61 74 74 20 72 75 6e 70 61 74 t-by-patt runpat
38d0: 74 20 74 61 72 67 65 74 70 61 74 74 20 6b 65 79 t targetpatt key
38e0: 73 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 s). (rmt:send-r
38f0: 65 63 65 69 76 65 20 27 67 65 74 2d 72 75 6e 73 eceive 'get-runs
3900: 2d 63 6e 74 2d 62 79 2d 70 61 74 74 20 23 66 20 -cnt-by-patt #f
3910: 28 6c 69 73 74 20 72 75 6e 70 61 74 74 20 20 74 (list runpatt t
3920: 61 72 67 65 74 70 61 74 74 20 6b 65 79 73 29 29 argetpatt keys))
3930: 29 0a 0a 3b 3b 20 55 73 65 20 74 68 65 20 73 70 )..;; Use the sp
3940: 65 63 69 61 6c 20 72 75 6e 2d 69 64 20 3d 3d 20 ecial run-id ==
3950: 23 66 20 73 63 65 6e 61 72 69 6f 20 68 65 72 65 #f scenario here
3960: 20 73 69 6e 63 65 20 74 68 65 72 65 20 69 73 20 since there is
3970: 6e 6f 20 72 75 6e 20 79 65 74 0a 28 64 65 66 69 no run yet.(defi
3980: 6e 65 20 28 72 6d 74 3a 72 65 67 69 73 74 65 72 ne (rmt:register
3990: 2d 72 75 6e 20 6b 65 79 76 61 6c 73 20 72 75 6e -run keyvals run
39a0: 6e 61 6d 65 20 73 74 61 74 65 20 73 74 61 74 75 name state statu
39b0: 73 20 75 73 65 72 20 63 6f 6e 74 6f 75 72 29 0a s user contour).
39c0: 20 20 3b 3b 20 66 69 72 73 74 20 72 65 67 69 73 ;; first regis
39d0: 74 65 72 20 69 6e 20 6d 61 69 6e 2e 64 62 20 28 ter in main.db (
39e0: 74 68 75 73 20 74 68 65 20 23 66 29 0a 20 20 28 thus the #f). (
39f0: 6c 65 74 2a 20 28 28 72 75 6e 2d 69 64 20 28 72 let* ((run-id (r
3a00: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
3a10: 27 72 65 67 69 73 74 65 72 2d 72 75 6e 20 23 66 'register-run #f
3a20: 20 28 6c 69 73 74 20 6b 65 79 76 61 6c 73 20 72 (list keyvals r
3a30: 75 6e 6e 61 6d 65 20 73 74 61 74 65 20 73 74 61 unname state sta
3a40: 74 75 73 20 75 73 65 72 20 63 6f 6e 74 6f 75 72 tus user contour
3a50: 29 29 29 29 0a 20 20 20 20 3b 3b 20 6e 6f 77 20 )))). ;; now
3a60: 72 65 67 69 73 74 65 72 20 69 6e 20 74 68 65 20 register in the
3a70: 72 75 6e 20 64 62 20 69 74 73 65 6c 66 0a 0a 20 run db itself..
3a80: 20 20 20 3b 3b 20 4e 45 45 44 20 41 20 52 45 43 ;; NEED A REC
3a90: 4f 52 44 20 49 4e 53 45 52 54 20 49 4e 43 4c 55 ORD INSERT INCLU
3aa0: 44 49 4e 47 20 53 45 54 54 49 4e 47 20 69 64 0a DING SETTING id.
3ab0: 20 20 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 (rmt:send-re
3ac0: 63 65 69 76 65 20 27 69 6e 73 65 72 74 2d 72 75 ceive 'insert-ru
3ad0: 6e 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 n run-id (list r
3ae0: 75 6e 2d 69 64 20 6b 65 79 76 61 6c 73 20 72 75 un-id keyvals ru
3af0: 6e 6e 61 6d 65 20 73 74 61 74 65 20 73 74 61 74 nname state stat
3b00: 75 73 20 75 73 65 72 20 63 6f 6e 74 6f 75 72 29 us user contour)
3b10: 29 0a 20 20 20 20 72 75 6e 2d 69 64 29 29 0a 20 ). run-id)).
3b20: 20 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 .(define (rmt:g
3b30: 65 74 2d 72 75 6e 2d 6e 61 6d 65 2d 66 72 6f 6d et-run-name-from
3b40: 2d 69 64 20 72 75 6e 2d 69 64 29 0a 20 20 28 72 -id run-id). (r
3b50: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
3b60: 27 67 65 74 2d 72 75 6e 2d 6e 61 6d 65 2d 66 72 'get-run-name-fr
3b70: 6f 6d 2d 69 64 20 72 75 6e 2d 69 64 20 28 6c 69 om-id run-id (li
3b80: 73 74 20 72 75 6e 2d 69 64 29 29 29 0a 0a 28 64 st run-id)))..(d
3b90: 65 66 69 6e 65 20 28 72 6d 74 3a 64 65 6c 65 74 efine (rmt:delet
3ba0: 65 2d 72 75 6e 20 72 75 6e 2d 69 64 29 0a 20 20 e-run run-id).
3bb0: 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 (rmt:send-receiv
3bc0: 65 20 27 64 65 6c 65 74 65 2d 72 75 6e 20 72 75 e 'delete-run ru
3bd0: 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 n-id (list run-i
3be0: 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 d)))..(define (r
3bf0: 6d 74 3a 75 70 64 61 74 65 2d 72 75 6e 2d 73 74 mt:update-run-st
3c00: 61 74 73 20 72 75 6e 2d 69 64 20 73 74 61 74 73 ats run-id stats
3c10: 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 ). (rmt:send-re
3c20: 63 65 69 76 65 20 27 75 70 64 61 74 65 2d 72 75 ceive 'update-ru
3c30: 6e 2d 73 74 61 74 73 20 23 66 20 28 6c 69 73 74 n-stats #f (list
3c40: 20 72 75 6e 2d 69 64 20 73 74 61 74 73 29 29 29 run-id stats)))
3c50: 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 64 ..(define (rmt:d
3c60: 65 6c 65 74 65 2d 6f 6c 64 2d 64 65 6c 65 74 65 elete-old-delete
3c70: 64 2d 74 65 73 74 2d 72 65 63 6f 72 64 73 29 0a d-test-records).
3c80: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
3c90: 69 76 65 20 27 64 65 6c 65 74 65 2d 6f 6c 64 2d ive 'delete-old-
3ca0: 64 65 6c 65 74 65 64 2d 74 65 73 74 2d 72 65 63 deleted-test-rec
3cb0: 6f 72 64 73 20 23 66 20 27 28 29 29 29 0a 0a 28 ords #f '()))..(
3cc0: 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d define (rmt:get-
3cd0: 72 75 6e 73 20 72 75 6e 70 61 74 74 20 63 6f 75 runs runpatt cou
3ce0: 6e 74 20 6f 66 66 73 65 74 20 6b 65 79 70 61 74 nt offset keypat
3cf0: 74 73 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d ts). (rmt:send-
3d00: 72 65 63 65 69 76 65 20 27 67 65 74 2d 72 75 6e receive 'get-run
3d10: 73 20 23 66 20 28 6c 69 73 74 20 72 75 6e 70 61 s #f (list runpa
3d20: 74 74 20 63 6f 75 6e 74 20 6f 66 66 73 65 74 20 tt count offset
3d30: 6b 65 79 70 61 74 74 73 29 29 29 0a 0a 28 64 65 keypatts)))..(de
3d40: 66 69 6e 65 20 28 72 6d 74 3a 73 69 6d 70 6c 65 fine (rmt:simple
3d50: 2d 67 65 74 2d 72 75 6e 73 20 72 75 6e 70 61 74 -get-runs runpat
3d60: 74 20 63 6f 75 6e 74 20 6f 66 66 73 65 74 20 74 t count offset t
3d70: 61 72 67 65 74 20 6c 61 73 74 2d 75 70 64 61 74 arget last-updat
3d80: 65 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 e). (rmt:send-r
3d90: 65 63 65 69 76 65 20 27 73 69 6d 70 6c 65 2d 67 eceive 'simple-g
3da0: 65 74 2d 72 75 6e 73 20 23 66 20 28 6c 69 73 74 et-runs #f (list
3db0: 20 72 75 6e 70 61 74 74 20 63 6f 75 6e 74 20 6f runpatt count o
3dc0: 66 66 73 65 74 20 74 61 72 67 65 74 20 6c 61 73 ffset target las
3dd0: 74 2d 75 70 64 61 74 65 29 29 29 0a 0a 28 64 65 t-update)))..(de
3de0: 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 61 6c fine (rmt:get-al
3df0: 6c 2d 72 75 6e 2d 69 64 73 29 0a 20 20 28 72 6d l-run-ids). (rm
3e00: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
3e10: 67 65 74 2d 61 6c 6c 2d 72 75 6e 2d 69 64 73 20 get-all-run-ids
3e20: 23 66 20 27 28 29 29 29 0a 0a 28 64 65 66 69 6e #f '()))..(defin
3e30: 65 20 28 72 6d 74 3a 67 65 74 2d 70 72 65 76 2d e (rmt:get-prev-
3e40: 72 75 6e 2d 69 64 73 20 72 75 6e 2d 69 64 29 0a run-ids run-id).
3e50: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
3e60: 69 76 65 20 27 67 65 74 2d 70 72 65 76 2d 72 75 ive 'get-prev-ru
3e70: 6e 2d 69 64 73 20 23 66 20 28 6c 69 73 74 20 72 n-ids #f (list r
3e80: 75 6e 2d 69 64 29 29 29 0a 0a 28 64 65 66 69 6e un-id)))..(defin
3e90: 65 20 28 72 6d 74 3a 6c 6f 63 6b 2f 75 6e 6c 6f e (rmt:lock/unlo
3ea0: 63 6b 2d 72 75 6e 20 72 75 6e 2d 69 64 20 6c 6f ck-run run-id lo
3eb0: 63 6b 20 75 6e 6c 6f 63 6b 20 75 73 65 72 29 0a ck unlock user).
3ec0: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
3ed0: 69 76 65 20 27 6c 6f 63 6b 2f 75 6e 6c 6f 63 6b ive 'lock/unlock
3ee0: 2d 72 75 6e 20 23 66 20 28 6c 69 73 74 20 72 75 -run #f (list ru
3ef0: 6e 2d 69 64 20 6c 6f 63 6b 20 75 6e 6c 6f 63 6b n-id lock unlock
3f00: 20 75 73 65 72 29 29 29 0a 0a 3b 3b 20 73 65 74 user)))..;; set
3f10: 2f 67 65 74 20 73 74 61 74 75 73 0a 28 64 65 66 /get status.(def
3f20: 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e ine (rmt:get-run
3f30: 2d 73 74 61 74 75 73 20 72 75 6e 2d 69 64 29 0a -status run-id).
3f40: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
3f50: 69 76 65 20 27 67 65 74 2d 72 75 6e 2d 73 74 61 ive 'get-run-sta
3f60: 74 75 73 20 23 66 20 28 6c 69 73 74 20 72 75 6e tus #f (list run
3f70: 2d 69 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 -id)))..(define
3f80: 28 72 6d 74 3a 67 65 74 2d 72 75 6e 2d 73 74 61 (rmt:get-run-sta
3f90: 74 65 20 72 75 6e 2d 69 64 29 0a 20 20 28 72 6d te run-id). (rm
3fa0: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
3fb0: 67 65 74 2d 72 75 6e 2d 73 74 61 74 65 20 23 66 get-run-state #f
3fc0: 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 29 29 29 (list run-id)))
3fd0: 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 73 ..(define (rmt:s
3fe0: 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 20 72 75 et-run-status ru
3ff0: 6e 2d 69 64 20 72 75 6e 2d 73 74 61 74 75 73 20 n-id run-status
4000: 23 21 6b 65 79 20 28 6d 73 67 20 23 66 29 29 0a #!key (msg #f)).
4010: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
4020: 69 76 65 20 27 73 65 74 2d 72 75 6e 2d 73 74 61 ive 'set-run-sta
4030: 74 75 73 20 23 66 20 28 6c 69 73 74 20 72 75 6e tus #f (list run
4040: 2d 69 64 20 72 75 6e 2d 73 74 61 74 75 73 20 6d -id run-status m
4050: 73 67 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 sg)))..(define (
4060: 72 6d 74 3a 73 65 74 2d 72 75 6e 2d 73 74 61 74 rmt:set-run-stat
4070: 65 2d 73 74 61 74 75 73 20 72 75 6e 2d 69 64 20 e-status run-id
4080: 73 74 61 74 65 20 73 74 61 74 75 73 20 29 0a 20 state status ).
4090: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
40a0: 76 65 20 27 73 65 74 2d 72 75 6e 2d 73 74 61 74 ve 'set-run-stat
40b0: 65 2d 73 74 61 74 75 73 20 23 66 20 28 6c 69 73 e-status #f (lis
40c0: 74 20 72 75 6e 2d 69 64 20 73 74 61 74 65 20 73 t run-id state s
40d0: 74 61 74 75 73 29 29 29 0a 0a 28 64 65 66 69 6e tatus)))..(defin
40e0: 65 20 28 72 6d 74 3a 75 70 64 61 74 65 2d 74 65 e (rmt:update-te
40f0: 73 64 61 74 61 2d 6f 6e 2d 72 65 70 69 6c 63 61 sdata-on-repilca
4100: 74 65 2d 64 62 20 6f 6c 64 2d 6c 74 20 6e 65 77 te-db old-lt new
4110: 2d 6c 74 29 0a 28 72 6d 74 3a 73 65 6e 64 2d 72 -lt).(rmt:send-r
4120: 65 63 65 69 76 65 20 27 75 70 64 61 74 65 2d 74 eceive 'update-t
4130: 65 73 64 61 74 61 2d 6f 6e 2d 72 65 70 69 6c 63 esdata-on-repilc
4140: 61 74 65 2d 64 62 20 23 66 20 28 6c 69 73 74 20 ate-db #f (list
4150: 6f 6c 64 2d 6c 74 20 6e 65 77 2d 6c 74 29 29 29 old-lt new-lt)))
4160: 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 75 ..(define (rmt:u
4170: 70 64 61 74 65 2d 72 75 6e 2d 65 76 65 6e 74 5f pdate-run-event_
4180: 74 69 6d 65 20 72 75 6e 2d 69 64 29 0a 20 20 28 time run-id). (
4190: 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 rmt:send-receive
41a0: 20 27 75 70 64 61 74 65 2d 72 75 6e 2d 65 76 65 'update-run-eve
41b0: 6e 74 5f 74 69 6d 65 20 23 66 20 28 6c 69 73 74 nt_time #f (list
41c0: 20 72 75 6e 2d 69 64 29 29 29 0a 0a 28 64 65 66 run-id)))..(def
41d0: 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e ine (rmt:get-run
41e0: 73 2d 62 79 2d 70 61 74 74 20 20 6b 65 79 73 20 s-by-patt keys
41f0: 72 75 6e 6e 61 6d 65 70 61 74 74 20 74 61 72 67 runnamepatt targ
4200: 70 61 74 74 20 6f 66 66 73 65 74 20 6c 69 6d 69 patt offset limi
4210: 74 20 66 69 65 6c 64 73 20 6c 61 73 74 2d 72 75 t fields last-ru
4220: 6e 73 2d 75 70 64 61 74 65 20 20 23 21 6b 65 79 ns-update #!key
4230: 20 20 28 73 6f 72 74 2d 6f 72 64 65 72 20 22 61 (sort-order "a
4240: 73 63 22 29 29 20 3b 3b 20 66 69 65 6c 64 73 20 sc")) ;; fields
4250: 6f 66 20 23 66 20 75 73 65 73 20 64 65 66 61 75 of #f uses defau
4260: 6c 74 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 lt. (rmt:send-r
4270: 65 63 65 69 76 65 20 27 67 65 74 2d 72 75 6e 73 eceive 'get-runs
4280: 2d 62 79 2d 70 61 74 74 20 23 66 20 28 6c 69 73 -by-patt #f (lis
4290: 74 20 6b 65 79 73 20 72 75 6e 6e 61 6d 65 70 61 t keys runnamepa
42a0: 74 74 20 74 61 72 67 70 61 74 74 20 6f 66 66 73 tt targpatt offs
42b0: 65 74 20 6c 69 6d 69 74 20 66 69 65 6c 64 73 20 et limit fields
42c0: 6c 61 73 74 2d 72 75 6e 73 2d 75 70 64 61 74 65 last-runs-update
42d0: 20 73 6f 72 74 2d 6f 72 64 65 72 29 29 29 0a 0a sort-order)))..
42e0: 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 66 69 6e (define (rmt:fin
42f0: 64 2d 61 6e 64 2d 6d 61 72 6b 2d 69 6e 63 6f 6d d-and-mark-incom
4300: 70 6c 65 74 65 20 72 75 6e 2d 69 64 20 6f 76 72 plete run-id ovr
4310: 2d 64 65 61 64 74 69 6d 65 29 0a 20 20 3b 3b 20 -deadtime). ;;
4320: 28 69 66 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 (if (rmt:send-re
4330: 63 65 69 76 65 20 27 68 61 76 65 2d 69 6e 63 6f ceive 'have-inco
4340: 6d 70 6c 65 74 65 73 3f 20 72 75 6e 2d 69 64 20 mpletes? run-id
4350: 28 6c 69 73 74 20 72 75 6e 2d 69 64 20 6f 76 72 (list run-id ovr
4360: 2d 64 65 61 64 74 69 6d 65 29 29 0a 20 20 28 72 -deadtime)). (r
4370: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
4380: 27 6d 61 72 6b 2d 69 6e 63 6f 6d 70 6c 65 74 65 'mark-incomplete
4390: 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 run-id (list ru
43a0: 6e 2d 69 64 20 6f 76 72 2d 64 65 61 64 74 69 6d n-id ovr-deadtim
43b0: 65 29 29 0a 20 20 29 20 3b 3b 20 29 0a 0a 28 64 e)). ) ;; )..(d
43c0: 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 6d efine (rmt:get-m
43d0: 61 69 6e 2d 72 75 6e 2d 73 74 61 74 73 20 72 75 ain-run-stats ru
43e0: 6e 2d 69 64 29 0a 20 20 28 72 6d 74 3a 73 65 6e n-id). (rmt:sen
43f0: 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d 6d d-receive 'get-m
4400: 61 69 6e 2d 72 75 6e 2d 73 74 61 74 73 20 23 66 ain-run-stats #f
4410: 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 29 29 29 (list run-id)))
4420: 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 6c ..(define (rmt:l
4430: 6f 67 2d 74 6f 2d 6d 61 69 6e 20 2e 20 70 61 72 og-to-main . par
4440: 61 6d 73 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 ams). (rmt:send
4450: 2d 72 65 63 65 69 76 65 20 27 6c 6f 67 2d 74 6f -receive 'log-to
4460: 2d 6d 61 69 6e 20 23 66 20 70 61 72 61 6d 73 29 -main #f params)
4470: 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a )..(define (rmt:
4480: 67 65 74 2d 76 61 72 20 72 75 6e 2d 69 64 20 76 get-var run-id v
4490: 61 72 6e 61 6d 65 29 0a 20 20 28 72 6d 74 3a 73 arname). (rmt:s
44a0: 65 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 end-receive 'get
44b0: 2d 76 61 72 20 72 75 6e 2d 69 64 20 28 6c 69 73 -var run-id (lis
44c0: 74 20 72 75 6e 2d 69 64 20 76 61 72 6e 61 6d 65 t run-id varname
44d0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d )))..(define (rm
44e0: 74 3a 64 65 6c 2d 76 61 72 20 72 75 6e 2d 69 64 t:del-var run-id
44f0: 20 76 61 72 6e 61 6d 65 29 0a 20 20 28 72 6d 74 varname). (rmt
4500: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 64 :send-receive 'd
4510: 65 6c 2d 76 61 72 20 72 75 6e 2d 69 64 20 28 6c el-var run-id (l
4520: 69 73 74 20 72 75 6e 2d 69 64 20 76 61 72 6e 61 ist run-id varna
4530: 6d 65 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 me)))..(define (
4540: 72 6d 74 3a 73 65 74 2d 76 61 72 20 72 75 6e 2d rmt:set-var run-
4550: 69 64 20 76 61 72 6e 61 6d 65 20 76 61 6c 75 65 id varname value
4560: 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 ). (rmt:send-re
4570: 63 65 69 76 65 20 27 73 65 74 2d 76 61 72 20 72 ceive 'set-var r
4580: 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d un-id (list run-
4590: 69 64 20 76 61 72 6e 61 6d 65 20 76 61 6c 75 65 id varname value
45a0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d )))..(define (rm
45b0: 74 3a 69 6e 63 2d 76 61 72 20 72 75 6e 2d 69 64 t:inc-var run-id
45c0: 20 76 61 72 6e 61 6d 65 29 0a 20 20 28 72 6d 74 varname). (rmt
45d0: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 69 :send-receive 'i
45e0: 6e 63 2d 76 61 72 20 23 66 20 28 6c 69 73 74 20 nc-var #f (list
45f0: 72 75 6e 2d 69 64 20 76 61 72 6e 61 6d 65 29 29 run-id varname))
4600: 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a )..(define (rmt:
4610: 64 65 63 2d 76 61 72 20 72 75 6e 2d 69 64 20 76 dec-var run-id v
4620: 61 72 6e 61 6d 65 29 0a 20 20 28 72 6d 74 3a 73 arname). (rmt:s
4630: 65 6e 64 2d 72 65 63 65 69 76 65 20 27 64 65 63 end-receive 'dec
4640: 2d 76 61 72 20 72 75 6e 2d 69 64 20 28 6c 69 73 -var run-id (lis
4650: 74 20 72 75 6e 2d 69 64 20 76 61 72 6e 61 6d 65 t run-id varname
4660: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d )))..(define (rm
4670: 74 3a 61 64 64 2d 76 61 72 20 72 75 6e 2d 69 64 t:add-var run-id
4680: 20 76 61 72 6e 61 6d 65 20 76 61 6c 75 65 29 0a varname value).
4690: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
46a0: 69 76 65 20 27 61 64 64 2d 76 61 72 20 72 75 6e ive 'add-var run
46b0: 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 -id (list run-id
46c0: 20 76 61 72 6e 61 6d 65 20 76 61 6c 75 65 29 29 varname value))
46d0: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
46e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
46f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4700: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4710: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4d ===========.;; M
4720: 20 55 20 4c 20 54 20 49 20 52 20 55 20 4e 20 20 U L T I R U N
4730: 20 51 20 55 20 45 20 52 20 49 20 45 20 53 0a 3b Q U E R I E S.;
4740: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
4750: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4760: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4770: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4780: 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 4e 65 65 64 =======..;; Need
4790: 20 74 6f 20 6d 6f 76 65 20 74 68 69 73 20 74 6f to move this to
47a0: 20 6d 75 6c 74 69 2d 72 75 6e 20 73 65 63 74 69 multi-run secti
47b0: 6f 6e 20 61 6e 64 20 6d 61 6b 65 20 61 73 73 6f on and make asso
47c0: 63 69 61 74 65 64 20 63 68 61 6e 67 65 73 0a 28 ciated changes.(
47d0: 64 65 66 69 6e 65 20 28 72 6d 74 3a 66 69 6e 64 define (rmt:find
47e0: 2d 61 6e 64 2d 6d 61 72 6b 2d 69 6e 63 6f 6d 70 -and-mark-incomp
47f0: 6c 65 74 65 2d 61 6c 6c 2d 72 75 6e 73 20 23 21 lete-all-runs #!
4800: 6b 65 79 20 28 6f 76 72 2d 64 65 61 64 74 69 6d key (ovr-deadtim
4810: 65 20 23 66 29 29 0a 20 20 28 6c 65 74 20 28 28 e #f)). (let ((
4820: 72 75 6e 2d 69 64 73 20 28 72 6d 74 3a 67 65 74 run-ids (rmt:get
4830: 2d 61 6c 6c 2d 72 75 6e 2d 69 64 73 29 29 29 0a -all-run-ids))).
4840: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c (for-each (l
4850: 61 6d 62 64 61 20 28 72 75 6e 2d 69 64 29 0a 09 ambda (run-id)..
4860: 20 20 20 20 20 20 20 28 72 6d 74 3a 66 69 6e 64 (rmt:find
4870: 2d 61 6e 64 2d 6d 61 72 6b 2d 69 6e 63 6f 6d 70 -and-mark-incomp
4880: 6c 65 74 65 20 72 75 6e 2d 69 64 20 6f 76 72 2d lete run-id ovr-
4890: 64 65 61 64 74 69 6d 65 29 29 0a 09 20 20 20 20 deadtime))..
48a0: 20 72 75 6e 2d 69 64 73 29 29 29 0a 0a 3b 3b 20 run-ids)))..;;
48b0: 67 65 74 20 74 68 65 20 70 72 65 76 69 6f 75 73 get the previous
48c0: 20 72 65 63 6f 72 64 20 66 6f 72 20 77 68 65 6e record for when
48d0: 20 74 68 69 73 20 74 65 73 74 20 77 61 73 20 72 this test was r
48e0: 75 6e 20 77 68 65 72 65 20 61 6c 6c 20 6b 65 79 un where all key
48f0: 73 20 6d 61 74 63 68 20 62 75 74 20 72 75 6e 6e s match but runn
4900: 61 6d 65 0a 3b 3b 20 72 65 74 75 72 6e 73 20 23 ame.;; returns #
4910: 66 20 69 66 20 6e 6f 20 73 75 63 68 20 74 65 73 f if no such tes
4920: 74 20 66 6f 75 6e 64 2c 20 72 65 74 75 72 6e 73 t found, returns
4930: 20 61 20 73 69 6e 67 6c 65 20 74 65 73 74 20 72 a single test r
4940: 65 63 6f 72 64 20 69 66 20 66 6f 75 6e 64 0a 3b ecord if found.;
4950: 3b 20 0a 3b 3b 20 52 75 6e 20 74 68 69 73 20 61 ; .;; Run this a
4960: 74 20 74 68 65 20 63 6c 69 65 6e 74 20 65 6e 64 t the client end
4970: 20 73 69 6e 63 65 20 77 65 20 68 61 76 65 20 74 since we have t
4980: 6f 20 63 6f 6e 6e 65 63 74 20 74 6f 20 6d 75 6c o connect to mul
4990: 74 69 70 6c 65 20 72 75 6e 2d 69 64 20 64 62 73 tiple run-id dbs
49a0: 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 .;;.(define (rmt
49b0: 3a 67 65 74 2d 70 72 65 76 69 6f 75 73 2d 74 65 :get-previous-te
49c0: 73 74 2d 72 75 6e 2d 72 65 63 6f 72 64 20 72 75 st-run-record ru
49d0: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 n-id test-name i
49e0: 74 65 6d 2d 70 61 74 68 29 0a 20 20 28 6c 65 74 tem-path). (let
49f0: 2a 20 28 28 6b 65 79 76 61 6c 73 20 28 72 6d 74 * ((keyvals (rmt
4a00: 3a 67 65 74 2d 6b 65 79 2d 76 61 6c 2d 70 61 69 :get-key-val-pai
4a10: 72 73 20 72 75 6e 2d 69 64 29 29 0a 09 20 28 6b rs run-id)).. (k
4a20: 65 79 73 20 20 20 20 28 72 6d 74 3a 67 65 74 2d eys (rmt:get-
4a30: 6b 65 79 73 29 29 0a 09 20 28 73 65 6c 73 74 72 keys)).. (selstr
4a40: 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 (string-inters
4a50: 70 65 72 73 65 20 20 6b 65 79 73 20 22 2c 22 29 perse keys ",")
4a60: 29 0a 09 20 28 71 72 79 73 74 72 20 20 28 73 74 ).. (qrystr (st
4a70: 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse
4a80: 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 78 (map (lambda (x
4a90: 29 28 63 6f 6e 63 20 78 20 22 3d 3f 22 29 29 20 )(conc x "=?"))
4aa0: 6b 65 79 73 29 20 22 20 41 4e 44 20 22 29 29 29 keys) " AND ")))
4ab0: 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 6b 65 . (if (not ke
4ac0: 79 76 61 6c 73 29 0a 09 23 66 0a 09 28 6c 65 74 yvals)..#f..(let
4ad0: 20 28 28 70 72 65 76 2d 72 75 6e 2d 69 64 73 20 ((prev-run-ids
4ae0: 28 72 6d 74 3a 67 65 74 2d 70 72 65 76 2d 72 75 (rmt:get-prev-ru
4af0: 6e 2d 69 64 73 20 72 75 6e 2d 69 64 29 29 29 0a n-ids run-id))).
4b00: 09 20 20 3b 3b 20 66 6f 72 20 65 61 63 68 20 72 . ;; for each r
4b10: 75 6e 20 73 74 61 72 74 69 6e 67 20 77 69 74 68 un starting with
4b20: 20 74 68 65 20 6d 6f 73 74 20 72 65 63 65 6e 74 the most recent
4b30: 20 6c 6f 6f 6b 20 74 6f 20 73 65 65 20 69 66 20 look to see if
4b40: 74 68 65 72 65 20 69 73 20 61 20 6d 61 74 63 68 there is a match
4b50: 69 6e 67 20 74 65 73 74 0a 09 20 20 3b 3b 20 69 ing test.. ;; i
4b60: 66 20 66 6f 75 6e 64 20 74 68 65 6e 20 72 65 74 f found then ret
4b70: 75 72 6e 20 74 68 61 74 20 6d 61 74 63 68 69 6e urn that matchin
4b80: 67 20 74 65 73 74 20 72 65 63 6f 72 64 0a 09 20 g test record..
4b90: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 (debug:print 4
4ba0: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
4bb0: 74 2a 20 22 73 65 6c 73 74 72 3a 20 22 20 73 65 t* "selstr: " se
4bc0: 6c 73 74 72 20 22 2c 20 71 72 79 73 74 72 3a 20 lstr ", qrystr:
4bd0: 22 20 71 72 79 73 74 72 20 22 2c 20 6b 65 79 76 " qrystr ", keyv
4be0: 61 6c 73 3a 20 22 20 6b 65 79 76 61 6c 73 20 22 als: " keyvals "
4bf0: 2c 20 70 72 65 76 69 6f 75 73 20 72 75 6e 20 69 , previous run i
4c00: 64 73 20 66 6f 75 6e 64 3a 20 22 20 70 72 65 76 ds found: " prev
4c10: 2d 72 75 6e 2d 69 64 73 29 0a 09 20 20 28 69 66 -run-ids).. (if
4c20: 20 28 6e 75 6c 6c 3f 20 70 72 65 76 2d 72 75 6e (null? prev-run
4c30: 2d 69 64 73 29 20 23 66 0a 09 20 20 20 20 20 20 -ids) #f..
4c40: 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 20 (let loop ((hed
4c50: 28 63 61 72 20 70 72 65 76 2d 72 75 6e 2d 69 64 (car prev-run-id
4c60: 73 29 29 0a 09 09 09 20 28 74 61 6c 20 28 63 64 s)).... (tal (cd
4c70: 72 20 70 72 65 76 2d 72 75 6e 2d 69 64 73 29 29 r prev-run-ids))
4c80: 29 0a 09 09 28 6c 65 74 20 28 28 72 65 73 75 6c )...(let ((resul
4c90: 74 73 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 ts (rmt:get-test
4ca0: 73 2d 66 6f 72 2d 72 75 6e 20 68 65 64 20 28 63 s-for-run hed (c
4cb0: 6f 6e 63 20 74 65 73 74 2d 6e 61 6d 65 20 22 2f onc test-name "/
4cc0: 22 20 69 74 65 6d 2d 70 61 74 68 29 20 27 28 29 " item-path) '()
4cd0: 20 27 28 29 20 3b 3b 20 72 75 6e 2d 69 64 20 74 '() ;; run-id t
4ce0: 65 73 74 70 61 74 74 20 73 74 61 74 65 73 20 73 estpatt states s
4cf0: 74 61 74 75 73 65 73 0a 09 09 09 09 09 09 20 20 tatuses.......
4d00: 20 20 20 20 23 66 20 23 66 20 23 66 20 20 20 20 #f #f #f
4d10: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 6f 66 ;; of
4d20: 66 73 65 74 20 6c 69 6d 69 74 20 6e 6f 74 2d 69 fset limit not-i
4d30: 6e 20 68 69 64 65 2f 6e 6f 74 2d 68 69 64 65 0a n hide/not-hide.
4d40: 09 09 09 09 09 09 20 20 20 20 20 20 23 66 20 23 ...... #f #
4d50: 66 20 23 66 20 23 66 20 27 6e 6f 72 6d 61 6c 29 f #f #f 'normal)
4d60: 29 29 20 3b 3b 20 73 6f 72 74 2d 62 79 20 73 6f )) ;; sort-by so
4d70: 72 74 2d 6f 72 64 65 72 20 71 72 79 76 61 6c 73 rt-order qryvals
4d80: 20 6c 61 73 74 2d 75 70 64 61 74 65 20 6d 6f 64 last-update mod
4d90: 65 0a 09 09 20 20 28 64 65 62 75 67 3a 70 72 69 e... (debug:pri
4da0: 6e 74 20 34 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 4 *default-lo
4db0: 67 2d 70 6f 72 74 2a 20 22 47 6f 74 20 74 65 73 g-port* "Got tes
4dc0: 74 73 20 66 6f 72 20 72 75 6e 2d 69 64 20 22 20 ts for run-id "
4dd0: 72 75 6e 2d 69 64 20 22 2c 20 74 65 73 74 2d 6e run-id ", test-n
4de0: 61 6d 65 20 22 20 74 65 73 74 2d 6e 61 6d 65 20 ame " test-name
4df0: 22 2c 20 69 74 65 6d 2d 70 61 74 68 20 22 20 69 ", item-path " i
4e00: 74 65 6d 2d 70 61 74 68 20 22 3a 20 22 20 72 65 tem-path ": " re
4e10: 73 75 6c 74 73 29 0a 09 09 20 20 28 69 66 20 28 sults)... (if (
4e20: 61 6e 64 20 28 6e 75 6c 6c 3f 20 72 65 73 75 6c and (null? resul
4e30: 74 73 29 0a 09 09 09 20 20 20 28 6e 6f 74 20 28 ts).... (not (
4e40: 6e 75 6c 6c 3f 20 74 61 6c 29 29 29 0a 09 09 20 null? tal)))...
4e50: 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 (loop (car
4e60: 74 61 6c 29 28 63 64 72 20 74 61 6c 29 29 0a 09 tal)(cdr tal))..
4e70: 09 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c . (if (null
4e80: 3f 20 72 65 73 75 6c 74 73 29 20 23 66 0a 09 09 ? results) #f...
4e90: 09 20 20 28 63 61 72 20 72 65 73 75 6c 74 73 29 . (car results)
4ea0: 29 29 29 29 29 29 29 29 29 0a 0a 28 64 65 66 69 )))))))))..(defi
4eb0: 6e 65 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e 2d ne (rmt:get-run-
4ec0: 73 74 61 74 73 29 0a 20 20 28 72 6d 74 3a 73 65 stats). (rmt:se
4ed0: 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d nd-receive 'get-
4ee0: 72 75 6e 2d 73 74 61 74 73 20 23 66 20 27 28 29 run-stats #f '()
4ef0: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
4f00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4f10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4f20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4f30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
4f40: 20 53 20 54 20 45 20 50 20 53 0a 3b 3b 3d 3d 3d S T E P S.;;===
4f50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4f60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4f70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4f80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4f90: 3d 3d 3d 0a 0a 3b 3b 20 47 65 74 74 69 6e 67 20 ===..;; Getting
4fa0: 73 74 65 70 73 20 69 73 20 6d 6f 72 65 20 63 6f steps is more co
4fb0: 6d 70 6c 69 63 61 74 65 64 2e 0a 3b 3b 0a 3b 3b mplicated..;;.;;
4fc0: 20 49 66 20 67 69 76 65 6e 20 77 6f 72 6b 20 61 If given work a
4fd0: 72 65 61 20 0a 3b 3b 20 20 31 2e 20 46 69 6e 64 rea .;; 1. Find
4fe0: 20 74 68 65 20 74 65 73 74 64 61 74 2e 64 62 20 the testdat.db
4ff0: 66 69 6c 65 0a 3b 3b 20 20 32 2e 20 4f 70 65 6e file.;; 2. Open
5000: 20 74 68 65 20 74 65 73 74 64 61 74 2e 64 62 20 the testdat.db
5010: 66 69 6c 65 20 61 6e 64 20 64 6f 20 74 68 65 20 file and do the
5020: 71 75 65 72 79 0a 3b 3b 20 49 66 20 6e 6f 74 20 query.;; If not
5030: 67 69 76 65 6e 20 74 68 65 20 77 6f 72 6b 20 61 given the work a
5040: 72 65 61 0a 3b 3b 20 20 31 2e 20 44 6f 20 61 20 rea.;; 1. Do a
5050: 72 65 6d 6f 74 65 20 63 61 6c 6c 20 74 6f 20 67 remote call to g
5060: 65 74 20 74 68 65 20 74 65 73 74 20 70 61 74 68 et the test path
5070: 0a 3b 3b 20 20 32 2e 20 43 6f 6e 74 69 6e 75 65 .;; 2. Continue
5080: 20 61 73 20 61 62 6f 76 65 0a 3b 3b 20 0a 3b 3b as above.;; .;;
5090: 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 (define (rmt:get
50a0: 2d 73 74 65 70 73 2d 66 6f 72 2d 74 65 73 74 20 -steps-for-test
50b0: 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 0a run-id test-id).
50c0: 3b 3b 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 ;; (rmt:send-re
50d0: 63 65 69 76 65 20 27 67 65 74 2d 73 74 65 70 73 ceive 'get-steps
50e0: 2d 64 61 74 61 20 72 75 6e 2d 69 64 20 28 6c 69 -data run-id (li
50f0: 73 74 20 74 65 73 74 2d 69 64 29 29 29 0a 0a 28 st test-id)))..(
5100: 64 65 66 69 6e 65 20 28 72 6d 74 3a 74 65 73 74 define (rmt:test
5110: 73 74 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 step-set-status!
5120: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 run-id test-id
5130: 74 65 73 74 73 74 65 70 2d 6e 61 6d 65 20 73 74 teststep-name st
5140: 61 74 65 2d 69 6e 20 73 74 61 74 75 73 2d 69 6e ate-in status-in
5150: 20 63 6f 6d 6d 65 6e 74 20 6c 6f 67 66 69 6c 65 comment logfile
5160: 29 0a 20 20 28 6c 65 74 2a 20 28 28 76 61 6c 69 ). (let* ((vali
5170: 64 2d 76 61 6c 75 65 73 20 28 63 6f 6e 66 69 67 d-values (config
5180: 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 f:lookup *config
5190: 64 61 74 2a 20 22 76 61 6c 69 64 76 61 6c 75 65 dat* "validvalue
51a0: 73 22 20 22 73 74 61 74 65 22 29 29 0a 09 20 28 s" "state")).. (
51b0: 73 74 61 74 65 20 20 20 20 20 20 20 20 28 69 74 state (it
51c0: 65 6d 73 3a 63 68 65 63 6b 2d 76 61 6c 69 64 2d ems:check-valid-
51d0: 69 74 65 6d 73 20 76 61 6c 69 64 2d 76 61 6c 75 items valid-valu
51e0: 65 73 20 22 73 74 61 74 65 22 20 73 74 61 74 65 es "state" state
51f0: 2d 69 6e 29 29 0a 09 20 28 73 74 61 74 75 73 20 -in)).. (status
5200: 20 20 20 20 20 20 28 69 74 65 6d 73 3a 63 68 65 (items:che
5210: 63 6b 2d 76 61 6c 69 64 2d 69 74 65 6d 73 20 76 ck-valid-items v
5220: 61 6c 69 64 2d 76 61 6c 75 65 73 20 22 73 74 61 alid-values "sta
5230: 74 75 73 22 20 73 74 61 74 75 73 2d 69 6e 29 29 tus" status-in))
5240: 29 0a 20 20 20 20 28 69 66 20 28 6f 72 20 28 6e ). (if (or (n
5250: 6f 74 20 73 74 61 74 65 29 28 6e 6f 74 20 73 74 ot state)(not st
5260: 61 74 75 73 29 29 0a 09 28 64 65 62 75 67 3a 70 atus))..(debug:p
5270: 72 69 6e 74 20 33 20 2a 64 65 66 61 75 6c 74 2d rint 3 *default-
5280: 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 log-port* "WARNI
5290: 4e 47 3a 20 49 6e 76 61 6c 69 64 20 22 20 28 69 NG: Invalid " (i
52a0: 66 20 73 74 61 74 75 73 20 22 73 74 61 74 75 73 f status "status
52b0: 22 20 22 73 74 61 74 65 22 29 0a 09 09 20 20 20 " "state")...
52c0: 20 20 22 20 76 61 6c 75 65 20 5c 22 22 20 28 69 " value \"" (i
52d0: 66 20 73 74 61 74 75 73 20 73 74 61 74 65 2d 69 f status state-i
52e0: 6e 20 73 74 61 74 75 73 2d 69 6e 29 20 22 5c 22 n status-in) "\"
52f0: 2c 20 75 70 64 61 74 65 20 79 6f 75 72 20 76 61 , update your va
5300: 6c 69 64 76 61 6c 75 65 73 20 73 65 63 74 69 6f lidvalues sectio
5310: 6e 20 69 6e 20 6d 65 67 61 74 65 73 74 2e 63 6f n in megatest.co
5320: 6e 66 69 67 22 29 29 0a 20 20 20 20 28 72 6d 74 nfig")). (rmt
5330: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 74 :send-receive 't
5340: 65 73 74 73 74 65 70 2d 73 65 74 2d 73 74 61 74 eststep-set-stat
5350: 75 73 21 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 us! run-id (list
5360: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 run-id test-id
5370: 74 65 73 74 73 74 65 70 2d 6e 61 6d 65 20 73 74 teststep-name st
5380: 61 74 65 2d 69 6e 20 73 74 61 74 75 73 2d 69 6e ate-in status-in
5390: 20 63 6f 6d 6d 65 6e 74 20 6c 6f 67 66 69 6c 65 comment logfile
53a0: 29 29 29 29 0a 0a 0a 28 64 65 66 69 6e 65 20 28 ))))...(define (
53b0: 72 6d 74 3a 64 65 6c 65 74 65 2d 73 74 65 70 73 rmt:delete-steps
53c0: 2d 66 6f 72 2d 74 65 73 74 21 20 72 75 6e 2d 69 -for-test! run-i
53d0: 64 20 74 65 73 74 2d 69 64 29 0a 20 20 28 72 6d d test-id). (rm
53e0: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
53f0: 64 65 6c 65 74 65 2d 73 74 65 70 73 2d 66 6f 72 delete-steps-for
5400: 2d 74 65 73 74 21 20 72 75 6e 2d 69 64 20 28 6c -test! run-id (l
5410: 69 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d ist run-id test-
5420: 69 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 id)))..(define (
5430: 72 6d 74 3a 67 65 74 2d 73 74 65 70 73 2d 66 6f rmt:get-steps-fo
5440: 72 2d 74 65 73 74 20 72 75 6e 2d 69 64 20 74 65 r-test run-id te
5450: 73 74 2d 69 64 29 0a 20 20 28 72 6d 74 3a 73 65 st-id). (rmt:se
5460: 6e 64 2d 72 65 63 65 69 76 65 20 27 67 65 74 2d nd-receive 'get-
5470: 73 74 65 70 73 2d 66 6f 72 2d 74 65 73 74 20 72 steps-for-test r
5480: 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d un-id (list run-
5490: 69 64 20 74 65 73 74 2d 69 64 29 29 29 0a 0a 28 id test-id)))..(
54a0: 64 65 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d define (rmt:get-
54b0: 73 74 65 70 73 2d 69 6e 66 6f 2d 62 79 2d 69 64 steps-info-by-id
54c0: 20 74 65 73 74 2d 73 74 65 70 2d 69 64 29 0a 20 test-step-id).
54d0: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
54e0: 76 65 20 27 67 65 74 2d 73 74 65 70 73 2d 69 6e ve 'get-steps-in
54f0: 66 6f 2d 62 79 2d 69 64 20 23 66 20 28 6c 69 73 fo-by-id #f (lis
5500: 74 20 74 65 73 74 2d 73 74 65 70 2d 69 64 29 29 t test-step-id))
5510: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
5520: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5530: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5540: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5550: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 20 ===========.;;
5560: 54 20 45 20 53 20 54 20 20 20 44 20 41 20 54 20 T E S T D A T
5570: 41 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d A .;;===========
5580: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5590: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
55a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
55b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 ===========..(de
55c0: 66 69 6e 65 20 28 72 6d 74 3a 72 65 61 64 2d 74 fine (rmt:read-t
55d0: 65 73 74 2d 64 61 74 61 20 72 75 6e 2d 69 64 20 est-data run-id
55e0: 74 65 73 74 2d 69 64 20 63 61 74 65 67 6f 72 79 test-id category
55f0: 70 61 74 74 20 23 21 6b 65 79 20 28 77 6f 72 6b patt #!key (work
5600: 2d 61 72 65 61 20 23 66 29 29 20 0a 20 20 28 72 -area #f)) . (r
5610: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
5620: 27 72 65 61 64 2d 74 65 73 74 2d 64 61 74 61 20 'read-test-data
5630: 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e run-id (list run
5640: 2d 69 64 20 74 65 73 74 2d 69 64 20 63 61 74 65 -id test-id cate
5650: 67 6f 72 79 70 61 74 74 29 29 29 0a 0a 28 64 65 gorypatt)))..(de
5660: 66 69 6e 65 20 28 72 6d 74 3a 72 65 61 64 2d 74 fine (rmt:read-t
5670: 65 73 74 2d 64 61 74 61 2d 76 61 72 70 61 74 74 est-data-varpatt
5680: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 run-id test-id
5690: 63 61 74 65 67 6f 72 79 70 61 74 74 20 76 61 72 categorypatt var
56a0: 70 61 74 74 20 23 21 6b 65 79 20 28 77 6f 72 6b patt #!key (work
56b0: 2d 61 72 65 61 20 23 66 29 29 20 0a 20 20 28 72 -area #f)) . (r
56c0: 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 mt:send-receive
56d0: 27 72 65 61 64 2d 74 65 73 74 2d 64 61 74 61 2d 'read-test-data-
56e0: 76 61 72 70 61 74 74 20 72 75 6e 2d 69 64 20 28 varpatt run-id (
56f0: 6c 69 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 list run-id test
5700: 2d 69 64 20 63 61 74 65 67 6f 72 79 70 61 74 74 -id categorypatt
5710: 20 76 61 72 70 61 74 74 29 29 29 0a 0a 28 64 65 varpatt)))..(de
5720: 66 69 6e 65 20 28 72 6d 74 3a 67 65 74 2d 64 61 fine (rmt:get-da
5730: 74 61 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 74 65 ta-info-by-id te
5740: 73 74 2d 64 61 74 61 2d 69 64 29 0a 20 20 20 28 st-data-id). (
5750: 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 rmt:send-receive
5760: 20 27 67 65 74 2d 64 61 74 61 2d 69 6e 66 6f 2d 'get-data-info-
5770: 62 79 2d 69 64 20 23 66 20 28 6c 69 73 74 20 74 by-id #f (list t
5780: 65 73 74 2d 64 61 74 61 2d 69 64 29 29 29 0a 0a est-data-id)))..
5790: 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 74 65 73 (define (rmt:tes
57a0: 74 6d 65 74 61 2d 61 64 64 2d 72 65 63 6f 72 64 tmeta-add-record
57b0: 20 74 65 73 74 6e 61 6d 65 29 0a 20 20 28 72 6d testname). (rm
57c0: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
57d0: 74 65 73 74 6d 65 74 61 2d 61 64 64 2d 72 65 63 testmeta-add-rec
57e0: 6f 72 64 20 23 66 20 28 6c 69 73 74 20 74 65 73 ord #f (list tes
57f0: 74 6e 61 6d 65 29 29 29 0a 0a 28 64 65 66 69 6e tname)))..(defin
5800: 65 20 28 72 6d 74 3a 74 65 73 74 6d 65 74 61 2d e (rmt:testmeta-
5810: 67 65 74 2d 72 65 63 6f 72 64 20 74 65 73 74 6e get-record testn
5820: 61 6d 65 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 ame). (rmt:send
5830: 2d 72 65 63 65 69 76 65 20 27 74 65 73 74 6d 65 -receive 'testme
5840: 74 61 2d 67 65 74 2d 72 65 63 6f 72 64 20 23 66 ta-get-record #f
5850: 20 28 6c 69 73 74 20 74 65 73 74 6e 61 6d 65 29 (list testname)
5860: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 ))..(define (rmt
5870: 3a 74 65 73 74 6d 65 74 61 2d 75 70 64 61 74 65 :testmeta-update
5880: 2d 66 69 65 6c 64 20 74 65 73 74 2d 6e 61 6d 65 -field test-name
5890: 20 66 6c 64 20 76 61 6c 29 0a 20 20 28 72 6d 74 fld val). (rmt
58a0: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 74 :send-receive 't
58b0: 65 73 74 6d 65 74 61 2d 75 70 64 61 74 65 2d 66 estmeta-update-f
58c0: 69 65 6c 64 20 23 66 20 28 6c 69 73 74 20 74 65 ield #f (list te
58d0: 73 74 2d 6e 61 6d 65 20 66 6c 64 20 76 61 6c 29 st-name fld val)
58e0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 ))..(define (rmt
58f0: 3a 74 65 73 74 2d 64 61 74 61 2d 72 6f 6c 6c 75 :test-data-rollu
5900: 70 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 p run-id test-id
5910: 20 73 74 61 74 75 73 29 0a 20 20 28 72 6d 74 3a status). (rmt:
5920: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 74 65 send-receive 'te
5930: 73 74 2d 64 61 74 61 2d 72 6f 6c 6c 75 70 20 72 st-data-rollup r
5940: 75 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d un-id (list run-
5950: 69 64 20 74 65 73 74 2d 69 64 20 73 74 61 74 75 id test-id statu
5960: 73 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 s)))..(define (r
5970: 6d 74 3a 63 73 76 2d 3e 74 65 73 74 2d 64 61 74 mt:csv->test-dat
5980: 61 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 a run-id test-id
5990: 20 63 73 76 64 61 74 61 29 0a 20 20 28 72 6d 74 csvdata). (rmt
59a0: 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 63 :send-receive 'c
59b0: 73 76 2d 3e 74 65 73 74 2d 64 61 74 61 20 72 75 sv->test-data ru
59c0: 6e 2d 69 64 20 28 6c 69 73 74 20 72 75 6e 2d 69 n-id (list run-i
59d0: 64 20 74 65 73 74 2d 69 64 20 63 73 76 64 61 74 d test-id csvdat
59e0: 61 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d a)))..;;========
59f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5a00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5a10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5a20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
5a30: 3b 20 20 54 20 41 20 53 20 4b 20 53 0a 3b 3b 3d ; T A S K S.;;=
5a40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5a50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5a60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5a70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5a80: 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 =====..(define (
5a90: 72 6d 74 3a 74 61 73 6b 73 2d 66 69 6e 64 2d 74 rmt:tasks-find-t
5aa0: 61 73 6b 2d 71 75 65 75 65 2d 72 65 63 6f 72 64 ask-queue-record
5ab0: 73 20 74 61 72 67 65 74 20 72 75 6e 2d 6e 61 6d s target run-nam
5ac0: 65 20 74 65 73 74 2d 70 61 74 74 20 73 74 61 74 e test-patt stat
5ad0: 65 2d 70 61 74 74 20 61 63 74 69 6f 6e 2d 70 61 e-patt action-pa
5ae0: 74 74 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d tt). (rmt:send-
5af0: 72 65 63 65 69 76 65 20 27 66 69 6e 64 2d 74 61 receive 'find-ta
5b00: 73 6b 2d 71 75 65 75 65 2d 72 65 63 6f 72 64 73 sk-queue-records
5b10: 20 23 66 20 28 6c 69 73 74 20 74 61 72 67 65 74 #f (list target
5b20: 20 72 75 6e 2d 6e 61 6d 65 20 74 65 73 74 2d 70 run-name test-p
5b30: 61 74 74 20 73 74 61 74 65 2d 70 61 74 74 20 61 att state-patt a
5b40: 63 74 69 6f 6e 2d 70 61 74 74 29 29 29 0a 0a 28 ction-patt)))..(
5b50: 64 65 66 69 6e 65 20 28 72 6d 74 3a 74 61 73 6b define (rmt:task
5b60: 73 2d 61 64 64 20 61 63 74 69 6f 6e 20 6f 77 6e s-add action own
5b70: 65 72 20 74 61 72 67 65 74 20 72 75 6e 6e 61 6d er target runnam
5b80: 65 20 74 65 73 74 70 61 74 74 20 70 61 72 61 6d e testpatt param
5b90: 73 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 s). (rmt:send-r
5ba0: 65 63 65 69 76 65 20 27 74 61 73 6b 73 2d 61 64 eceive 'tasks-ad
5bb0: 64 20 23 66 20 28 6c 69 73 74 20 61 63 74 69 6f d #f (list actio
5bc0: 6e 20 6f 77 6e 65 72 20 74 61 72 67 65 74 20 72 n owner target r
5bd0: 75 6e 6e 61 6d 65 20 74 65 73 74 70 61 74 74 20 unname testpatt
5be0: 70 61 72 61 6d 73 29 29 29 0a 0a 28 64 65 66 69 params)))..(defi
5bf0: 6e 65 20 28 72 6d 74 3a 74 61 73 6b 73 2d 73 65 ne (rmt:tasks-se
5c00: 74 2d 73 74 61 74 65 2d 67 69 76 65 6e 2d 70 61 t-state-given-pa
5c10: 72 61 6d 2d 6b 65 79 20 70 61 72 61 6d 2d 6b 65 ram-key param-ke
5c20: 79 20 6e 65 77 2d 73 74 61 74 65 29 0a 20 20 28 y new-state). (
5c30: 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 rmt:send-receive
5c40: 20 27 74 61 73 6b 73 2d 73 65 74 2d 73 74 61 74 'tasks-set-stat
5c50: 65 2d 67 69 76 65 6e 2d 70 61 72 61 6d 2d 6b 65 e-given-param-ke
5c60: 79 20 23 66 20 28 6c 69 73 74 20 20 70 61 72 61 y #f (list para
5c70: 6d 2d 6b 65 79 20 6e 65 77 2d 73 74 61 74 65 29 m-key new-state)
5c80: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 ))..(define (rmt
5c90: 3a 74 61 73 6b 73 2d 67 65 74 2d 6c 61 73 74 20 :tasks-get-last
5ca0: 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 29 0a target runname).
5cb0: 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 (rmt:send-rece
5cc0: 69 76 65 20 27 74 61 73 6b 73 2d 67 65 74 2d 6c ive 'tasks-get-l
5cd0: 61 73 74 20 23 66 20 28 6c 69 73 74 20 74 61 72 ast #f (list tar
5ce0: 67 65 74 20 72 75 6e 6e 61 6d 65 29 29 29 0a 0a get runname)))..
5cf0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
5d00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5d10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5d20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5d30: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4e 20 4f 20 ========.;; N O
5d40: 20 20 53 20 59 20 4e 20 43 20 20 20 44 20 42 20 S Y N C D B
5d50: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
5d60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5d70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5d80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5d90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 =========..(defi
5da0: 6e 65 20 28 72 6d 74 3a 6e 6f 2d 73 79 6e 63 2d ne (rmt:no-sync-
5db0: 73 65 74 20 76 61 72 20 76 61 6c 29 0a 20 20 28 set var val). (
5dc0: 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 rmt:send-receive
5dd0: 20 27 6e 6f 2d 73 79 6e 63 2d 73 65 74 20 23 66 'no-sync-set #f
5de0: 20 60 28 2c 76 61 72 20 2c 76 61 6c 29 29 29 0a `(,var ,val))).
5df0: 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a 6e 6f .(define (rmt:no
5e00: 2d 73 79 6e 63 2d 67 65 74 2f 64 65 66 61 75 6c -sync-get/defaul
5e10: 74 20 76 61 72 20 64 65 66 61 75 6c 74 29 0a 20 t var default).
5e20: 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 (rmt:send-recei
5e30: 76 65 20 27 6e 6f 2d 73 79 6e 63 2d 67 65 74 2f ve 'no-sync-get/
5e40: 64 65 66 61 75 6c 74 20 23 66 20 60 28 2c 76 61 default #f `(,va
5e50: 72 20 2c 64 65 66 61 75 6c 74 29 29 29 0a 0a 28 r ,default)))..(
5e60: 64 65 66 69 6e 65 20 28 72 6d 74 3a 6e 6f 2d 73 define (rmt:no-s
5e70: 79 6e 63 2d 64 65 6c 21 20 76 61 72 29 0a 20 20 ync-del! var).
5e80: 28 72 6d 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 (rmt:send-receiv
5e90: 65 20 27 6e 6f 2d 73 79 6e 63 2d 64 65 6c 21 20 e 'no-sync-del!
5ea0: 23 66 20 60 28 2c 76 61 72 29 29 29 0a 0a 28 64 #f `(,var)))..(d
5eb0: 65 66 69 6e 65 20 28 72 6d 74 3a 6e 6f 2d 73 79 efine (rmt:no-sy
5ec0: 6e 63 2d 67 65 74 2d 6c 6f 63 6b 20 6b 65 79 6e nc-get-lock keyn
5ed0: 61 6d 65 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 ame). (rmt:send
5ee0: 2d 72 65 63 65 69 76 65 20 27 6e 6f 2d 73 79 6e -receive 'no-syn
5ef0: 63 2d 67 65 74 2d 6c 6f 63 6b 20 23 66 20 60 28 c-get-lock #f `(
5f00: 2c 6b 65 79 6e 61 6d 65 29 29 29 0a 0a 3b 3b 3d ,keyname)))..;;=
5f10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5f20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5f30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5f40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5f50: 3d 3d 3d 3d 3d 0a 3b 3b 20 41 20 52 20 43 20 48 =====.;; A R C H
5f60: 20 49 20 56 20 45 20 53 0a 3b 3b 3d 3d 3d 3d 3d I V E S.;;=====
5f70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5f80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5f90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5fa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5fb0: 3d 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a =..(define (rmt:
5fc0: 61 72 63 68 69 76 65 2d 67 65 74 2d 61 6c 6c 6f archive-get-allo
5fd0: 63 61 74 69 6f 6e 73 20 20 74 65 73 74 6e 61 6d cations testnam
5fe0: 65 20 69 74 65 6d 70 61 74 68 20 64 6e 65 65 64 e itempath dneed
5ff0: 65 64 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d ed). (rmt:send-
6000: 72 65 63 65 69 76 65 20 27 61 72 63 68 69 76 65 receive 'archive
6010: 2d 67 65 74 2d 61 6c 6c 6f 63 61 74 69 6f 6e 73 -get-allocations
6020: 20 23 66 20 28 6c 69 73 74 20 74 65 73 74 6e 61 #f (list testna
6030: 6d 65 20 69 74 65 6d 70 61 74 68 20 64 6e 65 65 me itempath dnee
6040: 64 65 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 ded)))..(define
6050: 28 72 6d 74 3a 61 72 63 68 69 76 65 2d 72 65 67 (rmt:archive-reg
6060: 69 73 74 65 72 2d 62 6c 6f 63 6b 2d 6e 61 6d 65 ister-block-name
6070: 20 62 64 69 73 6b 2d 69 64 20 61 72 63 68 69 76 bdisk-id archiv
6080: 65 2d 70 61 74 68 29 0a 20 20 28 72 6d 74 3a 73 e-path). (rmt:s
6090: 65 6e 64 2d 72 65 63 65 69 76 65 20 27 61 72 63 end-receive 'arc
60a0: 68 69 76 65 2d 72 65 67 69 73 74 65 72 2d 62 6c hive-register-bl
60b0: 6f 63 6b 2d 6e 61 6d 65 20 23 66 20 28 6c 69 73 ock-name #f (lis
60c0: 74 20 62 64 69 73 6b 2d 69 64 20 61 72 63 68 69 t bdisk-id archi
60d0: 76 65 2d 70 61 74 68 29 29 29 0a 0a 28 64 65 66 ve-path)))..(def
60e0: 69 6e 65 20 28 72 6d 74 3a 61 72 63 68 69 76 65 ine (rmt:archive
60f0: 2d 61 6c 6c 6f 63 61 74 65 2d 74 65 73 74 73 75 -allocate-testsu
6100: 69 74 65 2f 61 72 65 61 2d 74 6f 2d 62 6c 6f 63 ite/area-to-bloc
6110: 6b 20 62 6c 6f 63 6b 2d 69 64 20 74 65 73 74 73 k block-id tests
6120: 75 69 74 65 2d 6e 61 6d 65 20 61 72 65 61 6b 65 uite-name areake
6130: 79 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 y). (rmt:send-r
6140: 65 63 65 69 76 65 20 27 61 72 63 68 69 76 65 2d eceive 'archive-
6150: 61 6c 6c 6f 63 61 74 65 2d 74 65 73 74 2d 74 6f allocate-test-to
6160: 2d 62 6c 6f 63 6b 20 23 66 20 28 6c 69 73 74 20 -block #f (list
6170: 20 62 6c 6f 63 6b 2d 69 64 20 74 65 73 74 73 75 block-id testsu
6180: 69 74 65 2d 6e 61 6d 65 20 61 72 65 61 6b 65 79 ite-name areakey
6190: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d )))..(define (rm
61a0: 74 3a 61 72 63 68 69 76 65 2d 72 65 67 69 73 74 t:archive-regist
61b0: 65 72 2d 64 69 73 6b 20 62 64 69 73 6b 2d 6e 61 er-disk bdisk-na
61c0: 6d 65 20 62 64 69 73 6b 2d 70 61 74 68 20 64 66 me bdisk-path df
61d0: 29 0a 20 20 28 72 6d 74 3a 73 65 6e 64 2d 72 65 ). (rmt:send-re
61e0: 63 65 69 76 65 20 27 61 72 63 68 69 76 65 2d 72 ceive 'archive-r
61f0: 65 67 69 73 74 65 72 2d 64 69 73 6b 20 23 66 20 egister-disk #f
6200: 28 6c 69 73 74 20 62 64 69 73 6b 2d 6e 61 6d 65 (list bdisk-name
6210: 20 62 64 69 73 6b 2d 70 61 74 68 20 64 66 29 29 bdisk-path df))
6220: 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 6d 74 3a )..(define (rmt:
6230: 74 65 73 74 2d 73 65 74 2d 61 72 63 68 69 76 65 test-set-archive
6240: 2d 62 6c 6f 63 6b 2d 69 64 20 72 75 6e 2d 69 64 -block-id run-id
6250: 20 74 65 73 74 2d 69 64 20 61 72 63 68 69 76 65 test-id archive
6260: 2d 62 6c 6f 63 6b 2d 69 64 29 0a 20 20 28 72 6d -block-id). (rm
6270: 74 3a 73 65 6e 64 2d 72 65 63 65 69 76 65 20 27 t:send-receive '
6280: 74 65 73 74 2d 73 65 74 2d 61 72 63 68 69 76 65 test-set-archive
6290: 2d 62 6c 6f 63 6b 2d 69 64 20 72 75 6e 2d 69 64 -block-id run-id
62a0: 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 20 74 65 (list run-id te
62b0: 73 74 2d 69 64 20 61 72 63 68 69 76 65 2d 62 6c st-id archive-bl
62c0: 6f 63 6b 2d 69 64 29 29 29 0a 0a 28 64 65 66 69 ock-id)))..(defi
62d0: 6e 65 20 28 72 6d 74 3a 74 65 73 74 2d 67 65 74 ne (rmt:test-get
62e0: 2d 61 72 63 68 69 76 65 2d 62 6c 6f 63 6b 2d 69 -archive-block-i
62f0: 6e 66 6f 20 61 72 63 68 69 76 65 2d 62 6c 6f 63 nfo archive-bloc
6300: 6b 2d 69 64 29 0a 20 20 28 72 6d 74 3a 73 65 6e k-id). (rmt:sen
6310: 64 2d 72 65 63 65 69 76 65 20 27 74 65 73 74 2d d-receive 'test-
6320: 67 65 74 2d 61 72 63 68 69 76 65 2d 62 6c 6f 63 get-archive-bloc
6330: 6b 2d 69 6e 66 6f 20 23 66 20 28 6c 69 73 74 20 k-info #f (list
6340: 61 72 63 68 69 76 65 2d 62 6c 6f 63 6b 2d 69 64 archive-block-id
6350: 29 29 29 0a 0a 3b 3b 20 67 65 74 73 20 6d 74 70 )))..;; gets mtp
6360: 67 2d 72 75 6e 2d 69 64 20 61 6e 64 20 73 79 6e g-run-id and syn
6370: 63 73 20 74 68 65 20 72 65 63 6f 72 64 20 69 66 cs the record if
6380: 20 64 69 66 66 65 72 65 6e 74 0a 3b 3b 0a 28 64 different.;;.(d
6390: 65 66 69 6e 65 20 28 74 61 73 6b 73 3a 72 75 6e efine (tasks:run
63a0: 2d 69 64 2d 3e 6d 74 70 67 2d 72 75 6e 2d 69 64 -id->mtpg-run-id
63b0: 20 64 62 68 20 63 61 63 68 65 64 2d 69 6e 66 6f dbh cached-info
63c0: 20 72 75 6e 2d 69 64 20 61 72 65 61 2d 69 6e 66 run-id area-inf
63d0: 6f 20 73 6d 61 6c 6c 65 73 74 2d 6c 61 73 74 2d o smallest-last-
63e0: 75 70 64 61 74 65 2d 74 69 6d 65 29 0a 20 20 28 update-time). (
63f0: 6c 65 74 2a 20 28 28 72 75 6e 73 2d 68 74 20 28 let* ((runs-ht (
6400: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 63 hash-table-ref c
6410: 61 63 68 65 64 2d 69 6e 66 6f 20 27 72 75 6e 73 ached-info 'runs
6420: 29 29 0a 09 20 28 72 75 6e 69 6e 66 20 20 28 68 )).. (runinf (h
6430: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
6440: 66 61 75 6c 74 20 72 75 6e 73 2d 68 74 20 72 75 fault runs-ht ru
6450: 6e 2d 69 64 20 23 66 29 29 0a 20 20 20 20 20 20 n-id #f)).
6460: 20 20 20 28 61 72 65 61 2d 69 64 20 28 76 65 63 (area-id (vec
6470: 74 6f 72 2d 72 65 66 20 61 72 65 61 2d 69 6e 66 tor-ref area-inf
6480: 6f 20 30 29 29 29 0a 20 20 20 20 20 20 20 28 69 o 0))). (i
6490: 66 20 72 75 6e 69 6e 66 0a 09 72 75 6e 69 6e 66 f runinf..runinf
64a0: 20 3b 3b 20 61 6c 72 65 61 64 79 20 63 61 63 68 ;; already cach
64b0: 65 64 0a 09 28 6c 65 74 2a 20 28 28 72 75 6e 2d ed..(let* ((run-
64c0: 64 61 74 20 20 20 20 28 72 6d 74 3a 67 65 74 2d dat (rmt:get-
64d0: 72 75 6e 2d 69 6e 66 6f 20 72 75 6e 2d 69 64 29 run-info run-id)
64e0: 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 )
64f0: 3b 3b 20 4e 4f 54 45 3a 20 67 65 74 2d 72 75 6e ;; NOTE: get-run
6500: 2d 69 6e 66 6f 20 72 65 74 75 72 6e 73 20 61 20 -info returns a
6510: 76 65 63 74 6f 72 20 3c 20 72 6f 77 20 68 65 61 vector < row hea
6520: 64 65 72 20 3e 0a 09 20 20 20 20 20 20 20 28 72 der >.. (r
6530: 75 6e 2d 6e 61 6d 65 20 20 20 28 72 6d 74 3a 67 un-name (rmt:g
6540: 65 74 2d 72 75 6e 2d 6e 61 6d 65 2d 66 72 6f 6d et-run-name-from
6550: 2d 69 64 20 72 75 6e 2d 69 64 29 29 0a 09 20 20 -id run-id))..
6560: 20 20 20 20 20 28 72 6f 77 20 20 20 20 20 20 20 (row
6570: 20 28 64 62 3a 67 65 74 2d 72 6f 77 73 20 72 75 (db:get-rows ru
6580: 6e 2d 64 61 74 29 29 20 20 20 20 20 20 20 20 20 n-dat))
6590: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 79 65 73 ;; yes
65a0: 2c 20 74 68 69 73 20 72 65 74 75 72 6e 73 20 61 , this returns a
65b0: 20 73 69 6e 67 6c 65 20 72 6f 77 0a 09 20 20 20 single row..
65c0: 20 20 20 20 28 68 65 61 64 65 72 20 20 20 20 20 (header
65d0: 28 64 62 3a 67 65 74 2d 68 65 61 64 65 72 20 72 (db:get-header r
65e0: 75 6e 2d 64 61 74 29 29 0a 09 20 20 20 20 20 20 un-dat))..
65f0: 20 28 73 74 61 74 65 20 20 20 20 20 20 28 64 62 (state (db
6600: 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 :get-value-by-he
6610: 61 64 65 72 20 72 6f 77 20 68 65 61 64 65 72 20 ader row header
6620: 22 73 74 61 74 65 22 29 29 0a 09 20 20 20 20 20 "state"))..
6630: 20 20 28 73 74 61 74 75 73 20 20 20 20 20 28 64 (status (d
6640: 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 b:get-value-by-h
6650: 65 61 64 65 72 20 72 6f 77 20 68 65 61 64 65 72 eader row header
6660: 20 22 73 74 61 74 75 73 22 29 29 0a 09 20 20 20 "status"))..
6670: 20 20 20 20 28 6f 77 6e 65 72 20 20 20 20 20 20 (owner
6680: 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 (db:get-value-by
6690: 2d 68 65 61 64 65 72 20 72 6f 77 20 68 65 61 64 -header row head
66a0: 65 72 20 22 6f 77 6e 65 72 22 29 29 0a 09 20 20 er "owner"))..
66b0: 20 20 20 20 20 28 65 76 65 6e 74 2d 74 69 6d 65 (event-time
66c0: 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 (db:get-value-b
66d0: 79 2d 68 65 61 64 65 72 20 72 6f 77 20 68 65 61 y-header row hea
66e0: 64 65 72 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 der "event_time"
66f0: 29 29 0a 09 20 20 20 20 20 20 20 28 63 6f 6d 6d )).. (comm
6700: 65 6e 74 20 20 20 20 28 64 62 3a 67 65 74 2d 76 ent (db:get-v
6710: 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 alue-by-header r
6720: 6f 77 20 68 65 61 64 65 72 20 22 63 6f 6d 6d 65 ow header "comme
6730: 6e 74 22 29 29 0a 09 20 20 20 20 20 20 20 28 66 nt")).. (f
6740: 61 69 6c 2d 63 6f 75 6e 74 20 28 64 62 3a 67 65 ail-count (db:ge
6750: 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 t-value-by-heade
6760: 72 20 72 6f 77 20 68 65 61 64 65 72 20 22 66 61 r row header "fa
6770: 69 6c 5f 63 6f 75 6e 74 22 29 29 0a 09 20 20 20 il_count"))..
6780: 20 20 20 20 28 70 61 73 73 2d 63 6f 75 6e 74 20 (pass-count
6790: 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 (db:get-value-by
67a0: 2d 68 65 61 64 65 72 20 72 6f 77 20 68 65 61 64 -header row head
67b0: 65 72 20 22 70 61 73 73 5f 63 6f 75 6e 74 22 29 er "pass_count")
67c0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
67d0: 20 28 64 62 2d 63 6f 6e 74 6f 75 72 20 28 64 62 (db-contour (db
67e0: 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 :get-value-by-he
67f0: 61 64 65 72 20 72 6f 77 20 68 65 61 64 65 72 20 ader row header
6800: 22 63 6f 6e 74 6f 75 72 22 29 29 0a 09 20 20 20 "contour"))..
6810: 20 20 20 20 28 63 6f 6e 74 6f 75 72 20 20 20 20 (contour
6820: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
6830: 67 20 22 2d 70 72 65 70 65 6e 64 2d 63 6f 6e 74 g "-prepend-cont
6840: 6f 75 72 22 29 20 0a 20 20 20 20 20 20 20 20 20 our") .
6850: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6860: 20 20 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 (if (and
6870: 20 64 62 2d 63 6f 6e 74 6f 75 72 20 28 6e 6f 74 db-contour (not
6880: 20 28 65 71 75 61 6c 3f 20 64 62 2d 63 6f 6e 74 (equal? db-cont
6890: 6f 75 72 20 22 22 29 29 20 20 28 73 74 72 69 6e our "")) (strin
68a0: 67 3f 20 64 62 2d 63 6f 6e 74 6f 75 72 20 29 29 g? db-contour ))
68b0: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
68c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
68d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 62 65 (be
68e0: 67 69 6e 20 0a 20 20 20 20 20 20 20 20 20 20 20 gin .
68f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6900: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6910: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
6920: 66 6f 20 31 30 20 2a 64 65 66 61 75 6c 74 2d 6c fo 10 *default-l
6930: 6f 67 2d 70 6f 72 74 2a 20 20 22 64 62 2d 63 6f og-port* "db-co
6940: 6e 74 6f 75 72 22 20 64 62 2d 63 6f 6e 74 6f 75 ntour" db-contou
6950: 72 29 20 0a 20 09 09 09 09 09 09 64 62 2d 63 6f r) . ......db-co
6960: 6e 74 6f 75 72 29 0a 09 09 09 09 09 20 20 20 20 ntour)......
6970: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
6980: 63 6f 6e 74 6f 75 72 22 29 29 29 29 0a 20 20 20 contour")))).
6990: 20 20 20 20 20 20 20 20 20 20 20 20 28 72 75 6e (run
69a0: 2d 74 61 67 20 28 69 66 20 28 61 72 67 73 3a 67 -tag (if (args:g
69b0: 65 74 2d 61 72 67 20 22 2d 72 75 6e 2d 74 61 67 et-arg "-run-tag
69c0: 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ").
69d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
69e0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
69f0: 75 6e 2d 74 61 67 22 29 0a 09 09 09 09 09 09 09 un-tag")........
6a00: 09 09 22 22 29 29 0a 20 20 20 20 20 20 20 20 20 .."")).
6a10: 20 20 20 20 20 20 28 6c 61 73 74 2d 75 70 64 61 (last-upda
6a20: 74 65 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 te (db:get-value
6a30: 2d 62 79 2d 68 65 61 64 65 72 20 72 6f 77 20 68 -by-header row h
6a40: 65 61 64 65 72 20 22 6c 61 73 74 5f 75 70 64 61 eader "last_upda
6a50: 74 65 22 29 29 0a 09 20 20 20 20 20 20 20 28 6b te")).. (k
6a60: 65 79 74 61 72 67 20 20 20 20 28 69 66 20 28 6f eytarg (if (o
6a70: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
6a80: 22 2d 70 72 65 70 65 6e 64 2d 63 6f 6e 74 6f 75 "-prepend-contou
6a90: 72 22 29 20 28 61 72 67 73 3a 67 65 74 2d 61 72 r") (args:get-ar
6aa0: 67 20 22 2d 70 72 65 66 69 78 2d 74 61 72 67 65 g "-prefix-targe
6ab0: 74 22 29 29 0a 09 20 20 20 20 20 20 20 09 09 09 t")).. ...
6ac0: 28 63 6f 6e 63 20 22 4d 54 5f 43 4f 4e 54 4f 55 (conc "MT_CONTOU
6ad0: 52 2f 4d 54 5f 41 52 45 41 2f 22 20 28 73 74 72 R/MT_AREA/" (str
6ae0: 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 ing-intersperse
6af0: 28 72 6d 74 3a 67 65 74 2d 6b 65 79 73 29 20 22 (rmt:get-keys) "
6b00: 2f 22 29 29 20 28 73 74 72 69 6e 67 2d 69 6e 74 /")) (string-int
6b10: 65 72 73 70 65 72 73 65 20 28 72 6d 74 3a 67 65 ersperse (rmt:ge
6b20: 74 2d 6b 65 79 73 29 20 22 2f 22 29 29 29 20 3b t-keys) "/"))) ;
6b30: 3b 20 65 2e 67 2e 20 76 65 72 73 69 6f 6e 2f 69 ; e.g. version/i
6b40: 74 65 72 61 74 69 6f 6e 2f 70 6c 61 74 66 6f 72 teration/platfor
6b50: 6d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 m.
6b60: 20 28 62 61 73 65 2d 74 61 72 67 65 74 20 20 20 (base-target
6b70: 20 20 20 28 72 6d 74 3a 67 65 74 2d 74 61 72 67 (rmt:get-targ
6b80: 65 74 20 72 75 6e 2d 69 64 29 29 0a 09 20 20 20 et run-id))..
6b90: 20 20 20 20 28 74 61 72 67 65 74 20 20 20 20 20 (target
6ba0: 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 (if (or (args:ge
6bb0: 74 2d 61 72 67 20 22 2d 70 72 65 70 65 6e 64 2d t-arg "-prepend-
6bc0: 63 6f 6e 74 6f 75 72 22 29 20 28 61 72 67 73 3a contour") (args:
6bd0: 67 65 74 2d 61 72 67 20 22 2d 70 72 65 66 69 78 get-arg "-prefix
6be0: 2d 74 61 72 67 65 74 22 29 29 20 0a 09 20 20 20 -target")) ..
6bf0: 20 20 20 20 09 09 09 28 63 6f 6e 63 20 28 6f 72 ...(conc (or
6c00: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
6c10: 2d 70 72 65 66 69 78 2d 74 61 72 67 65 74 22 29 -prefix-target")
6c20: 20 28 63 6f 6e 63 20 63 6f 6e 74 6f 75 72 20 22 (conc contour "
6c30: 2f 22 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 61 /" (common:get-a
6c40: 72 65 61 2d 6e 61 6d 65 29 20 22 2f 22 29 29 20 rea-name) "/"))
6c50: 62 61 73 65 2d 74 61 72 67 65 74 29 20 62 61 73 base-target) bas
6c60: 65 2d 74 61 72 67 65 74 29 29 20 20 20 20 20 20 e-target))
6c70: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 65 2e ;; e.
6c80: 67 2e 20 76 31 2e 36 33 2f 61 33 65 31 2f 75 62 g. v1.63/a3e1/ub
6c90: 75 6e 74 75 0a 09 20 20 20 20 20 20 20 28 73 70 untu.. (sp
6ca0: 65 63 2d 69 64 20 20 20 20 28 70 67 64 62 3a 67 ec-id (pgdb:g
6cb0: 65 74 2d 74 74 79 70 65 20 64 62 68 20 6b 65 79 et-ttype dbh key
6cc0: 74 61 72 67 29 29 0a 09 20 20 20 20 20 20 20 28 targ)).. (
6cd0: 70 75 62 6c 69 73 68 2d 74 69 6d 65 20 28 69 66 publish-time (if
6ce0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
6cf0: 2d 63 70 2d 65 76 65 6e 74 74 69 6d 65 2d 74 6f -cp-eventtime-to
6d00: 2d 70 75 62 6c 69 73 68 74 69 6d 65 22 29 0a 20 -publishtime").
6d10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6d20: 20 20 20 20 20 20 20 20 20 20 20 65 76 65 6e 74 event
6d30: 2d 74 69 6d 65 0a 20 20 20 20 20 20 20 20 20 20 -time.
6d40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6d50: 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 (current-second
6d60: 73 29 29 29 20 0a 09 20 20 20 20 20 20 20 28 6e s))) .. (n
6d70: 65 77 2d 72 75 6e 2d 69 64 20 28 69 66 20 28 61 ew-run-id (if (a
6d80: 6e 64 20 72 75 6e 2d 6e 61 6d 65 20 62 61 73 65 nd run-name base
6d90: 2d 74 61 72 67 65 74 29 20 28 70 67 64 62 3a 67 -target) (pgdb:g
6da0: 65 74 2d 72 75 6e 2d 69 64 20 64 62 68 20 73 70 et-run-id dbh sp
6db0: 65 63 2d 69 64 20 74 61 72 67 65 74 20 72 75 6e ec-id target run
6dc0: 2d 6e 61 6d 65 20 61 72 65 61 2d 69 64 29 20 23 -name area-id) #
6dd0: 66 29 29 29 0a 20 20 20 20 20 20 20 20 20 28 69 f))). (i
6de0: 66 20 6e 65 77 2d 72 75 6e 2d 69 64 0a 09 20 20 f new-run-id..
6df0: 20 20 20 20 20 20 20 28 62 65 67 69 6e 20 3b 3b (begin ;;
6e00: 20 6c 65 74 20 28 28 72 75 6e 2d 72 65 63 6f 72 let ((run-recor
6e10: 64 20 28 70 67 64 62 3a 67 65 74 2d 72 75 6e 2d d (pgdb:get-run-
6e20: 69 6e 66 6f 20 64 62 68 20 6e 65 77 2d 72 75 6e info dbh new-run
6e30: 2d 69 64 29 29 0a 09 09 20 20 20 20 20 20 20 20 -id))...
6e40: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set!
6e50: 20 72 75 6e 73 2d 68 74 20 72 75 6e 2d 69 64 20 runs-ht run-id
6e60: 6e 65 77 2d 72 75 6e 2d 69 64 29 0a 09 09 3b 3b new-run-id)...;;
6e70: 20 65 6e 73 75 72 65 20 6b 65 79 20 66 69 65 6c ensure key fiel
6e80: 64 73 20 61 72 65 20 75 70 20 74 6f 20 64 61 74 ds are up to dat
6e90: 65 0a 20 20 20 20 20 3b 3b 20 69 66 20 6c 61 73 e. ;; if las
6ea0: 74 5f 75 70 64 61 74 65 20 3d 3d 20 70 67 64 62 t_update == pgdb
6eb0: 5f 6c 61 73 74 5f 75 70 64 61 74 65 20 64 6f 20 _last_update do
6ec0: 6e 6f 74 20 75 70 64 61 74 65 20 73 6d 61 6c 6c not update small
6ed0: 65 73 74 2d 6c 61 73 74 2d 75 70 64 61 74 65 2d est-last-update-
6ee0: 74 69 6d 65 20 20 0a 20 20 20 20 28 6c 65 74 2a time . (let*
6ef0: 20 28 28 70 67 64 62 2d 6c 61 73 74 2d 75 70 64 ((pgdb-last-upd
6f00: 61 74 65 20 28 70 67 64 62 3a 67 65 74 2d 72 75 ate (pgdb:get-ru
6f10: 6e 2d 6c 61 73 74 2d 75 70 64 61 74 65 20 64 62 n-last-update db
6f20: 68 20 6e 65 77 2d 72 75 6e 2d 69 64 29 29 0a 20 h new-run-id)).
6f30: 20 20 20 20 20 20 20 20 20 20 28 73 6d 61 6c 6c (small
6f40: 65 73 74 2d 74 69 6d 65 20 28 68 61 73 68 2d 74 est-time (hash-t
6f50: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
6f60: 20 73 6d 61 6c 6c 65 73 74 2d 6c 61 73 74 2d 75 smallest-last-u
6f70: 70 64 61 74 65 2d 74 69 6d 65 20 22 73 6d 61 6c pdate-time "smal
6f80: 6c 65 73 74 2d 74 69 6d 65 22 20 23 66 29 29 29 lest-time" #f)))
6f90: 0a 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 20 . (if (and
6fa0: 28 3e 20 6c 61 73 74 2d 75 70 64 61 74 65 20 70 (> last-update p
6fb0: 67 64 62 2d 6c 61 73 74 2d 75 70 64 61 74 65 29 gdb-last-update)
6fc0: 20 28 6f 72 20 28 6e 6f 74 20 73 6d 61 6c 6c 65 (or (not smalle
6fd0: 73 74 2d 74 69 6d 65 29 20 28 3c 20 6c 61 73 74 st-time) (< last
6fe0: 2d 75 70 64 61 74 65 20 73 6d 61 6c 6c 65 73 74 -update smallest
6ff0: 2d 74 69 6d 65 29 29 29 0a 20 20 20 20 20 20 20 -time))).
7000: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set
7010: 21 20 73 6d 61 6c 6c 65 73 74 2d 6c 61 73 74 2d ! smallest-last-
7020: 75 70 64 61 74 65 2d 74 69 6d 65 20 22 73 6d 61 update-time "sma
7030: 6c 6c 65 73 74 2d 74 69 6d 65 22 20 6c 61 73 74 llest-time" last
7040: 2d 75 70 64 61 74 65 29 29 29 0a 09 09 28 70 67 -update)))...(pg
7050: 64 62 3a 72 65 66 72 65 73 68 2d 72 75 6e 2d 69 db:refresh-run-i
7060: 6e 66 6f 0a 09 09 20 64 62 68 0a 09 09 20 6e 65 nfo... dbh... ne
7070: 77 2d 72 75 6e 2d 69 64 0a 09 09 20 73 74 61 74 w-run-id... stat
7080: 65 20 73 74 61 74 75 73 20 6f 77 6e 65 72 20 65 e status owner e
7090: 76 65 6e 74 2d 74 69 6d 65 20 63 6f 6d 6d 65 6e vent-time commen
70a0: 74 20 66 61 69 6c 2d 63 6f 75 6e 74 20 70 61 73 t fail-count pas
70b0: 73 2d 63 6f 75 6e 74 20 61 72 65 61 2d 69 64 20 s-count area-id
70c0: 6c 61 73 74 2d 75 70 64 61 74 65 20 70 75 62 6c last-update publ
70d0: 69 73 68 2d 74 69 6d 65 29 0a 20 20 20 20 20 28 ish-time). (
70e0: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
70f0: 20 34 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 4 *default-log-
7100: 70 6f 72 74 2a 20 22 57 6f 72 6b 69 6e 67 20 6f port* "Working o
7110: 6e 20 72 75 6e 2d 69 64 20 22 20 72 75 6e 2d 69 n run-id " run-i
7120: 64 20 22 20 70 67 64 62 2d 69 64 20 22 20 20 6e d " pgdb-id " n
7130: 65 77 2d 72 75 6e 2d 69 64 20 29 0a 20 20 20 20 ew-run-id ).
7140: 20 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c (if (not (equal
7150: 3f 20 72 75 6e 2d 74 61 67 20 22 22 29 29 0a 20 ? run-tag "")).
7160: 20 20 20 20 20 28 74 61 73 6b 3a 61 64 64 2d 72 (task:add-r
7170: 75 6e 2d 74 61 67 20 64 62 68 20 6e 65 77 2d 72 un-tag dbh new-r
7180: 75 6e 2d 69 64 20 72 75 6e 2d 74 61 67 29 29 0a un-id run-tag)).
7190: 09 09 6e 65 77 2d 72 75 6e 2d 69 64 29 20 0a 20 ..new-run-id) .
71a0: 20 20 20 20 20 0a 09 20 20 20 20 20 20 28 69 66 .. (if
71b0: 20 28 6f 72 20 28 6e 6f 74 20 73 74 61 74 65 29 (or (not state)
71c0: 20 28 65 71 75 61 6c 3f 20 73 74 61 74 65 20 22 (equal? state "
71d0: 64 65 6c 65 74 65 64 22 29 29 0a 20 20 20 20 20 deleted")).
71e0: 20 20 20 20 20 28 62 65 67 69 6e 20 0a 20 20 20 (begin .
71f0: 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 (debug:pr
7200: 69 6e 74 2d 69 6e 66 6f 20 31 20 2a 64 65 66 61 int-info 1 *defa
7210: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 20 22 ult-log-port* "
7220: 57 61 72 6e 69 6e 67 3a 20 52 75 6e 20 77 69 74 Warning: Run wit
7230: 68 20 69 64 20 22 20 72 75 6e 2d 69 64 20 22 20 h id " run-id "
7240: 77 61 73 20 63 72 65 61 74 65 64 20 61 66 74 65 was created afte
7250: 72 20 70 72 65 76 69 6f 75 73 20 73 79 6e 63 20 r previous sync
7260: 61 6e 64 20 64 65 6c 65 74 65 64 20 62 65 66 6f and deleted befo
7270: 72 65 20 74 68 65 20 73 79 6e 63 22 29 20 23 66 re the sync") #f
7280: 29 0a 20 20 20 20 20 20 20 20 20 20 28 69 66 20 ). (if
7290: 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f (handle-exceptio
72a0: 6e 73 0a 09 09 20 20 20 20 20 20 20 20 65 78 6e ns... exn
72b0: 0a 09 09 20 20 20 20 20 20 20 20 28 62 65 67 69 ... (begi
72c0: 6e 20 28 70 72 69 6e 74 2d 63 61 6c 6c 2d 63 68 n (print-call-ch
72d0: 61 69 6e 29 0a 20 20 20 20 20 20 20 20 20 20 20 ain).
72e0: 20 20 20 28 70 72 69 6e 74 20 28 28 63 6f 6e 64 (print ((cond
72f0: 69 74 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 ition-property-a
7300: 63 63 65 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 ccessor 'exn 'me
7310: 73 73 61 67 65 29 20 65 78 6e 29 29 20 20 20 20 ssage) exn))
7320: 20 0a 09 09 09 20 20 20 20 20 20 23 66 29 0a 20 .... #f).
7330: 20 20 20 20 20 20 20 20 20 20 20 0a 20 20 20 20 .
7340: 20 20 20 20 20 20 20 20 28 70 67 64 62 3a 69 6e (pgdb:in
7350: 73 65 72 74 2d 72 75 6e 0a 09 09 20 20 20 20 20 sert-run...
7360: 64 62 68 0a 09 09 20 20 20 20 20 73 70 65 63 2d dbh... spec-
7370: 69 64 20 74 61 72 67 65 74 20 72 75 6e 2d 6e 61 id target run-na
7380: 6d 65 20 73 74 61 74 65 20 73 74 61 74 75 73 20 me state status
7390: 6f 77 6e 65 72 20 65 76 65 6e 74 2d 74 69 6d 65 owner event-time
73a0: 20 63 6f 6d 6d 65 6e 74 20 66 61 69 6c 2d 63 6f comment fail-co
73b0: 75 6e 74 20 70 61 73 73 2d 63 6f 75 6e 74 20 20 unt pass-count
73c0: 61 72 65 61 2d 69 64 20 6c 61 73 74 2d 75 70 64 area-id last-upd
73d0: 61 74 65 20 70 75 62 6c 69 73 68 2d 74 69 6d 65 ate publish-time
73e0: 29 29 0a 09 09 20 20 20 20 20 20 20 28 6c 65 74 ))... (let
73f0: 2a 20 28 28 73 6d 61 6c 6c 65 73 74 2d 74 69 6d * ((smallest-tim
7400: 65 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 e (hash-table-re
7410: 66 2f 64 65 66 61 75 6c 74 20 73 6d 61 6c 6c 65 f/default smalle
7420: 73 74 2d 6c 61 73 74 2d 75 70 64 61 74 65 2d 74 st-last-update-t
7430: 69 6d 65 20 22 73 6d 61 6c 6c 65 73 74 2d 74 69 ime "smallest-ti
7440: 6d 65 22 20 23 66 29 29 29 0a 20 20 20 20 20 20 me" #f))).
7450: 20 20 20 20 20 20 20 28 69 66 20 28 6f 72 20 28 (if (or (
7460: 6e 6f 74 20 73 6d 61 6c 6c 65 73 74 2d 74 69 6d not smallest-tim
7470: 65 29 20 28 3c 20 6c 61 73 74 2d 75 70 64 61 74 e) (< last-updat
7480: 65 20 73 6d 61 6c 6c 65 73 74 2d 74 69 6d 65 29 e smallest-time)
7490: 29 0a 20 20 20 20 20 20 20 20 09 09 09 09 28 68 ). ....(h
74a0: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 73 ash-table-set! s
74b0: 6d 61 6c 6c 65 73 74 2d 6c 61 73 74 2d 75 70 64 mallest-last-upd
74c0: 61 74 65 2d 74 69 6d 65 20 22 73 6d 61 6c 6c 65 ate-time "smalle
74d0: 73 74 2d 74 69 6d 65 22 20 6c 61 73 74 2d 75 70 st-time" last-up
74e0: 64 61 74 65 29 29 0a 20 20 20 20 20 20 20 20 20 date)).
74f0: 20 20 20 20 28 74 61 73 6b 73 3a 72 75 6e 2d 69 (tasks:run-i
7500: 64 2d 3e 6d 74 70 67 2d 72 75 6e 2d 69 64 20 64 d->mtpg-run-id d
7510: 62 68 20 63 61 63 68 65 64 2d 69 6e 66 6f 20 72 bh cached-info r
7520: 75 6e 2d 69 64 20 61 72 65 61 2d 69 6e 66 6f 20 un-id area-info
7530: 73 6d 61 6c 6c 65 73 74 2d 6c 61 73 74 2d 75 70 smallest-last-up
7540: 64 61 74 65 2d 74 69 6d 65 29 29 0a 09 09 20 20 date-time))...
7550: 23 66 29 29 29 29 29 29 29 0a 0a 28 64 65 66 69 #f)))))))..(defi
7560: 6e 65 20 28 74 61 73 6b 73 3a 73 79 6e 63 2d 74 ne (tasks:sync-t
7570: 65 73 74 2d 67 65 6e 2d 64 61 74 61 20 64 62 68 est-gen-data dbh
7580: 20 63 61 63 68 65 64 2d 69 6e 66 6f 20 74 65 73 cached-info tes
7590: 74 2d 64 61 74 61 2d 69 64 73 20 73 6d 61 6c 6c t-data-ids small
75a0: 65 73 74 2d 6c 61 73 74 2d 75 70 64 61 74 65 2d est-last-update-
75b0: 74 69 6d 65 29 0a 20 20 28 6c 65 74 20 28 28 74 time). (let ((t
75c0: 65 73 74 2d 68 74 20 28 68 61 73 68 2d 74 61 62 est-ht (hash-tab
75d0: 6c 65 2d 72 65 66 20 63 61 63 68 65 64 2d 69 6e le-ref cached-in
75e0: 66 6f 20 27 74 65 73 74 73 29 29 0a 20 20 20 20 fo 'tests)).
75f0: 20 20 20 20 28 64 61 74 61 2d 68 74 20 28 68 61 (data-ht (ha
7600: 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 63 61 63 sh-table-ref cac
7610: 68 65 64 2d 69 6e 66 6f 20 27 64 61 74 61 29 29 hed-info 'data))
7620: 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 0a ). (for-each.
7630: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 65 (lambda (te
7640: 73 74 2d 64 61 74 61 2d 69 64 29 0a 20 20 20 20 st-data-id).
7650: 20 20 20 20 28 6c 65 74 2a 20 28 28 74 65 73 74 (let* ((test
7660: 2d 64 61 74 61 2d 69 6e 66 6f 20 20 28 72 6d 74 -data-info (rmt
7670: 3a 67 65 74 2d 64 61 74 61 2d 69 6e 66 6f 2d 62 :get-data-info-b
7680: 79 2d 69 64 20 74 65 73 74 2d 64 61 74 61 2d 69 y-id test-data-i
7690: 64 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 d)).
76a0: 20 20 20 28 64 61 74 61 2d 69 64 20 28 64 62 3a (data-id (db:
76b0: 74 65 73 74 2d 64 61 74 61 2d 67 65 74 2d 69 64 test-data-get-id
76c0: 20 20 74 65 73 74 2d 64 61 74 61 2d 69 6e 66 6f test-data-info
76d0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
76e0: 20 20 28 74 65 73 74 2d 69 64 20 20 28 64 62 3a (test-id (db:
76f0: 74 65 73 74 2d 64 61 74 61 2d 67 65 74 2d 74 65 test-data-get-te
7700: 73 74 5f 69 64 20 20 20 74 65 73 74 2d 64 61 74 st_id test-dat
7710: 61 2d 69 6e 66 6f 29 29 20 20 20 0a 09 20 20 20 a-info)) ..
7720: 20 20 20 20 28 63 61 74 65 67 6f 72 79 20 20 28 (category (
7730: 64 62 3a 74 65 73 74 2d 64 61 74 61 2d 67 65 74 db:test-data-get
7740: 2d 63 61 74 65 67 6f 72 79 20 20 74 65 73 74 2d -category test-
7750: 64 61 74 61 2d 69 6e 66 6f 29 29 0a 09 20 20 20 data-info))..
7760: 20 20 20 20 28 76 61 72 69 61 62 6c 65 20 20 28 (variable (
7770: 64 62 3a 74 65 73 74 2d 64 61 74 61 2d 67 65 74 db:test-data-get
7780: 2d 76 61 72 69 61 62 6c 65 20 74 65 73 74 2d 64 -variable test-d
7790: 61 74 61 2d 69 6e 66 6f 29 29 09 0a 09 20 20 20 ata-info))...
77a0: 20 20 20 20 28 76 61 6c 75 65 20 28 64 62 3a 74 (value (db:t
77b0: 65 73 74 2d 64 61 74 61 2d 67 65 74 2d 76 61 6c est-data-get-val
77c0: 75 65 20 20 74 65 73 74 2d 64 61 74 61 2d 69 6e ue test-data-in
77d0: 66 6f 29 29 09 0a 20 20 20 20 20 20 20 20 20 20 fo))..
77e0: 20 20 20 20 20 28 65 78 70 65 63 74 65 64 20 28 (expected (
77f0: 64 62 3a 74 65 73 74 2d 64 61 74 61 2d 67 65 74 db:test-data-get
7800: 2d 65 78 70 65 63 74 65 64 20 20 74 65 73 74 2d -expected test-
7810: 64 61 74 61 2d 69 6e 66 6f 29 29 0a 20 20 20 20 data-info)).
7820: 20 20 20 20 20 20 20 20 20 20 20 28 74 6f 6c 20 (tol
7830: 28 64 62 3a 74 65 73 74 2d 64 61 74 61 2d 67 65 (db:test-data-ge
7840: 74 2d 74 6f 6c 20 20 74 65 73 74 2d 64 61 74 61 t-tol test-data
7850: 2d 69 6e 66 6f 29 29 0a 20 20 20 20 20 20 20 20 -info)).
7860: 20 20 20 20 20 20 20 28 75 6e 69 74 73 20 28 64 (units (d
7870: 62 3a 74 65 73 74 2d 64 61 74 61 2d 67 65 74 2d b:test-data-get-
7880: 75 6e 69 74 73 20 20 74 65 73 74 2d 64 61 74 61 units test-data
7890: 2d 69 6e 66 6f 29 29 20 20 20 20 20 0a 09 20 20 -info)) ..
78a0: 20 20 20 20 20 28 63 6f 6d 6d 65 6e 74 20 20 28 (comment (
78b0: 64 62 3a 74 65 73 74 2d 64 61 74 61 2d 67 65 74 db:test-data-get
78c0: 2d 63 6f 6d 6d 65 6e 74 20 74 65 73 74 2d 64 61 -comment test-da
78d0: 74 61 2d 69 6e 66 6f 29 29 09 0a 20 20 20 20 20 ta-info))..
78e0: 20 20 20 20 20 20 20 20 20 20 28 73 74 61 74 75 (statu
78f0: 73 20 28 64 62 3a 74 65 73 74 2d 64 61 74 61 2d s (db:test-data-
7900: 67 65 74 2d 73 74 61 74 75 73 20 74 65 73 74 2d get-status test-
7910: 64 61 74 61 2d 69 6e 66 6f 29 29 09 0a 09 20 20 data-info))...
7920: 20 20 20 20 20 28 74 79 70 65 20 28 64 62 3a 74 (type (db:t
7930: 65 73 74 2d 64 61 74 61 2d 67 65 74 2d 74 79 70 est-data-get-typ
7940: 65 20 74 65 73 74 2d 64 61 74 61 2d 69 6e 66 6f e test-data-info
7950: 29 29 0a 09 09 09 09 20 28 6c 61 73 74 2d 75 70 ))..... (last-up
7960: 64 61 74 65 20 28 64 62 3a 74 65 73 74 2d 64 61 date (db:test-da
7970: 74 61 2d 67 65 74 2d 6c 61 73 74 5f 75 70 64 61 ta-get-last_upda
7980: 74 65 20 74 65 73 74 2d 64 61 74 61 2d 69 6e 66 te test-data-inf
7990: 6f 29 29 0a 09 09 09 09 20 28 73 6d 61 6c 6c 65 o))..... (smalle
79a0: 73 74 2d 74 69 6d 65 20 28 68 61 73 68 2d 74 61 st-time (hash-ta
79b0: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
79c0: 73 6d 61 6c 6c 65 73 74 2d 6c 61 73 74 2d 75 70 smallest-last-up
79d0: 64 61 74 65 2d 74 69 6d 65 20 22 73 6d 61 6c 6c date-time "small
79e0: 65 73 74 2d 74 69 6d 65 22 20 23 66 29 29 0a 20 est-time" #f)).
79f0: 20 20 09 0a 09 20 20 20 20 20 20 20 28 70 67 64 ... (pgd
7a00: 62 2d 74 65 73 74 2d 69 64 20 20 28 68 61 73 68 b-test-id (hash
7a10: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
7a20: 6c 74 20 74 65 73 74 2d 68 74 20 74 65 73 74 2d lt test-ht test-
7a30: 69 64 20 23 66 29 29 0a 20 20 20 20 20 20 20 20 id #f)).
7a40: 20 20 20 20 20 20 20 28 70 67 64 62 2d 64 61 74 (pgdb-dat
7a50: 61 2d 69 64 20 28 69 66 20 70 67 64 62 2d 74 65 a-id (if pgdb-te
7a60: 73 74 2d 69 64 20 0a 20 20 20 20 20 20 20 20 20 st-id .
7a70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7a80: 20 20 20 20 20 20 20 20 28 70 67 64 62 3a 67 65 (pgdb:ge
7a90: 74 2d 74 65 73 74 2d 64 61 74 61 2d 69 64 20 64 t-test-data-id d
7aa0: 62 68 20 70 67 64 62 2d 74 65 73 74 2d 69 64 20 bh pgdb-test-id
7ab0: 63 61 74 65 67 6f 72 79 20 76 61 72 69 61 62 6c category variabl
7ac0: 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 e).
7ad0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7ae0: 20 20 20 20 20 23 66 29 29 29 0a 20 20 20 20 28 #f))). (
7af0: 69 66 20 64 61 74 61 2d 69 64 0a 20 20 20 20 20 if data-id.
7b00: 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 (begin.
7b10: 28 69 66 20 70 67 64 62 2d 74 65 73 74 2d 69 64 (if pgdb-test-id
7b20: 0a 20 20 20 20 20 20 20 20 20 20 20 28 62 65 67 . (beg
7b30: 69 6e 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 in .
7b40: 20 20 20 20 28 69 66 20 20 70 67 64 62 2d 64 61 (if pgdb-da
7b50: 74 61 2d 69 64 0a 20 20 20 20 20 20 20 20 20 20 ta-id.
7b60: 20 20 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a (begin.
7b70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7b80: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
7b90: 2d 69 6e 66 6f 20 34 20 2a 64 65 66 61 75 6c 74 -info 4 *default
7ba0: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 20 22 55 70 64 -log-port* "Upd
7bb0: 61 74 69 6e 67 20 65 78 69 73 74 69 6e 67 20 74 ating existing t
7bc0: 65 73 74 2d 64 61 74 61 20 77 69 74 68 20 74 65 est-data with te
7bd0: 73 74 2d 69 64 3a 20 22 20 74 65 73 74 2d 69 64 st-id: " test-id
7be0: 20 22 20 61 6e 64 20 20 64 61 74 61 2d 69 64 20 " and data-id
7bf0: 22 20 64 61 74 61 2d 69 64 20 22 20 70 67 64 62 " data-id " pgdb
7c00: 20 74 65 73 74 20 69 64 3a 20 22 20 70 67 64 62 test id: " pgdb
7c10: 2d 74 65 73 74 2d 69 64 20 22 20 70 67 64 62 20 -test-id " pgdb
7c20: 64 61 74 61 20 69 64 20 22 20 70 67 64 62 2d 64 data id " pgdb-d
7c30: 61 74 61 2d 69 64 29 0a 20 20 20 20 20 20 20 20 ata-id).
7c40: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 (let
7c50: 2a 20 28 28 70 67 64 62 2d 6c 61 73 74 2d 75 70 * ((pgdb-last-up
7c60: 64 61 74 65 20 28 70 67 64 62 3a 67 65 74 2d 74 date (pgdb:get-t
7c70: 65 73 74 2d 64 61 74 61 2d 6c 61 73 74 2d 75 70 est-data-last-up
7c80: 64 61 74 65 20 64 62 68 20 70 67 64 62 2d 64 61 date dbh pgdb-da
7c90: 74 61 2d 69 64 29 29 29 0a 20 20 20 20 20 20 20 ta-id))).
7ca0: 20 20 28 69 66 20 28 61 6e 64 20 20 28 3e 20 20 (if (and (>
7cb0: 6c 61 73 74 2d 75 70 64 61 74 65 20 70 67 64 62 last-update pgdb
7cc0: 2d 6c 61 73 74 2d 75 70 64 61 74 65 29 20 28 6f -last-update) (o
7cd0: 72 20 28 6e 6f 74 20 73 6d 61 6c 6c 65 73 74 2d r (not smallest-
7ce0: 74 69 6d 65 29 20 28 3c 20 6c 61 73 74 2d 75 70 time) (< last-up
7cf0: 64 61 74 65 20 73 6d 61 6c 6c 65 73 74 2d 74 69 date smallest-ti
7d00: 6d 65 29 29 29 0a 20 20 20 20 20 20 20 20 28 68 me))). (h
7d10: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 73 ash-table-set! s
7d20: 6d 61 6c 6c 65 73 74 2d 6c 61 73 74 2d 75 70 64 mallest-last-upd
7d30: 61 74 65 2d 74 69 6d 65 20 22 73 6d 61 6c 6c 65 ate-time "smalle
7d40: 73 74 2d 74 69 6d 65 22 20 6c 61 73 74 2d 75 70 st-time" last-up
7d50: 64 61 74 65 29 29 29 20 0a 20 20 20 20 20 20 20 date))) .
7d60: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 70 67 (pg
7d70: 64 62 3a 75 70 64 61 74 65 2d 74 65 73 74 2d 64 db:update-test-d
7d80: 61 74 61 20 64 62 68 20 70 67 64 62 2d 64 61 74 ata dbh pgdb-dat
7d90: 61 2d 69 64 20 70 67 64 62 2d 74 65 73 74 2d 69 a-id pgdb-test-i
7da0: 64 20 20 63 61 74 65 67 6f 72 79 20 76 61 72 69 d category vari
7db0: 61 62 6c 65 20 76 61 6c 75 65 20 65 78 70 65 63 able value expec
7dc0: 74 65 64 20 74 6f 6c 20 75 6e 69 74 73 20 63 6f ted tol units co
7dd0: 6d 6d 65 6e 74 20 73 74 61 74 75 73 20 74 79 70 mment status typ
7de0: 65 20 6c 61 73 74 2d 75 70 64 61 74 65 29 29 0a e last-update)).
7df0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7e00: 20 20 20 20 28 62 65 67 69 6e 0a 20 09 09 20 20 (begin. ..
7e10: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
7e20: 2d 69 6e 66 6f 20 34 20 2a 64 65 66 61 75 6c 74 -info 4 *default
7e30: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 20 22 49 6e 73 -log-port* "Ins
7e40: 65 72 74 69 6e 67 20 74 65 73 74 2d 64 61 74 61 erting test-data
7e50: 20 77 69 74 68 20 74 65 73 74 2d 69 64 3a 20 22 with test-id: "
7e60: 20 74 65 73 74 2d 69 64 20 22 20 61 6e 64 20 64 test-id " and d
7e70: 61 74 61 2d 69 64 20 22 20 64 61 74 61 2d 69 64 ata-id " data-id
7e80: 20 22 20 70 67 64 62 20 74 65 73 74 20 69 64 3a " pgdb test id:
7e90: 20 22 20 70 67 64 62 2d 74 65 73 74 2d 69 64 29 " pgdb-test-id)
7ea0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
7eb0: 20 20 20 20 20 20 20 20 28 69 66 20 28 68 61 6e (if (han
7ec0: 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 dle-exceptions..
7ed0: 09 20 20 20 20 20 20 65 78 6e 0a 09 09 20 20 20 . exn...
7ee0: 20 20 20 28 62 65 67 69 6e 20 28 70 72 69 6e 74 (begin (print
7ef0: 2d 63 61 6c 6c 2d 63 68 61 69 6e 29 0a 20 20 20 -call-chain).
7f00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7f10: 20 20 20 20 20 20 20 20 20 20 20 28 70 72 69 6e (prin
7f20: 74 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 t ((condition-pr
7f30: 6f 70 65 72 74 79 2d 61 63 63 65 73 73 6f 72 20 operty-accessor
7f40: 27 65 78 6e 20 27 6d 65 73 73 61 67 65 29 20 65 'exn 'message) e
7f50: 78 6e 29 29 20 20 20 20 20 0a 09 09 09 23 66 29 xn)) ....#f)
7f60: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
7f70: 20 20 20 20 20 20 0a 20 20 20 20 20 20 20 20 20 .
7f80: 20 20 20 20 20 20 20 20 20 20 20 28 70 67 64 62 (pgdb
7f90: 3a 69 6e 73 65 72 74 2d 74 65 73 74 2d 64 61 74 :insert-test-dat
7fa0: 61 20 64 62 68 20 70 67 64 62 2d 74 65 73 74 2d a dbh pgdb-test-
7fb0: 69 64 20 63 61 74 65 67 6f 72 79 20 76 61 72 69 id category vari
7fc0: 61 62 6c 65 20 76 61 6c 75 65 20 65 78 70 65 63 able value expec
7fd0: 74 65 64 20 74 6f 6c 20 75 6e 69 74 73 20 63 6f ted tol units co
7fe0: 6d 6d 65 6e 74 20 73 74 61 74 75 73 20 74 79 70 mment status typ
7ff0: 65 20 6c 61 73 74 2d 75 70 64 61 74 65 29 29 0a e last-update)).
8000: 09 09 20 20 20 20 20 20 20 3b 28 74 61 73 6b 73 .. ;(tasks
8010: 3a 72 75 6e 2d 69 64 2d 3e 6d 74 70 67 2d 72 75 :run-id->mtpg-ru
8020: 6e 2d 69 64 20 64 62 68 20 63 61 63 68 65 64 2d n-id dbh cached-
8030: 69 6e 66 6f 20 72 75 6e 2d 69 64 20 61 72 65 61 info run-id area
8040: 2d 69 6e 66 6f 29 0a 20 20 20 20 20 20 20 20 20 -info).
8050: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 62 65 (be
8060: 67 69 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 gin.
8070: 20 20 20 20 20 20 20 20 20 20 3b 28 70 67 64 62 ;(pgdb
8080: 3a 69 6e 73 65 72 74 2d 74 65 73 74 2d 64 61 74 :insert-test-dat
8090: 61 20 64 62 68 20 70 67 64 62 2d 74 65 73 74 2d a dbh pgdb-test-
80a0: 69 64 20 63 61 74 65 67 6f 72 79 20 76 61 72 69 id category vari
80b0: 61 62 6c 65 20 76 61 6c 75 65 20 65 78 70 65 63 able value expec
80c0: 74 65 64 20 74 6f 6c 20 75 6e 69 74 73 20 63 6f ted tol units co
80d0: 6d 6d 65 6e 74 20 73 74 61 74 75 73 20 74 79 70 mment status typ
80e0: 65 20 29 0a 09 09 09 09 09 09 09 09 09 09 09 28 e )............(
80f0: 69 66 20 28 6f 72 20 28 6e 6f 74 20 73 6d 61 6c if (or (not smal
8100: 6c 65 73 74 2d 74 69 6d 65 29 20 28 3c 20 6c 61 lest-time) (< la
8110: 73 74 2d 75 70 64 61 74 65 20 73 6d 61 6c 6c 65 st-update smalle
8120: 73 74 2d 74 69 6d 65 29 29 0a 20 20 20 20 20 20 st-time)).
8130: 20 20 09 09 09 09 09 09 09 09 28 68 61 73 68 2d ........(hash-
8140: 74 61 62 6c 65 2d 73 65 74 21 20 73 6d 61 6c 6c table-set! small
8150: 65 73 74 2d 6c 61 73 74 2d 75 70 64 61 74 65 2d est-last-update-
8160: 74 69 6d 65 20 22 73 6d 61 6c 6c 65 73 74 2d 74 time "smallest-t
8170: 69 6d 65 22 20 6c 61 73 74 2d 75 70 64 61 74 65 ime" last-update
8180: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
8190: 20 20 20 20 20 20 20 20 20 28 73 65 74 21 20 70 (set! p
81a0: 67 64 62 2d 64 61 74 61 2d 69 64 20 20 28 70 67 gdb-data-id (pg
81b0: 64 62 3a 67 65 74 2d 74 65 73 74 2d 64 61 74 61 db:get-test-data
81c0: 2d 69 64 20 64 62 68 20 70 67 64 62 2d 74 65 73 -id dbh pgdb-tes
81d0: 74 2d 69 64 20 20 63 61 74 65 67 6f 72 79 20 76 t-id category v
81e0: 61 72 69 61 62 6c 65 29 29 29 0a 09 09 20 20 20 ariable)))...
81f0: 23 66 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 #f))).
8200: 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c (hash-tabl
8210: 65 2d 73 65 74 21 20 64 61 74 61 2d 68 74 20 64 e-set! data-ht d
8220: 61 74 61 2d 69 64 20 70 67 64 62 2d 64 61 74 61 ata-id pgdb-data
8230: 2d 69 64 20 29 29 0a 20 20 20 20 20 20 20 20 20 -id )).
8240: 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 (begin.
8250: 20 20 20 20 20 20 20 20 20 20 20 20 28 64 65 62 (deb
8260: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 20 ug:print-info 1
8270: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
8280: 74 2a 20 20 22 45 72 72 6f 72 3a 20 54 65 73 74 t* "Error: Test
8290: 20 6e 6f 74 20 69 6e 20 70 67 64 62 22 29 29 29 not in pgdb")))
82a0: 29 0a 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a ).. (debug:
82b0: 70 72 69 6e 74 2d 69 6e 66 6f 20 31 20 2a 64 65 print-info 1 *de
82c0: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
82d0: 20 22 45 72 72 6f 72 3a 20 43 6f 75 6c 64 20 6e "Error: Could n
82e0: 6f 74 20 67 65 74 20 74 65 73 74 20 64 61 74 61 ot get test data
82f0: 20 69 6e 66 6f 20 66 6f 72 20 64 61 74 61 20 69 info for data i
8300: 64 20 22 20 74 65 73 74 2d 64 61 74 61 2d 69 64 d " test-data-id
8310: 20 29 29 29 29 09 3b 3b 20 74 68 69 73 20 69 73 )))).;; this is
8320: 20 61 20 77 69 65 72 64 20 73 65 6e 61 72 69 6f a wierd senario
8330: 20 6e 65 65 64 20 74 6f 20 64 65 62 75 67 20 20 need to debug
8340: 20 20 20 20 09 0a 20 20 20 74 65 73 74 2d 64 61 .. test-da
8350: 74 61 2d 69 64 73 29 29 29 0a 0a 0a 20 28 64 65 ta-ids)))... (de
8360: 66 69 6e 65 20 28 74 61 73 6b 3a 67 65 74 2d 74 fine (task:get-t
8370: 65 73 74 2d 74 69 6d 65 73 29 0a 20 20 20 28 6c est-times). (l
8380: 65 74 2a 20 28 28 72 75 6e 6e 61 6d 65 20 28 69 et* ((runname (i
8390: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
83a0: 22 2d 72 75 6e 6e 61 6d 65 22 29 0a 20 20 20 20 "-runname").
83b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
83c0: 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
83d0: 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 0a 20 20 g "-runname").
83e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
83f0: 20 20 20 20 20 20 23 66 29 29 0a 20 20 20 20 20 #f)).
8400: 20 20 20 20 20 20 28 74 61 72 67 65 74 20 28 69 (target (i
8410: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
8420: 22 2d 74 61 72 67 65 74 22 29 0a 20 20 20 20 20 "-target").
8430: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8440: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
8450: 20 22 2d 74 61 72 67 65 74 22 29 0a 20 20 20 20 "-target").
8460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8470: 20 20 20 20 23 66 29 29 0a 20 0a 20 20 20 20 20 #f)). .
8480: 20 20 20 20 20 20 28 74 65 73 74 2d 74 69 6d 65 (test-time
8490: 73 20 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 s (rmt:get-test
84a0: 2d 74 69 6d 65 73 20 20 72 75 6e 6e 61 6d 65 20 -times runname
84b0: 74 61 72 67 65 74 20 29 29 29 0a 20 20 20 28 69 target ))). (i
84c0: 66 20 28 6e 6f 74 20 72 75 6e 6e 61 6d 65 29 0a f (not runname).
84d0: 20 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 (begin.
84e0: 20 20 20 28 70 72 69 6e 74 20 22 45 72 72 6f 72 (print "Error
84f0: 3a 20 4d 69 73 73 69 6e 67 20 61 72 67 75 6d 65 : Missing argume
8500: 6e 74 20 2d 72 75 6e 6e 61 6d 65 22 29 0a 20 20 nt -runname").
8510: 20 20 20 20 28 65 78 69 74 29 29 29 20 0a 20 20 (exit))) .
8520: 20 20 28 69 66 20 28 73 74 72 69 6e 67 2d 63 6f (if (string-co
8530: 6e 74 61 69 6e 73 20 72 75 6e 6e 61 6d 65 20 22 ntains runname "
8540: 25 22 29 0a 20 20 20 20 20 20 28 62 65 67 69 6e %"). (begin
8550: 0a 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 45 . (print "E
8560: 72 72 6f 72 3a 20 49 6e 76 61 6c 69 64 20 72 75 rror: Invalid ru
8570: 6e 6e 61 6d 65 2c 20 27 25 27 20 6e 6f 74 20 61 nname, '%' not a
8580: 6c 6c 6f 77 65 64 20 20 28 22 20 72 75 6e 6e 61 llowed (" runna
8590: 6d 65 20 22 29 20 22 29 0a 20 20 20 20 20 20 28 me ") "). (
85a0: 65 78 69 74 29 29 29 0a 20 20 20 20 28 69 66 20 exit))). (if
85b0: 28 6e 6f 74 20 74 61 72 67 65 74 29 0a 20 20 20 (not target).
85c0: 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 (begin.
85d0: 28 70 72 69 6e 74 20 22 45 72 72 6f 72 3a 20 4d (print "Error: M
85e0: 69 73 73 69 6e 67 20 61 72 67 75 6d 65 6e 74 20 issing argument
85f0: 2d 74 61 72 67 65 74 22 29 0a 20 20 20 20 20 20 -target").
8600: 28 65 78 69 74 29 29 29 0a 20 20 20 20 20 28 69 (exit))). (i
8610: 66 20 20 28 73 74 72 69 6e 67 2d 63 6f 6e 74 61 f (string-conta
8620: 69 6e 73 20 74 61 72 67 65 74 20 22 25 22 29 0a ins target "%").
8630: 20 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 (begin.
8640: 20 20 20 28 70 72 69 6e 74 20 22 45 72 72 6f 72 (print "Error
8650: 3a 20 49 6e 76 61 6c 69 64 20 74 61 72 67 65 74 : Invalid target
8660: 2c 20 27 25 27 20 6e 6f 74 20 61 6c 6c 6f 77 65 , '%' not allowe
8670: 64 20 20 28 22 20 74 61 72 67 65 74 20 22 29 20 d (" target ")
8680: 22 29 0a 20 20 20 20 20 20 28 65 78 69 74 29 29 "). (exit))
8690: 29 0a 20 0a 20 20 20 28 69 66 20 28 65 71 3f 20 ). . (if (eq?
86a0: 28 6c 65 6e 67 74 68 20 74 65 73 74 2d 74 69 6d (length test-tim
86b0: 65 73 29 20 30 29 0a 20 20 20 20 20 28 62 65 67 es) 0). (beg
86c0: 69 6e 0a 20 20 20 20 20 20 20 28 70 72 69 6e 74 in. (print
86d0: 20 22 44 61 74 61 20 6e 6f 74 20 66 6f 75 6e 64 "Data not found
86e0: 21 21 22 29 0a 20 20 20 20 20 20 20 28 65 78 69 !!"). (exi
86f0: 74 29 29 29 0a 20 20 20 28 69 66 20 28 65 71 75 t))). (if (equ
8700: 61 6c 3f 20 28 61 72 67 73 3a 67 65 74 2d 61 72 al? (args:get-ar
8710: 67 20 22 2d 64 75 6d 70 6d 6f 64 65 22 29 20 22 g "-dumpmode") "
8720: 6a 73 6f 6e 22 29 0a 20 20 20 20 20 20 20 28 74 json"). (t
8730: 61 73 6b 3a 70 72 69 6e 74 2d 74 65 73 74 74 69 ask:print-testti
8740: 6d 65 2d 61 73 2d 6a 73 6f 6e 20 74 65 73 74 2d me-as-json test-
8750: 74 69 6d 65 73 29 0a 20 20 20 20 20 20 20 20 20 times).
8760: 28 69 66 20 28 65 71 75 61 6c 3f 20 28 61 72 67 (if (equal? (arg
8770: 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 75 6d 70 s:get-arg "-dump
8780: 6d 6f 64 65 22 29 20 22 63 73 76 22 29 0a 09 20 mode") "csv")..
8790: 20 20 20 20 28 74 61 73 6b 3a 70 72 69 6e 74 2d (task:print-
87a0: 74 65 73 74 74 69 6d 65 20 74 65 73 74 2d 74 69 testtime test-ti
87b0: 6d 65 73 20 22 2c 22 29 0a 09 20 20 20 20 20 28 mes ",").. (
87c0: 74 61 73 6b 3a 70 72 69 6e 74 2d 74 65 73 74 74 task:print-testt
87d0: 69 6d 65 20 74 65 73 74 2d 74 69 6d 65 73 20 22 ime test-times "
87e0: 20 20 22 29 29 29 29 29 0a 0a 0a 0a 28 64 65 66 ")))))....(def
87f0: 69 6e 65 20 28 74 61 73 6b 73 3a 73 79 6e 63 2d ine (tasks:sync-
8800: 74 65 73 74 2d 73 74 65 70 73 20 64 62 68 20 63 test-steps dbh c
8810: 61 63 68 65 64 2d 69 6e 66 6f 20 74 65 73 74 2d ached-info test-
8820: 73 74 65 70 2d 69 64 73 20 73 6d 61 6c 6c 65 73 step-ids smalles
8830: 74 2d 6c 61 73 74 2d 75 70 64 61 74 65 2d 74 69 t-last-update-ti
8840: 6d 65 29 0a 20 3b 20 28 70 72 69 6e 74 20 22 53 me). ; (print "S
8850: 79 6e 63 20 53 74 65 70 73 20 22 20 74 65 73 74 ync Steps " test
8860: 2d 73 74 65 70 2d 69 64 73 20 29 0a 20 20 28 6c -step-ids ). (l
8870: 65 74 20 28 28 74 65 73 74 2d 68 74 20 28 68 61 et ((test-ht (ha
8880: 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 63 61 63 sh-table-ref cac
8890: 68 65 64 2d 69 6e 66 6f 20 27 74 65 73 74 73 29 hed-info 'tests)
88a0: 29 0a 20 20 20 20 20 20 20 20 28 73 74 65 70 2d ). (step-
88b0: 68 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 ht (hash-table-r
88c0: 65 66 20 63 61 63 68 65 64 2d 69 6e 66 6f 20 27 ef cached-info '
88d0: 73 74 65 70 73 29 29 29 0a 20 20 20 20 28 66 6f steps))). (fo
88e0: 72 2d 65 61 63 68 0a 20 20 20 20 20 28 6c 61 6d r-each. (lam
88f0: 62 64 61 20 28 74 65 73 74 2d 73 74 65 70 2d 69 bda (test-step-i
8900: 64 29 0a 20 20 20 20 20 20 20 20 28 6c 65 74 2a d). (let*
8910: 20 28 28 74 65 73 74 2d 73 74 65 70 2d 69 6e 66 ((test-step-inf
8920: 6f 20 20 28 72 6d 74 3a 67 65 74 2d 73 74 65 70 o (rmt:get-step
8930: 73 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 74 65 73 s-info-by-id tes
8940: 74 2d 73 74 65 70 2d 69 64 29 29 0a 20 20 20 20 t-step-id)).
8950: 20 20 20 20 20 20 20 20 20 20 20 28 73 74 65 70 (step
8960: 2d 69 64 20 28 74 64 62 3a 73 74 65 70 2d 67 65 -id (tdb:step-ge
8970: 74 2d 69 64 20 74 65 73 74 2d 73 74 65 70 2d 69 t-id test-step-i
8980: 6e 66 6f 29 29 0a 20 20 20 20 20 20 20 20 20 20 nfo)).
8990: 20 20 20 20 20 28 74 65 73 74 2d 69 64 20 20 28 (test-id (
89a0: 74 64 62 3a 73 74 65 70 2d 67 65 74 2d 74 65 73 tdb:step-get-tes
89b0: 74 5f 69 64 20 20 20 20 74 65 73 74 2d 73 74 65 t_id test-ste
89c0: 70 2d 69 6e 66 6f 29 29 20 20 20 0a 09 20 20 20 p-info)) ..
89d0: 20 20 20 20 28 73 74 65 70 6e 61 6d 65 20 28 74 (stepname (t
89e0: 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 65 70 db:step-get-step
89f0: 6e 61 6d 65 20 20 74 65 73 74 2d 73 74 65 70 2d name test-step-
8a00: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
8a10: 73 74 61 74 65 20 28 74 64 62 3a 73 74 65 70 2d state (tdb:step-
8a20: 67 65 74 2d 73 74 61 74 65 20 74 65 73 74 2d 73 get-state test-s
8a30: 74 65 70 2d 69 6e 66 6f 29 29 09 0a 09 20 20 20 tep-info))...
8a40: 20 20 20 20 28 73 74 61 74 75 73 20 28 74 64 62 (status (tdb
8a50: 3a 73 74 65 70 2d 67 65 74 2d 73 74 61 74 75 73 :step-get-status
8a60: 20 74 65 73 74 2d 73 74 65 70 2d 69 6e 66 6f 29 test-step-info)
8a70: 29 09 0a 09 20 20 20 20 20 20 20 28 65 76 65 6e )... (even
8a80: 74 5f 74 69 6d 65 20 28 74 64 62 3a 73 74 65 70 t_time (tdb:step
8a90: 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 -get-event_time
8aa0: 20 74 65 73 74 2d 73 74 65 70 2d 69 6e 66 6f 29 test-step-info)
8ab0: 29 09 0a 09 20 20 20 20 20 20 20 28 63 6f 6d 6d )... (comm
8ac0: 65 6e 74 20 20 28 74 64 62 3a 73 74 65 70 2d 67 ent (tdb:step-g
8ad0: 65 74 2d 63 6f 6d 6d 65 6e 74 20 74 65 73 74 2d et-comment test-
8ae0: 73 74 65 70 2d 69 6e 66 6f 29 29 09 0a 09 20 20 step-info))...
8af0: 20 20 20 20 20 28 6c 6f 67 66 69 6c 65 20 28 74 (logfile (t
8b00: 64 62 3a 73 74 65 70 2d 67 65 74 2d 6c 6f 67 66 db:step-get-logf
8b10: 69 6c 65 20 74 65 73 74 2d 73 74 65 70 2d 69 6e ile test-step-in
8b20: 66 6f 29 29 09 0a 20 20 20 20 20 20 20 20 20 28 fo)).. (
8b30: 6c 61 73 74 2d 75 70 64 61 74 65 20 28 74 64 62 last-update (tdb
8b40: 3a 73 74 65 70 2d 67 65 74 2d 6c 61 73 74 5f 75 :step-get-last_u
8b50: 70 64 61 74 65 20 74 65 73 74 2d 73 74 65 70 2d pdate test-step-
8b60: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
8b70: 70 67 64 62 2d 74 65 73 74 2d 69 64 20 20 28 68 pgdb-test-id (h
8b80: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
8b90: 66 61 75 6c 74 20 74 65 73 74 2d 68 74 20 74 65 fault test-ht te
8ba0: 73 74 2d 69 64 20 23 66 29 29 0a 09 09 09 09 20 st-id #f)).....
8bb0: 28 73 6d 61 6c 6c 65 73 74 2d 74 69 6d 65 20 28 (smallest-time (
8bc0: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
8bd0: 65 66 61 75 6c 74 20 73 6d 61 6c 6c 65 73 74 2d efault smallest-
8be0: 6c 61 73 74 2d 75 70 64 61 74 65 2d 74 69 6d 65 last-update-time
8bf0: 20 22 73 6d 61 6c 6c 65 73 74 2d 74 69 6d 65 22 "smallest-time"
8c00: 20 23 66 29 29 0a 20 20 20 20 20 20 20 20 20 28 #f)). (
8c10: 70 67 64 62 2d 73 74 65 70 2d 69 64 20 28 69 66 pgdb-step-id (if
8c20: 20 70 67 64 62 2d 74 65 73 74 2d 69 64 20 0a 20 pgdb-test-id .
8c30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8c40: 20 20 20 20 20 20 20 20 28 70 67 64 62 3a 67 65 (pgdb:ge
8c50: 74 2d 74 65 73 74 2d 73 74 65 70 2d 69 64 20 64 t-test-step-id d
8c60: 62 68 20 70 67 64 62 2d 74 65 73 74 2d 69 64 20 bh pgdb-test-id
8c70: 73 74 65 70 6e 61 6d 65 20 73 74 61 74 65 29 0a stepname state).
8c80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8c90: 20 20 20 20 20 20 20 20 20 20 23 66 29 29 29 0a #f))).
8ca0: 20 20 20 20 28 69 66 20 73 74 65 70 2d 69 64 0a (if step-id.
8cb0: 20 20 20 20 20 20 28 62 65 67 69 6e 20 20 0a 20 (begin .
8cc0: 20 20 20 20 20 20 20 28 69 66 20 70 67 64 62 2d (if pgdb-
8cd0: 74 65 73 74 2d 69 64 0a 20 20 20 20 20 20 20 20 test-id.
8ce0: 20 20 20 28 62 65 67 69 6e 20 0a 20 20 20 20 20 (begin .
8cf0: 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 20 (if
8d00: 70 67 64 62 2d 73 74 65 70 2d 69 64 0a 20 20 20 pgdb-step-id.
8d10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8d20: 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 (begin.
8d30: 20 20 20 20 20 20 20 20 20 20 20 28 64 65 62 75 (debu
8d40: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 34 20 2a g:print-info 4 *
8d50: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
8d60: 2a 20 20 22 55 70 64 61 74 69 6e 67 20 65 78 69 * "Updating exi
8d70: 73 74 69 6e 67 20 74 65 73 74 2d 73 74 65 70 20 sting test-step
8d80: 77 69 74 68 20 74 65 73 74 2d 69 64 3a 20 22 20 with test-id: "
8d90: 74 65 73 74 2d 69 64 20 22 20 61 6e 64 20 73 74 test-id " and st
8da0: 65 70 2d 69 64 20 22 20 73 74 65 70 2d 69 64 20 ep-id " step-id
8db0: 22 20 70 67 64 62 20 74 65 73 74 20 69 64 3a 20 " pgdb test id:
8dc0: 22 20 70 67 64 62 2d 74 65 73 74 2d 69 64 20 22 " pgdb-test-id "
8dd0: 20 70 67 64 62 20 73 74 65 70 20 69 64 20 22 20 pgdb step id "
8de0: 70 67 64 62 2d 73 74 65 70 2d 69 64 20 29 0a 09 pgdb-step-id )..
8df0: 09 09 09 09 09 09 09 09 09 28 6c 65 74 2a 20 28 .........(let* (
8e00: 28 70 67 64 62 2d 6c 61 73 74 2d 75 70 64 61 74 (pgdb-last-updat
8e10: 65 20 28 70 67 64 62 3a 67 65 74 2d 74 65 73 74 e (pgdb:get-test
8e20: 2d 73 74 65 70 2d 6c 61 73 74 2d 75 70 64 61 74 -step-last-updat
8e30: 65 20 64 62 68 20 70 67 64 62 2d 73 74 65 70 2d e dbh pgdb-step-
8e40: 69 64 29 29 29 0a 20 20 20 20 20 20 20 20 20 28 id))). (
8e50: 69 66 20 28 61 6e 64 20 20 28 3e 20 6c 61 73 74 if (and (> last
8e60: 2d 75 70 64 61 74 65 20 70 67 64 62 2d 6c 61 73 -update pgdb-las
8e70: 74 2d 75 70 64 61 74 65 29 20 28 6f 72 20 28 6e t-update) (or (n
8e80: 6f 74 20 73 6d 61 6c 6c 65 73 74 2d 74 69 6d 65 ot smallest-time
8e90: 29 20 28 3c 20 6c 61 73 74 2d 75 70 64 61 74 65 ) (< last-update
8ea0: 20 73 6d 61 6c 6c 65 73 74 2d 74 69 6d 65 29 29 smallest-time))
8eb0: 29 0a 20 20 20 20 20 20 20 20 28 68 61 73 68 2d ). (hash-
8ec0: 74 61 62 6c 65 2d 73 65 74 21 20 73 6d 61 6c 6c table-set! small
8ed0: 65 73 74 2d 6c 61 73 74 2d 75 70 64 61 74 65 2d est-last-update-
8ee0: 74 69 6d 65 20 22 73 6d 61 6c 6c 65 73 74 2d 74 time "smallest-t
8ef0: 69 6d 65 22 20 6c 61 73 74 2d 75 70 64 61 74 65 ime" last-update
8f00: 29 29 29 20 0a 20 20 20 20 20 20 20 20 20 20 20 ))) .
8f10: 20 20 20 20 20 20 20 20 20 28 70 67 64 62 3a 75 (pgdb:u
8f20: 70 64 61 74 65 2d 74 65 73 74 2d 73 74 65 70 20 pdate-test-step
8f30: 64 62 68 20 70 67 64 62 2d 73 74 65 70 2d 69 64 dbh pgdb-step-id
8f40: 20 70 67 64 62 2d 74 65 73 74 2d 69 64 20 73 74 pgdb-test-id st
8f50: 65 70 6e 61 6d 65 20 73 74 61 74 65 20 73 74 61 epname state sta
8f60: 74 75 73 20 65 76 65 6e 74 5f 74 69 6d 65 20 63 tus event_time c
8f70: 6f 6d 6d 65 6e 74 20 6c 6f 67 66 69 6c 65 20 6c omment logfile l
8f80: 61 73 74 2d 75 70 64 61 74 65 29 29 0a 20 20 20 ast-update)).
8f90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8fa0: 20 28 62 65 67 69 6e 0a 20 09 09 20 20 20 20 20 (begin. ..
8fb0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
8fc0: 66 6f 20 34 20 2a 64 65 66 61 75 6c 74 2d 6c 6f fo 4 *default-lo
8fd0: 67 2d 70 6f 72 74 2a 20 20 22 49 6e 73 65 72 74 g-port* "Insert
8fe0: 69 6e 67 20 74 65 73 74 2d 73 74 65 70 20 77 69 ing test-step wi
8ff0: 74 68 20 74 65 73 74 2d 69 64 3a 20 22 20 74 65 th test-id: " te
9000: 73 74 2d 69 64 20 22 20 61 6e 64 20 73 74 65 70 st-id " and step
9010: 2d 69 64 20 22 20 73 74 65 70 2d 69 64 20 20 22 -id " step-id "
9020: 20 70 67 64 62 20 74 65 73 74 20 69 64 3a 20 22 pgdb test id: "
9030: 20 70 67 64 62 2d 74 65 73 74 2d 69 64 29 0a 20 pgdb-test-id).
9040: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9050: 20 20 20 20 28 69 66 20 28 6f 72 20 28 6e 6f 74 (if (or (not
9060: 20 73 6d 61 6c 6c 65 73 74 2d 74 69 6d 65 29 20 smallest-time)
9070: 28 3c 20 6c 61 73 74 2d 75 70 64 61 74 65 20 73 (< last-update s
9080: 6d 61 6c 6c 65 73 74 2d 74 69 6d 65 29 29 0a 20 mallest-time)).
9090: 20 20 20 20 20 20 20 09 09 09 09 20 20 20 20 20 ....
90a0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set
90b0: 21 20 73 6d 61 6c 6c 65 73 74 2d 6c 61 73 74 2d ! smallest-last-
90c0: 75 70 64 61 74 65 2d 74 69 6d 65 20 22 73 6d 61 update-time "sma
90d0: 6c 6c 65 73 74 2d 74 69 6d 65 22 20 6c 61 73 74 llest-time" last
90e0: 2d 75 70 64 61 74 65 29 29 0a 20 20 20 20 20 20 -update)).
90f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9100: 28 70 67 64 62 3a 69 6e 73 65 72 74 2d 74 65 73 (pgdb:insert-tes
9110: 74 2d 73 74 65 70 20 64 62 68 20 70 67 64 62 2d t-step dbh pgdb-
9120: 74 65 73 74 2d 69 64 20 73 74 65 70 6e 61 6d 65 test-id stepname
9130: 20 73 74 61 74 65 20 73 74 61 74 75 73 20 65 76 state status ev
9140: 65 6e 74 5f 74 69 6d 65 20 63 6f 6d 6d 65 6e 74 ent_time comment
9150: 20 6c 6f 67 66 69 6c 65 20 6c 61 73 74 2d 75 70 logfile last-up
9160: 64 61 74 65 20 29 0a 20 20 20 20 20 20 20 20 20 date ).
9170: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 65 (se
9180: 74 21 20 70 67 64 62 2d 73 74 65 70 2d 69 64 20 t! pgdb-step-id
9190: 20 28 70 67 64 62 3a 67 65 74 2d 74 65 73 74 2d (pgdb:get-test-
91a0: 73 74 65 70 2d 69 64 20 64 62 68 20 70 67 64 62 step-id dbh pgdb
91b0: 2d 74 65 73 74 2d 69 64 20 73 74 65 70 6e 61 6d -test-id stepnam
91c0: 65 20 73 74 61 74 65 29 29 29 29 0a 20 20 20 20 e state)))).
91d0: 20 20 20 20 20 20 20 20 20 20 20 20 28 68 61 73 (has
91e0: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 73 74 65 h-table-set! ste
91f0: 70 2d 68 74 20 73 74 65 70 2d 69 64 20 70 67 64 p-ht step-id pgd
9200: 62 2d 73 74 65 70 2d 69 64 20 29 29 0a 20 20 20 b-step-id )).
9210: 20 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 (debug:p
9220: 72 69 6e 74 2d 69 6e 66 6f 20 31 20 2a 64 65 66 rint-info 1 *def
9230: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 20 ault-log-port*
9240: 22 45 72 72 6f 72 3a 20 54 65 73 74 20 6e 6f 74 "Error: Test not
9250: 20 63 61 73 68 65 64 22 29 29 29 0a 20 20 20 20 cashed"))).
9260: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
9270: 6e 66 6f 20 31 20 2a 64 65 66 61 75 6c 74 2d 6c nfo 1 *default-l
9280: 6f 67 2d 70 6f 72 74 2a 20 20 22 45 72 72 6f 72 og-port* "Error
9290: 3a 20 43 6f 75 6c 64 20 6e 6f 74 20 67 65 74 20 : Could not get
92a0: 74 65 73 74 20 73 74 65 70 20 69 6e 66 6f 20 66 test step info f
92b0: 6f 72 20 73 74 65 70 20 69 64 20 22 20 74 65 73 or step id " tes
92c0: 74 2d 73 74 65 70 2d 69 64 20 29 29 29 29 09 3b t-step-id )))).;
92d0: 3b 20 74 68 69 73 20 69 73 20 61 20 77 69 65 72 ; this is a wier
92e0: 64 20 73 65 6e 61 72 69 6f 20 6e 65 65 64 20 74 d senario need t
92f0: 6f 20 64 65 62 75 67 20 20 20 20 20 20 09 0a 20 o debug ..
9300: 20 20 74 65 73 74 2d 73 74 65 70 2d 69 64 73 29 test-step-ids)
9310: 29 29 0a 0a 0a 28 64 65 66 69 6e 65 20 28 74 61 ))...(define (ta
9320: 73 6b 73 3a 73 79 6e 63 2d 74 65 73 74 73 2d 64 sks:sync-tests-d
9330: 61 74 61 20 64 62 68 20 63 61 63 68 65 64 2d 69 ata dbh cached-i
9340: 6e 66 6f 20 74 65 73 74 2d 69 64 73 20 61 72 65 nfo test-ids are
9350: 61 2d 69 6e 66 6f 20 73 6d 61 6c 6c 65 73 74 2d a-info smallest-
9360: 6c 61 73 74 2d 75 70 64 61 74 65 2d 74 69 6d 65 last-update-time
9370: 29 0a 20 20 28 6c 65 74 20 28 28 74 65 73 74 2d ). (let ((test-
9380: 68 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 ht (hash-table-r
9390: 65 66 20 63 61 63 68 65 64 2d 69 6e 66 6f 20 27 ef cached-info '
93a0: 74 65 73 74 73 29 29 29 0a 20 20 20 20 28 66 6f tests))). (fo
93b0: 72 2d 65 61 63 68 0a 20 20 20 20 20 28 6c 61 6d r-each. (lam
93c0: 62 64 61 20 28 74 65 73 74 2d 69 64 29 0a 20 20 bda (test-id).
93d0: 20 20 20 20 3b 20 28 70 72 69 6e 74 20 74 65 73 ; (print tes
93e0: 74 2d 69 64 29 0a 20 20 20 20 20 20 20 28 6c 65 t-id). (le
93f0: 74 2a 20 28 28 74 65 73 74 2d 69 6e 66 6f 20 20 t* ((test-info
9400: 20 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 2d (rmt:get-test-
9410: 69 6e 66 6f 2d 62 79 2d 69 64 20 23 66 20 74 65 info-by-id #f te
9420: 73 74 2d 69 64 29 29 0a 09 20 20 20 20 20 20 28 st-id)).. (
9430: 72 75 6e 2d 69 64 20 20 20 20 20 20 20 28 64 62 run-id (db
9440: 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 5f 69 64 :test-get-run_id
9450: 20 20 20 20 74 65 73 74 2d 69 6e 66 6f 29 29 20 test-info))
9460: 3b 3b 20 6c 6f 6f 6b 20 74 68 65 73 65 20 75 70 ;; look these up
9470: 20 69 6e 20 64 62 5f 72 65 63 6f 72 64 73 2e 73 in db_records.s
9480: 63 6d 0a 09 20 20 20 20 20 20 28 74 65 73 74 2d cm.. (test-
9490: 69 64 20 20 20 20 20 20 28 64 62 3a 74 65 73 74 id (db:test
94a0: 2d 67 65 74 2d 69 64 20 20 20 20 20 20 20 20 74 -get-id t
94b0: 65 73 74 2d 69 6e 66 6f 29 29 0a 09 20 20 20 20 est-info))..
94c0: 20 20 28 74 65 73 74 2d 6e 61 6d 65 20 20 20 20 (test-name
94d0: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 73 (db:test-get-tes
94e0: 74 6e 61 6d 65 20 20 74 65 73 74 2d 69 6e 66 6f tname test-info
94f0: 29 29 0a 09 20 20 20 20 20 20 28 69 74 65 6d 2d )).. (item-
9500: 70 61 74 68 20 20 20 20 28 64 62 3a 74 65 73 74 path (db:test
9510: 2d 67 65 74 2d 69 74 65 6d 2d 70 61 74 68 20 74 -get-item-path t
9520: 65 73 74 2d 69 6e 66 6f 29 29 0a 09 20 20 20 20 est-info))..
9530: 20 20 28 73 74 61 74 65 20 20 20 20 20 20 20 20 (state
9540: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 (db:test-get-sta
9550: 74 65 20 20 20 20 20 74 65 73 74 2d 69 6e 66 6f te test-info
9560: 29 29 0a 09 20 20 20 20 20 20 28 73 74 61 74 75 )).. (statu
9570: 73 20 20 20 20 20 20 20 28 64 62 3a 74 65 73 74 s (db:test
9580: 2d 67 65 74 2d 73 74 61 74 75 73 20 20 20 20 74 -get-status t
9590: 65 73 74 2d 69 6e 66 6f 29 29 0a 09 20 20 20 20 est-info))..
95a0: 20 20 28 68 6f 73 74 20 20 20 20 20 20 20 20 20 (host
95b0: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 68 6f 73 (db:test-get-hos
95c0: 74 20 20 20 20 20 20 74 65 73 74 2d 69 6e 66 6f t test-info
95d0: 29 29 0a 20 20 20 20 20 20 20 20 28 70 69 64 20 )). (pid
95e0: 20 20 20 20 20 20 20 20 20 28 64 62 3a 74 65 73 (db:tes
95f0: 74 2d 67 65 74 2d 70 72 6f 63 65 73 73 5f 69 64 t-get-process_id
9600: 20 74 65 73 74 2d 69 6e 66 6f 29 29 20 0a 09 20 test-info)) ..
9610: 20 20 20 20 20 28 63 70 75 6c 6f 61 64 20 20 20 (cpuload
9620: 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d (db:test-get-
9630: 63 70 75 6c 6f 61 64 20 20 20 74 65 73 74 2d 69 cpuload test-i
9640: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 28 64 69 nfo)).. (di
9650: 73 6b 66 72 65 65 20 20 20 20 20 28 64 62 3a 74 skfree (db:t
9660: 65 73 74 2d 67 65 74 2d 64 69 73 6b 66 72 65 65 est-get-diskfree
9670: 20 20 74 65 73 74 2d 69 6e 66 6f 29 29 0a 09 20 test-info))..
9680: 20 20 20 20 20 28 75 6e 61 6d 65 20 20 20 20 20 (uname
9690: 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d (db:test-get-
96a0: 75 6e 61 6d 65 20 20 20 20 20 74 65 73 74 2d 69 uname test-i
96b0: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 28 72 75 nfo)).. (ru
96c0: 6e 2d 64 69 72 20 20 20 20 20 20 28 64 62 3a 74 n-dir (db:t
96d0: 65 73 74 2d 67 65 74 2d 72 75 6e 64 69 72 20 20 est-get-rundir
96e0: 20 20 74 65 73 74 2d 69 6e 66 6f 29 29 0a 09 20 test-info))..
96f0: 20 20 20 20 20 28 6c 6f 67 2d 66 69 6c 65 20 20 (log-file
9700: 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d (db:test-get-
9710: 66 69 6e 61 6c 5f 6c 6f 67 66 20 74 65 73 74 2d final_logf test-
9720: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 28 72 info)).. (r
9730: 75 6e 2d 64 75 72 61 74 69 6f 6e 20 28 64 62 3a un-duration (db:
9740: 74 65 73 74 2d 67 65 74 2d 72 75 6e 5f 64 75 72 test-get-run_dur
9750: 61 74 69 6f 6e 20 74 65 73 74 2d 69 6e 66 6f 29 ation test-info)
9760: 29 0a 09 20 20 20 20 20 20 28 63 6f 6d 6d 65 6e ).. (commen
9770: 74 20 20 20 20 20 20 28 64 62 3a 74 65 73 74 2d t (db:test-
9780: 67 65 74 2d 63 6f 6d 6d 65 6e 74 20 20 20 74 65 get-comment te
9790: 73 74 2d 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 st-info))..
97a0: 20 28 65 76 65 6e 74 2d 74 69 6d 65 20 20 20 28 (event-time (
97b0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 65 76 65 6e db:test-get-even
97c0: 74 5f 74 69 6d 65 20 74 65 73 74 2d 69 6e 66 6f t_time test-info
97d0: 29 29 0a 09 20 20 20 20 20 20 28 61 72 63 68 69 )).. (archi
97e0: 76 65 64 20 20 20 20 20 28 64 62 3a 74 65 73 74 ved (db:test
97f0: 2d 67 65 74 2d 61 72 63 68 69 76 65 64 20 20 74 -get-archived t
9800: 65 73 74 2d 69 6e 66 6f 29 29 0a 20 20 20 20 20 est-info)).
9810: 20 20 20 28 6c 61 73 74 2d 75 70 64 61 74 65 20 (last-update
9820: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 6c 61 (db:test-get-la
9830: 73 74 5f 75 70 64 61 74 65 20 20 74 65 73 74 2d st_update test-
9840: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 28 70 info)).. (p
9850: 67 64 62 2d 72 75 6e 2d 69 64 20 20 28 74 61 73 gdb-run-id (tas
9860: 6b 73 3a 72 75 6e 2d 69 64 2d 3e 6d 74 70 67 2d ks:run-id->mtpg-
9870: 72 75 6e 2d 69 64 20 64 62 68 20 63 61 63 68 65 run-id dbh cache
9880: 64 2d 69 6e 66 6f 20 72 75 6e 2d 69 64 20 61 72 d-info run-id ar
9890: 65 61 2d 69 6e 66 6f 20 73 6d 61 6c 6c 65 73 74 ea-info smallest
98a0: 2d 6c 61 73 74 2d 75 70 64 61 74 65 2d 74 69 6d -last-update-tim
98b0: 65 29 29 0a 20 20 20 20 20 20 20 20 28 73 6d 61 e)). (sma
98c0: 6c 6c 65 73 74 2d 74 69 6d 65 20 28 68 61 73 68 llest-time (hash
98d0: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
98e0: 6c 74 20 73 6d 61 6c 6c 65 73 74 2d 6c 61 73 74 lt smallest-last
98f0: 2d 75 70 64 61 74 65 2d 74 69 6d 65 20 22 73 6d -update-time "sm
9900: 61 6c 6c 65 73 74 2d 74 69 6d 65 22 20 23 66 29 allest-time" #f)
9910: 29 20 20 20 20 20 20 20 0a 09 20 20 20 20 20 20 ) ..
9920: 28 70 67 64 62 2d 74 65 73 74 2d 69 64 20 28 69 (pgdb-test-id (i
9930: 66 20 70 67 64 62 2d 72 75 6e 2d 69 64 20 0a 09 f pgdb-run-id ..
9940: 09 09 09 28 62 65 67 69 6e 0a 20 20 20 20 20 20 ...(begin.
9950: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9960: 20 20 20 20 20 20 20 20 20 20 20 20 3b 28 70 72 ;(pr
9970: 69 6e 74 20 70 67 64 62 2d 72 75 6e 2d 69 64 29 int pgdb-run-id)
9980: 20 20 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 .
9990: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
99a0: 20 20 20 20 20 20 28 70 67 64 62 3a 67 65 74 2d (pgdb:get-
99b0: 74 65 73 74 2d 69 64 20 64 62 68 20 70 67 64 62 test-id dbh pgdb
99c0: 2d 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d -run-id test-nam
99d0: 65 20 69 74 65 6d 2d 70 61 74 68 29 29 0a 20 20 e item-path)).
99e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
99f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 23 #
9a00: 66 29 29 29 0a 09 20 3b 3b 20 22 69 64 22 20 20 f))).. ;; "id"
9a10: 20 20 20 20 20 20 20 20 20 22 72 75 6e 5f 69 64 "run_id
9a20: 22 20 20 20 20 20 20 20 20 22 74 65 73 74 6e 61 " "testna
9a30: 6d 65 22 20 20 22 73 74 61 74 65 22 20 20 20 20 me" "state"
9a40: 20 20 22 73 74 61 74 75 73 22 20 20 20 20 20 20 "status"
9a50: 22 65 76 65 6e 74 5f 74 69 6d 65 22 0a 09 20 3b "event_time".. ;
9a60: 3b 20 22 68 6f 73 74 22 20 20 20 20 20 20 20 20 ; "host"
9a70: 20 22 63 70 75 6c 6f 61 64 22 20 20 20 20 20 20 "cpuload"
9a80: 20 22 64 69 73 6b 66 72 65 65 22 20 20 22 75 6e "diskfree" "un
9a90: 61 6d 65 22 20 20 20 20 20 20 22 72 75 6e 64 69 ame" "rundi
9aa0: 72 22 20 20 20 20 20 20 22 69 74 65 6d 5f 70 61 r" "item_pa
9ab0: 74 68 22 0a 09 20 3b 3b 20 22 72 75 6e 5f 64 75 th".. ;; "run_du
9ac0: 72 61 74 69 6f 6e 22 20 22 66 69 6e 61 6c 5f 6c ration" "final_l
9ad0: 6f 67 66 22 20 20 20 20 22 63 6f 6d 6d 65 6e 74 ogf" "comment
9ae0: 22 20 20 20 22 73 68 6f 72 74 64 69 72 22 20 20 " "shortdir"
9af0: 20 22 61 74 74 65 6d 70 74 6e 75 6d 22 20 20 22 "attemptnum" "
9b00: 61 72 63 68 69 76 65 64 22 0a 20 20 20 20 20 20 archived".
9b10: 20 20 20 28 69 66 20 28 6f 72 20 28 6e 6f 74 20 (if (or (not
9b20: 69 74 65 6d 2d 70 61 74 68 29 20 28 73 74 72 69 item-path) (stri
9b30: 6e 67 2d 6e 75 6c 6c 3f 20 69 74 65 6d 2d 70 61 ng-null? item-pa
9b40: 74 68 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 th)).
9b50: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
9b60: 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c nfo 0 *default-l
9b70: 6f 67 2d 70 6f 72 74 2a 20 22 57 6f 72 6b 69 6e og-port* "Workin
9b80: 67 20 6f 6e 20 52 75 6e 20 69 64 20 3a 20 22 20 g on Run id : "
9b90: 72 75 6e 2d 69 64 20 22 61 6e 64 20 74 65 73 74 run-id "and test
9ba0: 20 6e 61 6d 65 20 3a 20 22 20 74 65 73 74 2d 6e name : " test-n
9bb0: 61 6d 65 29 29 20 0a 20 20 20 20 20 20 20 20 20 ame)) .
9bc0: 28 69 66 20 70 67 64 62 2d 72 75 6e 2d 69 64 0a (if pgdb-run-id.
9bd0: 20 20 20 20 20 20 20 20 20 20 20 28 62 65 67 69 (begi
9be0: 6e 0a 09 20 20 20 28 69 66 20 70 67 64 62 2d 74 n.. (if pgdb-t
9bf0: 65 73 74 2d 69 64 20 3b 3b 20 68 61 76 65 20 61 est-id ;; have a
9c00: 20 72 65 63 6f 72 64 0a 09 20 20 20 20 20 28 62 record.. (b
9c10: 65 67 69 6e 20 3b 3b 20 6c 65 74 20 28 28 6b 65 egin ;; let ((ke
9c20: 79 2d 6e 61 6d 65 20 28 63 6f 6e 63 20 72 75 6e y-name (conc run
9c30: 2d 69 64 20 22 2f 22 20 74 65 73 74 2d 6e 61 6d -id "/" test-nam
9c40: 65 20 22 2f 22 20 69 74 65 6d 2d 70 61 74 68 29 e "/" item-path)
9c50: 29 29 0a 09 20 20 20 20 20 20 20 28 64 65 62 75 )).. (debu
9c60: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 34 20 2a g:print-info 4 *
9c70: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
9c80: 2a 20 20 22 55 70 64 61 74 69 6e 67 20 65 78 69 * "Updating exi
9c90: 73 74 69 6e 67 20 74 65 73 74 20 77 69 74 68 20 sting test with
9ca0: 72 75 6e 2d 69 64 3a 20 22 20 72 75 6e 2d 69 64 run-id: " run-id
9cb0: 20 22 20 61 6e 64 20 74 65 73 74 2d 69 64 3a 20 " and test-id:
9cc0: 22 20 74 65 73 74 2d 69 64 20 22 20 70 67 64 62 " test-id " pgdb
9cd0: 20 72 75 6e 20 69 64 3a 20 22 20 70 67 64 62 2d run id: " pgdb-
9ce0: 72 75 6e 2d 69 64 20 22 20 20 70 67 64 62 2d 74 run-id " pgdb-t
9cf0: 65 73 74 2d 69 64 20 22 20 20 70 67 64 62 2d 74 est-id " pgdb-t
9d00: 65 73 74 2d 69 64 29 0a 20 20 20 20 20 20 20 20 est-id).
9d10: 20 28 6c 65 74 2a 20 28 28 70 67 64 62 2d 6c 61 (let* ((pgdb-la
9d20: 73 74 2d 75 70 64 61 74 65 20 28 70 67 64 62 3a st-update (pgdb:
9d30: 67 65 74 2d 74 65 73 74 2d 6c 61 73 74 2d 75 70 get-test-last-up
9d40: 64 61 74 65 20 64 62 68 20 70 67 64 62 2d 74 65 date dbh pgdb-te
9d50: 73 74 2d 69 64 29 29 29 0a 20 20 20 20 20 20 20 st-id))).
9d60: 20 20 28 69 66 20 28 61 6e 64 20 20 28 3e 20 20 (if (and (>
9d70: 6c 61 73 74 2d 75 70 64 61 74 65 20 70 67 64 62 last-update pgdb
9d80: 2d 6c 61 73 74 2d 75 70 64 61 74 65 29 20 28 6f -last-update) (o
9d90: 72 20 28 6e 6f 74 20 73 6d 61 6c 6c 65 73 74 2d r (not smallest-
9da0: 74 69 6d 65 29 20 28 3c 20 6c 61 73 74 2d 75 70 time) (< last-up
9db0: 64 61 74 65 20 73 6d 61 6c 6c 65 73 74 2d 74 69 date smallest-ti
9dc0: 6d 65 29 29 29 20 3b 3b 69 66 20 6c 61 73 74 2d me))) ;;if last-
9dd0: 75 70 64 61 74 65 20 69 73 20 73 61 6d 65 20 61 update is same a
9de0: 73 20 70 67 64 62 2d 6c 61 73 74 2d 75 70 64 61 s pgdb-last-upda
9df0: 74 65 20 74 68 65 6e 20 69 74 20 69 73 20 73 61 te then it is sa
9e00: 66 65 20 74 6f 20 61 73 73 75 6d 65 20 74 68 65 fe to assume the
9e10: 20 72 65 63 6f 72 64 73 20 61 72 65 20 69 64 65 records are ide
9e20: 6e 74 69 63 61 6c 20 61 6e 64 20 77 65 20 63 61 ntical and we ca
9e30: 6e 20 75 73 65 20 61 20 6c 61 72 67 65 72 20 6c n use a larger l
9e40: 61 73 74 20 75 70 64 61 74 65 20 74 69 6d 65 2e ast update time.
9e50: 0a 20 20 20 20 20 20 20 20 28 68 61 73 68 2d 74 . (hash-t
9e60: 61 62 6c 65 2d 73 65 74 21 20 73 6d 61 6c 6c 65 able-set! smalle
9e70: 73 74 2d 6c 61 73 74 2d 75 70 64 61 74 65 2d 74 st-last-update-t
9e80: 69 6d 65 20 22 73 6d 61 6c 6c 65 73 74 2d 74 69 ime "smallest-ti
9e90: 6d 65 22 20 6c 61 73 74 2d 75 70 64 61 74 65 29 me" last-update)
9ea0: 29 29 20 0a 09 20 20 20 20 20 20 20 28 70 67 64 )) .. (pgd
9eb0: 62 3a 75 70 64 61 74 65 2d 74 65 73 74 20 64 62 b:update-test db
9ec0: 68 20 70 67 64 62 2d 74 65 73 74 2d 69 64 20 70 h pgdb-test-id p
9ed0: 67 64 62 2d 72 75 6e 2d 69 64 20 74 65 73 74 2d gdb-run-id test-
9ee0: 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 20 73 name item-path s
9ef0: 74 61 74 65 20 73 74 61 74 75 73 20 68 6f 73 74 tate status host
9f00: 20 63 70 75 6c 6f 61 64 20 64 69 73 6b 66 72 65 cpuload diskfre
9f10: 65 20 75 6e 61 6d 65 20 72 75 6e 2d 64 69 72 20 e uname run-dir
9f20: 6c 6f 67 2d 66 69 6c 65 20 72 75 6e 2d 64 75 72 log-file run-dur
9f30: 61 74 69 6f 6e 20 63 6f 6d 6d 65 6e 74 20 65 76 ation comment ev
9f40: 65 6e 74 2d 74 69 6d 65 20 61 72 63 68 69 76 65 ent-time archive
9f50: 64 20 6c 61 73 74 2d 75 70 64 61 74 65 20 70 69 d last-update pi
9f60: 64 29 29 0a 09 20 20 20 20 20 28 62 65 67 69 6e d)).. (begin
9f70: 20 0a 20 20 20 20 20 20 20 20 20 20 20 28 64 65 . (de
9f80: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 34 bug:print-info 4
9f90: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
9fa0: 72 74 2a 20 20 22 49 6e 73 65 72 74 69 6e 67 20 rt* "Inserting
9fb0: 74 65 73 74 20 77 69 74 68 20 72 75 6e 2d 69 64 test with run-id
9fc0: 3a 20 22 20 72 75 6e 2d 69 64 20 22 20 61 6e 64 : " run-id " and
9fd0: 20 74 65 73 74 2d 69 64 3a 20 22 20 74 65 73 74 test-id: " test
9fe0: 2d 69 64 20 20 22 20 70 67 64 62 20 72 75 6e 20 -id " pgdb run
9ff0: 69 64 3a 20 22 20 70 67 64 62 2d 72 75 6e 2d 69 id: " pgdb-run-i
a000: 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 70 d). (p
a010: 67 64 62 3a 69 6e 73 65 72 74 2d 74 65 73 74 20 gdb:insert-test
a020: 64 62 68 20 70 67 64 62 2d 72 75 6e 2d 69 64 20 dbh pgdb-run-id
a030: 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 test-name item-p
a040: 61 74 68 20 73 74 61 74 65 20 73 74 61 74 75 73 ath state status
a050: 20 68 6f 73 74 20 63 70 75 6c 6f 61 64 20 64 69 host cpuload di
a060: 73 6b 66 72 65 65 20 75 6e 61 6d 65 20 72 75 6e skfree uname run
a070: 2d 64 69 72 20 6c 6f 67 2d 66 69 6c 65 20 72 75 -dir log-file ru
a080: 6e 2d 64 75 72 61 74 69 6f 6e 20 63 6f 6d 6d 65 n-duration comme
a090: 6e 74 20 65 76 65 6e 74 2d 74 69 6d 65 20 61 72 nt event-time ar
a0a0: 63 68 69 76 65 64 20 6c 61 73 74 2d 75 70 64 61 chived last-upda
a0b0: 74 65 20 70 69 64 29 0a 20 20 20 20 20 20 20 20 te pid).
a0c0: 20 20 20 20 28 69 66 20 28 6f 72 20 28 6e 6f 74 (if (or (not
a0d0: 20 73 6d 61 6c 6c 65 73 74 2d 74 69 6d 65 29 20 smallest-time)
a0e0: 28 3c 20 6c 61 73 74 2d 75 70 64 61 74 65 20 73 (< last-update s
a0f0: 6d 61 6c 6c 65 73 74 2d 74 69 6d 65 29 29 0a 20 mallest-time)).
a100: 20 20 20 20 20 20 20 09 09 09 09 28 68 61 73 68 ....(hash
a110: 2d 74 61 62 6c 65 2d 73 65 74 21 20 73 6d 61 6c -table-set! smal
a120: 6c 65 73 74 2d 6c 61 73 74 2d 75 70 64 61 74 65 lest-last-update
a130: 2d 74 69 6d 65 20 22 73 6d 61 6c 6c 65 73 74 2d -time "smallest-
a140: 74 69 6d 65 22 20 6c 61 73 74 2d 75 70 64 61 74 time" last-updat
a150: 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 e)). (
a160: 73 65 74 21 20 70 67 64 62 2d 74 65 73 74 2d 69 set! pgdb-test-i
a170: 64 20 28 70 67 64 62 3a 67 65 74 2d 74 65 73 74 d (pgdb:get-test
a180: 2d 69 64 20 64 62 68 20 70 67 64 62 2d 72 75 6e -id dbh pgdb-run
a190: 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 -id test-name it
a1a0: 65 6d 2d 70 61 74 68 29 29 29 29 0a 20 20 20 20 em-path)))).
a1b0: 20 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 (hash-tab
a1c0: 6c 65 2d 73 65 74 21 20 74 65 73 74 2d 68 74 20 le-set! test-ht
a1d0: 74 65 73 74 2d 69 64 20 70 67 64 62 2d 74 65 73 test-id pgdb-tes
a1e0: 74 2d 69 64 29 29 0a 20 20 20 20 20 20 20 20 20 t-id)).
a1f0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
a200: 6e 66 6f 20 31 20 2a 64 65 66 61 75 6c 74 2d 6c nfo 1 *default-l
a210: 6f 67 2d 70 6f 72 74 2a 20 20 22 57 41 52 4e 49 og-port* "WARNI
a220: 4e 47 3a 20 53 6b 69 70 70 69 6e 67 20 72 75 6e NG: Skipping run
a230: 20 77 69 74 68 20 72 75 6e 2d 69 64 3a 22 20 72 with run-id:" r
a240: 75 6e 2d 69 64 20 22 2e 20 54 68 69 73 20 72 75 un-id ". This ru
a250: 6e 20 77 61 73 20 63 72 65 61 74 65 64 20 61 66 n was created af
a260: 74 65 72 20 70 72 69 76 69 6f 75 73 20 73 79 6e ter privious syn
a270: 63 20 61 6e 64 20 72 65 6d 6f 76 65 64 20 62 65 c and removed be
a280: 66 6f 72 65 20 74 68 69 73 20 73 79 6e 63 2e 22 fore this sync."
a290: 29 29 29 29 0a 20 20 20 20 20 74 65 73 74 2d 69 )))). test-i
a2a0: 64 73 29 29 29 0a 0a 0a 3b 3b 20 67 65 74 20 72 ds)))...;; get r
a2b0: 75 6e 73 20 63 68 61 6e 67 65 64 20 73 69 6e 63 uns changed sinc
a2c0: 65 20 6c 61 73 74 20 73 79 6e 63 0a 3b 3b 20 28 e last sync.;; (
a2d0: 64 65 66 69 6e 65 20 28 74 61 73 6b 73 3a 73 79 define (tasks:sy
a2e0: 6e 63 2d 74 65 73 74 2d 64 61 74 61 20 64 62 68 nc-test-data dbh
a2f0: 20 63 61 63 68 65 64 2d 69 6e 66 6f 20 61 72 65 cached-info are
a300: 61 2d 69 6e 66 6f 29 0a 3b 3b 20 20 20 28 6c 65 a-info).;; (le
a310: 74 2a 20 28 28 0a 0a 28 64 65 66 69 6e 65 20 28 t* ((..(define (
a320: 74 61 73 6b 73 3a 73 79 6e 63 2d 74 6f 2d 70 6f tasks:sync-to-po
a330: 73 74 67 72 65 73 20 63 6f 6e 66 69 67 64 61 74 stgres configdat
a340: 20 64 65 73 74 29 0a 20 20 28 70 72 69 6e 74 20 dest). (print
a350: 22 49 6e 20 73 79 6e 63 22 29 0a 20 20 28 6c 65 "In sync"). (le
a360: 74 2a 20 28 28 64 62 68 20 20 20 20 20 20 20 20 t* ((dbh
a370: 20 28 70 67 64 62 3a 6f 70 65 6e 20 63 6f 6e 66 (pgdb:open conf
a380: 69 67 64 61 74 20 64 62 6e 61 6d 65 3a 20 64 65 igdat dbname: de
a390: 73 74 29 29 0a 09 20 28 61 72 65 61 2d 69 6e 66 st)).. (area-inf
a3a0: 6f 20 20 20 28 70 67 64 62 3a 67 65 74 2d 61 72 o (pgdb:get-ar
a3b0: 65 61 2d 62 79 2d 70 61 74 68 20 64 62 68 20 2a ea-by-path dbh *
a3c0: 74 6f 70 70 61 74 68 2a 29 29 0a 09 20 28 63 61 toppath*)).. (ca
a3d0: 63 68 65 64 2d 69 6e 66 6f 20 28 6d 61 6b 65 2d ched-info (make-
a3e0: 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 09 20 28 hash-table)).. (
a3f0: 73 74 61 72 74 20 20 20 20 20 20 20 28 63 75 72 start (cur
a400: 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 0a 20 rent-seconds)).
a410: 20 20 28 74 65 73 74 2d 70 61 74 74 20 20 20 28 (test-patt (
a420: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
a430: 20 22 2d 74 65 73 74 70 61 74 74 22 29 0a 09 09 "-testpatt")...
a440: 09 09 09 09 09 09 09 09 09 28 61 72 67 73 3a 67 .........(args:g
a450: 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 et-arg "-testpat
a460: 74 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 t").
a470: 20 20 20 20 20 20 20 20 20 20 22 25 22 29 29 0a "%")).
a480: 20 20 20 28 74 61 72 67 65 74 20 20 20 20 20 20 (target
a490: 20 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 (if (args:get
a4a0: 2d 61 72 67 20 22 2d 74 61 72 67 65 74 22 29 0a -arg "-target").
a4b0: 09 09 09 09 09 09 09 09 09 09 09 09 09 09 20 28 .............. (
a4c0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 args:get-arg "-t
a4d0: 61 72 67 65 74 22 29 0a 09 09 09 09 09 09 09 09 arget").........
a4e0: 09 09 09 09 09 23 66 29 29 0a 20 20 20 20 28 72 .....#f)). (r
a4f0: 75 6e 2d 6e 61 6d 65 20 20 20 20 20 20 20 20 20 un-name
a500: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
a510: 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 0a 09 09 g "-runname")...
a520: 09 09 09 09 09 09 09 09 09 09 09 09 20 28 61 72 ............ (ar
a530: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
a540: 6e 61 6d 65 22 29 0a 09 09 09 09 09 09 09 09 09 name")..........
a550: 09 09 09 09 23 66 29 29 29 0a 20 20 20 20 20 28 ....#f))). (
a560: 69 66 20 28 61 6e 64 20 74 61 72 67 65 74 20 20 if (and target
a570: 28 6e 6f 74 20 72 75 6e 2d 6e 61 6d 65 29 29 0a (not run-name)).
a580: 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 (begin...
a590: 09 09 09 28 70 72 69 6e 74 20 22 45 72 72 6f 72 ...(print "Error
a5a0: 3a 20 50 72 6f 76 69 64 65 20 72 75 6e 6e 61 6d : Provide runnam
a5b0: 65 22 29 0a 20 20 20 20 20 20 20 20 20 20 28 65 e"). (e
a5c0: 78 69 74 20 31 29 29 29 0a 20 20 20 20 20 28 69 xit 1))). (i
a5d0: 66 20 28 61 6e 64 20 28 6e 6f 74 20 74 61 72 67 f (and (not targ
a5e0: 65 74 29 20 20 72 75 6e 2d 6e 61 6d 65 29 0a 20 et) run-name).
a5f0: 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 (begin....
a600: 09 09 28 70 72 69 6e 74 20 22 45 72 72 6f 72 3a ..(print "Error:
a610: 20 50 72 6f 76 69 64 65 20 74 61 72 67 65 74 22 Provide target"
a620: 29 0a 20 20 20 20 20 20 20 20 20 20 28 65 78 69 ). (exi
a630: 74 20 31 29 29 29 0a 20 20 20 20 3b 28 70 72 69 t 1))). ;(pri
a640: 6e 74 20 22 31 32 33 22 29 0a 20 20 20 20 3b 28 nt "123"). ;(
a650: 65 78 69 74 20 31 29 20 0a 20 20 20 20 28 66 6f exit 1) . (fo
a660: 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 r-each (lambda (
a670: 64 74 79 70 65 29 0a 09 09 28 68 61 73 68 2d 74 dtype)...(hash-t
a680: 61 62 6c 65 2d 73 65 74 21 20 63 61 63 68 65 64 able-set! cached
a690: 2d 69 6e 66 6f 20 64 74 79 70 65 20 28 6d 61 6b -info dtype (mak
a6a0: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 29 0a e-hash-table))).
a6b0: 09 20 20 20 20 20 20 27 28 72 75 6e 73 20 74 61 . '(runs ta
a6c0: 72 67 65 74 73 20 74 65 73 74 73 20 73 74 65 70 rgets tests step
a6d0: 73 20 64 61 74 61 29 29 0a 20 20 20 20 28 68 61 s data)). (ha
a6e0: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 63 61 sh-table-set! ca
a6f0: 63 68 65 64 2d 69 6e 66 6f 20 27 73 74 61 72 74 ched-info 'start
a700: 20 73 74 61 72 74 29 20 3b 3b 20 77 68 65 6e 20 start) ;; when
a710: 64 6f 6e 65 20 77 65 27 6c 6c 20 73 65 74 20 73 done we'll set s
a720: 79 6e 63 20 74 69 6d 65 73 20 74 6f 20 74 68 69 ync times to thi
a730: 73 0a 20 20 20 20 28 69 66 20 61 72 65 61 2d 69 s. (if area-i
a740: 6e 66 6f 0a 09 28 6c 65 74 2a 20 28 28 6c 61 73 nfo..(let* ((las
a750: 74 2d 73 79 6e 63 2d 74 69 6d 65 20 28 76 65 63 t-sync-time (vec
a760: 74 6f 72 2d 72 65 66 20 61 72 65 61 2d 69 6e 66 tor-ref area-inf
a770: 6f 20 33 29 29 0a 09 20 20 20 20 20 20 20 28 73 o 3)).. (s
a780: 6d 61 6c 6c 65 73 74 2d 6c 61 73 74 2d 75 70 64 mallest-last-upd
a790: 61 74 65 2d 74 69 6d 65 20 20 28 6d 61 6b 65 2d ate-time (make-
a7a0: 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 20 20 20 hash-table)).
a7b0: 20 20 20 20 20 20 28 63 68 61 6e 67 65 64 20 20 (changed
a7c0: 20 20 20 20 28 69 66 20 28 61 6e 64 20 74 61 72 (if (and tar
a7d0: 67 65 74 20 72 75 6e 2d 6e 61 6d 65 29 0a 20 20 get run-name).
a7e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a7f0: 20 20 20 20 20 20 20 20 20 20 28 72 6d 74 3a 67 (rmt:g
a800: 65 74 2d 72 75 6e 2d 72 65 63 6f 72 64 2d 69 64 et-run-record-id
a810: 73 20 74 61 72 67 65 74 20 72 75 6e 2d 6e 61 6d s target run-nam
a820: 65 20 28 72 6d 74 3a 67 65 74 2d 6b 65 79 73 29 e (rmt:get-keys)
a830: 20 74 65 73 74 2d 70 61 74 74 29 0a 20 20 20 20 test-patt).
a840: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a850: 20 20 20 20 20 20 20 20 28 72 6d 74 3a 67 65 74 (rmt:get
a860: 2d 63 68 61 6e 67 65 64 2d 72 65 63 6f 72 64 2d -changed-record-
a870: 69 64 73 20 6c 61 73 74 2d 73 79 6e 63 2d 74 69 ids last-sync-ti
a880: 6d 65 29 29 29 0a 09 20 20 20 20 20 20 20 28 72 me))).. (r
a890: 75 6e 2d 69 64 73 20 20 20 20 20 20 20 20 28 61 un-ids (a
a8a0: 6c 69 73 74 2d 72 65 66 20 27 72 75 6e 73 20 20 list-ref 'runs
a8b0: 20 20 20 20 20 63 68 61 6e 67 65 64 29 29 0a 09 changed))..
a8c0: 20 20 20 20 20 20 20 28 74 65 73 74 2d 69 64 73 (test-ids
a8d0: 20 20 20 20 20 20 20 28 61 6c 69 73 74 2d 72 65 (alist-re
a8e0: 66 20 27 74 65 73 74 73 20 20 20 20 20 20 63 68 f 'tests ch
a8f0: 61 6e 67 65 64 29 29 0a 09 20 20 20 20 20 20 20 anged))..
a900: 28 74 65 73 74 2d 73 74 65 70 2d 69 64 73 20 20 (test-step-ids
a910: 28 61 6c 69 73 74 2d 72 65 66 20 27 74 65 73 74 (alist-ref 'test
a920: 5f 73 74 65 70 73 20 63 68 61 6e 67 65 64 29 29 _steps changed))
a930: 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 2d 64 .. (test-d
a940: 61 74 61 2d 69 64 73 20 20 28 61 6c 69 73 74 2d ata-ids (alist-
a950: 72 65 66 20 27 74 65 73 74 5f 64 61 74 61 20 20 ref 'test_data
a960: 63 68 61 6e 67 65 64 29 29 0a 09 20 20 20 20 20 changed))..
a970: 20 20 28 72 75 6e 2d 73 74 61 74 2d 69 64 73 20 (run-stat-ids
a980: 20 20 28 61 6c 69 73 74 2d 72 65 66 20 27 72 75 (alist-ref 'ru
a990: 6e 5f 73 74 61 74 73 20 20 63 68 61 6e 67 65 64 n_stats changed
a9a0: 29 29 0a 20 20 20 20 20 20 20 20 20 28 61 72 65 )). (are
a9b0: 61 2d 74 61 67 20 20 20 20 28 69 66 20 28 61 72 a-tag (if (ar
a9c0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 61 72 65 gs:get-arg "-are
a9d0: 61 2d 74 61 67 22 29 20 0a 20 20 20 20 20 20 20 a-tag") .
a9e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a9f0: 20 20 20 20 20 20 20 20 20 20 28 61 72 67 73 3a (args:
aa00: 67 65 74 2d 61 72 67 20 22 2d 61 72 65 61 2d 74 get-arg "-area-t
aa10: 61 67 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 ag").
aa20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
aa30: 20 20 20 20 20 20 28 69 66 20 28 61 72 67 73 3a (if (args:
aa40: 67 65 74 2d 61 72 67 20 22 2d 61 72 65 61 22 29 get-arg "-area")
aa50: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
aa60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
aa70: 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 (args:get-a
aa80: 72 67 20 22 2d 61 72 65 61 22 29 20 0a 20 20 20 rg "-area") .
aa90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
aaa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
aab0: 22 22 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 "")))).
aac0: 20 20 28 69 66 20 28 61 6e 64 20 28 65 71 75 61 (if (and (equa
aad0: 6c 3f 20 61 72 65 61 2d 74 61 67 20 22 22 29 20 l? area-tag "")
aae0: 28 6e 6f 74 20 28 70 67 64 62 3a 69 73 2d 61 72 (not (pgdb:is-ar
aaf0: 65 61 2d 74 61 67 65 64 20 64 62 68 20 28 76 65 ea-taged dbh (ve
ab00: 63 74 6f 72 2d 72 65 66 20 61 72 65 61 2d 69 6e ctor-ref area-in
ab10: 66 6f 20 30 29 29 29 29 0a 20 20 20 20 20 20 20 fo 0)))).
ab20: 20 20 20 20 20 28 73 65 74 21 20 61 72 65 61 2d (set! area-
ab30: 74 61 67 20 2a 64 65 66 61 75 6c 74 2d 61 72 65 tag *default-are
ab40: 61 2d 74 61 67 2a 29 29 20 0a 20 20 20 20 20 20 a-tag*)) .
ab50: 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 (if (not (e
ab60: 71 75 61 6c 3f 20 61 72 65 61 2d 74 61 67 20 22 qual? area-tag "
ab70: 22 29 29 20 0a 20 20 20 20 20 20 20 20 20 20 20 ")) .
ab80: 20 20 28 74 61 73 6b 3a 61 64 64 2d 61 72 65 61 (task:add-area
ab90: 2d 74 61 67 20 64 62 68 20 61 72 65 61 2d 69 6e -tag dbh area-in
aba0: 66 6f 20 61 72 65 61 2d 74 61 67 29 29 20 0a 09 fo area-tag)) ..
abb0: 20 20 28 69 66 20 28 6f 72 20 28 6e 6f 74 20 28 (if (or (not (
abc0: 6e 75 6c 6c 3f 20 74 65 73 74 2d 69 64 73 29 29 null? test-ids))
abd0: 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 72 75 6e (not (null? run
abe0: 2d 69 64 73 29 29 29 0a 09 20 20 20 20 20 20 28 -ids))).. (
abf0: 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 20 begin.
ac00: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
ac10: 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 nt-info 0 *defau
ac20: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 20 22 73 lt-log-port* "s
ac30: 79 6e 63 69 6e 67 20 72 75 6e 73 22 29 20 20 20 yncing runs")
ac40: 0a 09 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ..
ac50: 28 74 61 73 6b 73 3a 73 79 6e 63 2d 72 75 6e 2d (tasks:sync-run-
ac60: 64 61 74 61 20 64 62 68 20 63 61 63 68 65 64 2d data dbh cached-
ac70: 69 6e 66 6f 20 72 75 6e 2d 69 64 73 20 61 72 65 info run-ids are
ac80: 61 2d 69 6e 66 6f 20 73 6d 61 6c 6c 65 73 74 2d a-info smallest-
ac90: 6c 61 73 74 2d 75 70 64 61 74 65 2d 74 69 6d 65 last-update-time
aca0: 29 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ) .
acb0: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
acc0: 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d info 0 *default-
acd0: 6c 6f 67 2d 70 6f 72 74 2a 20 20 22 73 79 6e 63 log-port* "sync
ace0: 69 6e 67 20 74 65 73 74 73 22 29 0a 09 09 20 20 ing tests")...
acf0: 20 20 20 20 20 20 20 20 20 20 28 74 61 73 6b 73 (tasks
ad00: 3a 73 79 6e 63 2d 74 65 73 74 73 2d 64 61 74 61 :sync-tests-data
ad10: 20 64 62 68 20 63 61 63 68 65 64 2d 69 6e 66 6f dbh cached-info
ad20: 20 74 65 73 74 2d 69 64 73 20 61 72 65 61 2d 69 test-ids area-i
ad30: 6e 66 6f 20 73 6d 61 6c 6c 65 73 74 2d 6c 61 73 nfo smallest-las
ad40: 74 2d 75 70 64 61 74 65 2d 74 69 6d 65 29 0a 20 t-update-time).
ad50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
ad60: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
ad70: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
ad80: 70 6f 72 74 2a 20 20 22 73 79 6e 63 69 6e 67 20 port* "syncing
ad90: 74 65 73 74 20 73 74 65 70 73 22 29 0a 20 20 20 test steps").
ada0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 74 61 (ta
adb0: 73 6b 73 3a 73 79 6e 63 2d 74 65 73 74 2d 73 74 sks:sync-test-st
adc0: 65 70 73 20 64 62 68 20 63 61 63 68 65 64 2d 69 eps dbh cached-i
add0: 6e 66 6f 20 74 65 73 74 2d 73 74 65 70 2d 69 64 nfo test-step-id
ade0: 73 20 73 6d 61 6c 6c 65 73 74 2d 6c 61 73 74 2d s smallest-last-
adf0: 75 70 64 61 74 65 2d 74 69 6d 65 29 0a 09 09 09 update-time)....
ae00: 09 09 09 09 09 28 64 65 62 75 67 3a 70 72 69 6e .....(debug:prin
ae10: 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c t-info 0 *defaul
ae20: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 20 22 73 79 t-log-port* "sy
ae30: 6e 63 69 6e 67 20 74 65 73 74 20 64 61 74 61 22 ncing test data"
ae40: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
ae50: 20 20 28 74 61 73 6b 73 3a 73 79 6e 63 2d 74 65 (tasks:sync-te
ae60: 73 74 2d 67 65 6e 2d 64 61 74 61 20 64 62 68 20 st-gen-data dbh
ae70: 63 61 63 68 65 64 2d 69 6e 66 6f 20 74 65 73 74 cached-info test
ae80: 2d 64 61 74 61 2d 69 64 73 20 73 6d 61 6c 6c 65 -data-ids smalle
ae90: 73 74 2d 6c 61 73 74 2d 75 70 64 61 74 65 2d 74 st-last-update-t
aea0: 69 6d 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 ime).
aeb0: 20 20 20 20 20 28 70 72 69 6e 74 20 22 2d 2d 2d (print "---
aec0: 2d 2d 2d 2d 2d 2d 2d 64 6f 6e 65 2d 2d 2d 2d 2d -------done-----
aed0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 22 29 29 29 0a 20 ----------"))).
aee0: 20 20 20 20 28 6c 65 74 2a 20 20 28 28 73 6d 61 (let* ((sma
aef0: 6c 6c 65 73 74 2d 74 69 6d 65 20 28 68 61 73 68 llest-time (hash
af00: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
af10: 6c 74 20 73 6d 61 6c 6c 65 73 74 2d 6c 61 73 74 lt smallest-last
af20: 2d 75 70 64 61 74 65 2d 74 69 6d 65 20 22 73 6d -update-time "sm
af30: 61 6c 6c 65 73 74 2d 74 69 6d 65 22 20 28 63 75 allest-time" (cu
af40: 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 29 rrent-seconds)))
af50: 29 0a 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 ). (debug:pr
af60: 69 6e 74 2d 69 6e 66 6f 20 30 20 22 73 6d 61 6c int-info 0 "smal
af70: 6c 65 73 74 2d 74 69 6d 65 20 3a 22 20 73 6d 61 lest-time :" sma
af80: 6c 6c 65 73 74 2d 74 69 6d 65 20 20 22 20 6c 61 llest-time " la
af90: 73 74 2d 73 79 6e 63 2d 74 69 6d 65 20 22 20 6c st-sync-time " l
afa0: 61 73 74 2d 73 79 6e 63 2d 74 69 6d 65 29 0a 20 ast-sync-time).
afb0: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 61 6e 64 (if (not (and
afc0: 20 74 61 72 67 65 74 20 72 75 6e 2d 6e 61 6d 65 target run-name
afd0: 29 29 20 0a 09 20 20 28 69 66 20 28 6f 72 20 28 )) .. (if (or (
afe0: 61 6e 64 20 73 6d 61 6c 6c 65 73 74 2d 74 69 6d and smallest-tim
aff0: 65 20 28 3e 20 73 6d 61 6c 6c 65 73 74 2d 74 69 e (> smallest-ti
b000: 6d 65 20 6c 61 73 74 2d 73 79 6e 63 2d 74 69 6d me last-sync-tim
b010: 65 29 29 20 28 61 6e 64 20 73 6d 61 6c 6c 65 73 e)) (and smalles
b020: 74 2d 74 69 6d 65 20 28 65 71 3f 20 6c 61 73 74 t-time (eq? last
b030: 2d 73 79 6e 63 2d 74 69 6d 65 20 30 29 29 29 0a -sync-time 0))).
b040: 09 09 09 09 28 70 67 64 62 3a 77 72 69 74 65 2d ....(pgdb:write-
b050: 73 79 6e 63 2d 74 69 6d 65 20 64 62 68 20 61 72 sync-time dbh ar
b060: 65 61 2d 69 6e 66 6f 20 73 6d 61 6c 6c 65 73 74 ea-info smallest
b070: 2d 74 69 6d 65 29 29 29 29 29 20 3b 3b 74 68 69 -time))))) ;;thi
b080: 73 20 6e 65 65 64 73 20 74 6f 20 62 65 20 63 68 s needs to be ch
b090: 61 6e 67 65 64 0a 09 28 69 66 20 28 74 61 73 6b anged..(if (task
b0a0: 73 3a 73 65 74 2d 61 72 65 61 20 64 62 68 20 63 s:set-area dbh c
b0b0: 6f 6e 66 69 67 64 61 74 29 0a 09 20 20 20 20 28 onfigdat).. (
b0c0: 74 61 73 6b 73 3a 73 79 6e 63 2d 74 6f 2d 70 6f tasks:sync-to-po
b0d0: 73 74 67 72 65 73 20 63 6f 6e 66 69 67 64 61 74 stgres configdat
b0e0: 20 64 65 73 74 29 0a 09 20 20 20 20 28 62 65 67 dest).. (beg
b0f0: 69 6e 0a 09 20 20 20 20 20 20 28 64 65 62 75 67 in.. (debug
b100: 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
b110: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 45 52 52 t-log-port* "ERR
b120: 4f 52 3a 20 75 6e 61 62 6c 65 20 74 6f 20 63 72 OR: unable to cr
b130: 65 61 74 65 20 61 6e 20 61 72 65 61 20 72 65 63 eate an area rec
b140: 6f 72 64 22 29 0a 09 20 20 20 20 20 20 23 66 29 ord").. #f)
b150: 29 29 29 29 0a 0a 0a 28 64 65 66 69 6e 65 20 28 ))))...(define (
b160: 74 61 73 6b 73 3a 73 79 6e 63 2d 72 75 6e 2d 64 tasks:sync-run-d
b170: 61 74 61 20 64 62 68 20 63 61 63 68 65 64 2d 69 ata dbh cached-i
b180: 6e 66 6f 20 72 75 6e 2d 69 64 73 20 61 72 65 61 nfo run-ids area
b190: 2d 69 6e 66 6f 20 73 6d 61 6c 6c 65 73 74 2d 6c -info smallest-l
b1a0: 61 73 74 2d 75 70 64 61 74 65 2d 74 69 6d 65 29 ast-update-time)
b1b0: 20 0a 20 20 28 66 6f 72 2d 65 61 63 68 0a 20 20 . (for-each.
b1c0: 20 20 20 28 6c 61 6d 62 64 61 20 28 72 75 6e 2d (lambda (run-
b1d0: 69 64 29 0a 20 20 20 20 20 20 28 64 65 62 75 67 id). (debug
b1e0: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 34 20 2a 64 :print-info 4 *d
b1f0: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
b200: 20 20 20 22 43 68 65 63 6b 20 69 66 20 72 75 6e "Check if run
b210: 20 77 69 74 68 20 22 20 72 75 6e 2d 69 64 20 22 with " run-id "
b220: 20 6e 65 65 64 73 20 74 6f 20 62 65 20 73 79 6e needs to be syn
b230: 63 65 64 22 20 29 0a 20 20 20 20 20 20 20 28 74 ced" ). (t
b240: 61 73 6b 73 3a 72 75 6e 2d 69 64 2d 3e 6d 74 70 asks:run-id->mtp
b250: 67 2d 72 75 6e 2d 69 64 20 64 62 68 20 63 61 63 g-run-id dbh cac
b260: 68 65 64 2d 69 6e 66 6f 20 72 75 6e 2d 69 64 20 hed-info run-id
b270: 61 72 65 61 2d 69 6e 66 6f 20 73 6d 61 6c 6c 65 area-info smalle
b280: 73 74 2d 6c 61 73 74 2d 75 70 64 61 74 65 2d 74 st-last-update-t
b290: 69 6d 65 29 29 0a 72 75 6e 2d 69 64 73 29 29 0a ime)).run-ids)).
b2a0: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
b2b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b2c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b2d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b2e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 73 69 6d =========.;; sim
b2f0: 70 6c 65 20 6c 6f 63 6b 2e 20 69 6d 70 72 6f 76 ple lock. improv
b300: 65 20 61 6e 64 20 63 6f 6e 76 65 72 67 65 20 6f e and converge o
b310: 6e 20 74 68 69 73 20 6f 6e 65 2e 0a 3b 3b 0a 28 n this one..;;.(
b320: 64 65 66 69 6e 65 20 28 63 6f 6d 6d 6f 6e 3a 73 define (common:s
b330: 69 6d 70 6c 65 2d 6c 6f 63 6b 20 6b 65 79 6e 61 imple-lock keyna
b340: 6d 65 29 0a 20 20 28 72 6d 74 3a 6e 6f 2d 73 79 me). (rmt:no-sy
b350: 6e 63 2d 67 65 74 2d 6c 6f 63 6b 20 6b 65 79 6e nc-get-lock keyn
b360: 61 6d 65 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 ame))..(define (
b370: 63 6f 6d 6d 6f 6e 3a 73 69 6d 70 6c 65 2d 75 6e common:simple-un
b380: 6c 6f 63 6b 20 6b 65 79 6e 61 6d 65 20 23 21 6b lock keyname #!k
b390: 65 79 20 28 66 6f 72 63 65 20 23 66 29 29 0a 20 ey (force #f)).
b3a0: 20 28 72 6d 74 3a 6e 6f 2d 73 79 6e 63 2d 64 65 (rmt:no-sync-de
b3b0: 6c 21 20 6b 65 79 6e 61 6d 65 29 29 0a 0a 3b 3b l! keyname))..;;
b3c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b3d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b3e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b3f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b400: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 20 53 20 54 20 41 ======.;; S T A
b410: 20 54 20 45 20 20 20 41 20 4e 20 44 20 20 20 53 T E A N D S
b420: 20 54 20 41 20 54 20 55 20 53 20 20 20 46 20 4f T A T U S F O
b430: 20 52 20 20 20 54 20 45 20 53 20 54 20 53 20 0a R T E S T S .
b440: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
b450: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b460: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b470: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b480: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 73 70 65 ========..;; spe
b490: 65 64 20 75 70 20 66 6f 72 20 63 6f 6d 6d 6f 6e ed up for common
b4a0: 20 63 61 73 65 73 20 77 69 74 68 20 61 20 6c 69 cases with a li
b4b0: 74 74 6c 65 20 6c 6f 67 69 63 0a 28 64 65 66 69 ttle logic.(defi
b4c0: 6e 65 20 28 6d 74 3a 74 65 73 74 2d 73 65 74 2d ne (mt:test-set-
b4d0: 73 74 61 74 65 2d 73 74 61 74 75 73 2d 62 79 2d state-status-by-
b4e0: 69 64 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 id run-id test-i
b4f0: 64 20 6e 65 77 73 74 61 74 65 20 6e 65 77 73 74 d newstate newst
b500: 61 74 75 73 20 6e 65 77 63 6f 6d 6d 65 6e 74 29 atus newcomment)
b510: 0a 20 20 28 69 66 20 28 6e 6f 74 20 28 61 6e 64 . (if (not (and
b520: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 run-id test-id)
b530: 29 0a 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 ). (begin..
b540: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 (debug:print-err
b550: 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f or 0 *default-lo
b560: 67 2d 70 6f 72 74 2a 20 22 62 61 64 20 64 61 74 g-port* "bad dat
b570: 61 20 68 61 6e 64 65 64 20 74 6f 20 6d 74 3a 74 a handed to mt:t
b580: 65 73 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 est-set-state-st
b590: 61 74 75 73 2d 62 79 2d 69 64 2c 20 72 75 6e 2d atus-by-id, run-
b5a0: 69 64 3d 22 20 72 75 6e 2d 69 64 20 22 2c 20 74 id=" run-id ", t
b5b0: 65 73 74 2d 69 64 3d 22 20 74 65 73 74 2d 69 64 est-id=" test-id
b5c0: 20 22 2c 20 6e 65 77 73 74 61 74 65 3d 22 20 6e ", newstate=" n
b5d0: 65 77 73 74 61 74 65 29 0a 09 28 70 72 69 6e 74 ewstate)..(print
b5e0: 2d 63 61 6c 6c 2d 63 68 61 69 6e 20 28 63 75 72 -call-chain (cur
b5f0: 72 65 6e 74 2d 65 72 72 6f 72 2d 70 6f 72 74 29 rent-error-port)
b600: 29 0a 09 23 66 29 0a 20 20 20 20 20 20 28 62 65 )..#f). (be
b610: 67 69 6e 0a 09 3b 3b 20 63 6f 6e 64 0a 09 3b 3b gin..;; cond..;;
b620: 20 28 28 61 6e 64 20 6e 65 77 73 74 61 74 65 20 ((and newstate
b630: 6e 65 77 73 74 61 74 75 73 20 6e 65 77 63 6f 6d newstatus newcom
b640: 6d 65 6e 74 29 0a 09 3b 3b 20 20 28 72 6d 74 3a ment)..;; (rmt:
b650: 67 65 6e 65 72 61 6c 2d 63 61 6c 6c 20 27 73 74 general-call 'st
b660: 61 74 65 2d 73 74 61 74 75 73 2d 6d 73 67 20 72 ate-status-msg r
b670: 75 6e 2d 69 64 20 6e 65 77 73 74 61 74 65 20 6e un-id newstate n
b680: 65 77 73 74 61 74 75 73 20 6e 65 77 63 6f 6d 6d ewstatus newcomm
b690: 65 6e 74 20 74 65 73 74 2d 69 64 29 29 0a 09 3b ent test-id))..;
b6a0: 3b 20 28 28 61 6e 64 20 6e 65 77 73 74 61 74 65 ; ((and newstate
b6b0: 20 6e 65 77 73 74 61 74 75 73 29 0a 09 3b 3b 20 newstatus)..;;
b6c0: 20 28 72 6d 74 3a 67 65 6e 65 72 61 6c 2d 63 61 (rmt:general-ca
b6d0: 6c 6c 20 27 73 74 61 74 65 2d 73 74 61 74 75 73 ll 'state-status
b6e0: 20 72 75 6e 2d 69 64 20 6e 65 77 73 74 61 74 65 run-id newstate
b6f0: 20 6e 65 77 73 74 61 74 75 73 20 74 65 73 74 2d newstatus test-
b700: 69 64 29 29 0a 09 3b 3b 20 28 65 6c 73 65 0a 09 id))..;; (else..
b710: 3b 3b 20 20 28 69 66 20 6e 65 77 73 74 61 74 65 ;; (if newstate
b720: 20 20 20 28 72 6d 74 3a 67 65 6e 65 72 61 6c 2d (rmt:general-
b730: 63 61 6c 6c 20 27 73 65 74 2d 74 65 73 74 2d 73 call 'set-test-s
b740: 74 61 74 65 20 20 20 72 75 6e 2d 69 64 20 6e 65 tate run-id ne
b750: 77 73 74 61 74 65 20 20 20 74 65 73 74 2d 69 64 wstate test-id
b760: 29 29 0a 09 3b 3b 20 20 28 69 66 20 6e 65 77 73 ))..;; (if news
b770: 74 61 74 75 73 20 20 28 72 6d 74 3a 67 65 6e 65 tatus (rmt:gene
b780: 72 61 6c 2d 63 61 6c 6c 20 27 73 65 74 2d 74 65 ral-call 'set-te
b790: 73 74 2d 73 74 61 74 75 73 20 20 72 75 6e 2d 69 st-status run-i
b7a0: 64 20 6e 65 77 73 74 61 74 75 73 20 20 74 65 73 d newstatus tes
b7b0: 74 2d 69 64 29 29 0a 09 3b 3b 20 20 28 69 66 20 t-id))..;; (if
b7c0: 6e 65 77 63 6f 6d 6d 65 6e 74 20 28 72 6d 74 3a newcomment (rmt:
b7d0: 67 65 6e 65 72 61 6c 2d 63 61 6c 6c 20 27 73 65 general-call 'se
b7e0: 74 2d 74 65 73 74 2d 63 6f 6d 6d 65 6e 74 20 72 t-test-comment r
b7f0: 75 6e 2d 69 64 20 6e 65 77 63 6f 6d 6d 65 6e 74 un-id newcomment
b800: 20 74 65 73 74 2d 69 64 29 29 29 29 0a 09 28 72 test-id))))..(r
b810: 6d 74 3a 73 65 74 2d 73 74 61 74 65 2d 73 74 61 mt:set-state-sta
b820: 74 75 73 2d 61 6e 64 2d 72 6f 6c 6c 2d 75 70 2d tus-and-roll-up-
b830: 69 74 65 6d 73 20 72 75 6e 2d 69 64 20 74 65 73 items run-id tes
b840: 74 2d 69 64 20 23 66 20 6e 65 77 73 74 61 74 65 t-id #f newstate
b850: 20 6e 65 77 73 74 61 74 75 73 20 6e 65 77 63 6f newstatus newco
b860: 6d 6d 65 6e 74 29 0a 09 3b 3b 20 28 6d 74 3a 70 mment)..;; (mt:p
b870: 72 6f 63 65 73 73 2d 74 72 69 67 67 65 72 73 20 rocess-triggers
b880: 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 6e run-id test-id n
b890: 65 77 73 74 61 74 65 20 6e 65 77 73 74 61 74 75 ewstate newstatu
b8a0: 73 29 0a 09 23 74 29 29 29 0a 0a 0a 28 64 65 66 s)..#t)))...(def
b8b0: 69 6e 65 20 28 6d 74 3a 74 65 73 74 2d 73 65 74 ine (mt:test-set
b8c0: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d 62 79 -state-status-by
b8d0: 2d 69 64 2d 75 6e 6c 65 73 73 2d 63 6f 6d 70 6c -id-unless-compl
b8e0: 65 74 65 64 20 72 75 6e 2d 69 64 20 74 65 73 74 eted run-id test
b8f0: 2d 69 64 20 6e 65 77 73 74 61 74 65 20 6e 65 77 -id newstate new
b900: 73 74 61 74 75 73 20 6e 65 77 63 6f 6d 6d 65 6e status newcommen
b910: 74 29 0a 20 20 28 6c 65 74 2a 20 28 28 74 65 73 t). (let* ((tes
b920: 74 2d 76 65 63 20 20 20 28 72 6d 74 3a 67 65 74 t-vec (rmt:get
b930: 2d 74 65 73 74 69 6e 66 6f 2d 73 74 61 74 65 2d -testinfo-state-
b940: 73 74 61 74 75 73 20 72 75 6e 2d 69 64 20 74 65 status run-id te
b950: 73 74 2d 69 64 29 29 0a 20 20 20 20 20 20 20 20 st-id)).
b960: 20 28 73 74 61 74 65 20 20 20 20 20 28 76 65 63 (state (vec
b970: 74 6f 72 2d 72 65 66 20 74 65 73 74 2d 76 65 63 tor-ref test-vec
b980: 20 33 29 29 29 0a 20 20 20 20 28 69 66 20 28 65 3))). (if (e
b990: 71 75 61 6c 3f 20 73 74 61 74 65 20 22 43 4f 4d qual? state "COM
b9a0: 50 4c 45 54 45 44 22 29 0a 20 20 20 20 20 20 20 PLETED").
b9b0: 20 23 74 0a 20 20 20 20 20 20 20 20 28 72 6d 74 #t. (rmt
b9c0: 3a 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 :set-state-statu
b9d0: 73 2d 61 6e 64 2d 72 6f 6c 6c 2d 75 70 2d 69 74 s-and-roll-up-it
b9e0: 65 6d 73 20 72 75 6e 2d 69 64 20 74 65 73 74 2d ems run-id test-
b9f0: 69 64 20 23 66 20 6e 65 77 73 74 61 74 65 20 6e id #f newstate n
ba00: 65 77 73 74 61 74 75 73 20 6e 65 77 63 6f 6d 6d ewstatus newcomm
ba10: 65 6e 74 29 29 29 29 0a 0a 20 20 0a 28 64 65 66 ent)))).. .(def
ba20: 69 6e 65 20 28 6d 74 3a 74 65 73 74 2d 73 65 74 ine (mt:test-set
ba30: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d 62 79 -state-status-by
ba40: 2d 74 65 73 74 6e 61 6d 65 20 72 75 6e 2d 69 64 -testname run-id
ba50: 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d test-name item-
ba60: 70 61 74 68 20 6e 65 77 2d 73 74 61 74 65 20 6e path new-state n
ba70: 65 77 2d 73 74 61 74 75 73 20 6e 65 77 2d 63 6f ew-status new-co
ba80: 6d 6d 65 6e 74 29 0a 20 20 3b 28 6c 65 74 20 28 mment). ;(let (
ba90: 28 74 65 73 74 2d 69 64 20 28 72 6d 74 3a 67 65 (test-id (rmt:ge
baa0: 74 2d 74 65 73 74 2d 69 64 20 72 75 6e 2d 69 64 t-test-id run-id
bab0: 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d test-name item-
bac0: 70 61 74 68 29 29 29 0a 20 20 28 72 6d 74 3a 73 path))). (rmt:s
bad0: 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d et-state-status-
bae0: 61 6e 64 2d 72 6f 6c 6c 2d 75 70 2d 69 74 65 6d and-roll-up-item
baf0: 73 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 s run-id test-na
bb00: 6d 65 20 69 74 65 6d 2d 70 61 74 68 20 6e 65 77 me item-path new
bb10: 2d 73 74 61 74 65 20 6e 65 77 2d 73 74 61 74 75 -state new-statu
bb20: 73 20 6e 65 77 2d 63 6f 6d 6d 65 6e 74 29 0a 20 s new-comment).
bb30: 20 3b 3b 20 28 6d 74 3a 70 72 6f 63 65 73 73 2d ;; (mt:process-
bb40: 74 72 69 67 67 65 72 73 20 72 75 6e 2d 69 64 20 triggers run-id
bb50: 74 65 73 74 2d 69 64 20 6e 65 77 2d 73 74 61 74 test-id new-stat
bb60: 65 20 6e 65 77 2d 73 74 61 74 75 73 29 0a 20 20 e new-status).
bb70: 23 74 29 3b 29 0a 09 3b 3b 28 6d 74 3a 74 65 73 #t);)..;;(mt:tes
bb80: 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 t-set-state-stat
bb90: 75 73 2d 62 79 2d 69 64 20 72 75 6e 2d 69 64 20 us-by-id run-id
bba0: 74 65 73 74 2d 69 64 20 6e 65 77 2d 73 74 61 74 test-id new-stat
bbb0: 65 20 6e 65 77 2d 73 74 61 74 75 73 20 6e 65 77 e new-status new
bbc0: 2d 63 6f 6d 6d 65 6e 74 29 29 29 0a 0a 28 64 65 -comment)))..(de
bbd0: 66 69 6e 65 20 28 6d 74 3a 74 65 73 74 2d 73 65 fine (mt:test-se
bbe0: 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d 62 t-state-status-b
bbf0: 79 2d 74 65 73 74 6e 61 6d 65 2d 75 6e 6c 65 73 y-testname-unles
bc00: 73 2d 63 6f 6d 70 6c 65 74 65 64 20 72 75 6e 2d s-completed run-
bc10: 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 id test-name ite
bc20: 6d 2d 70 61 74 68 20 6e 65 77 2d 73 74 61 74 65 m-path new-state
bc30: 20 6e 65 77 2d 73 74 61 74 75 73 20 6e 65 77 2d new-status new-
bc40: 63 6f 6d 6d 65 6e 74 29 0a 20 20 28 6c 65 74 20 comment). (let
bc50: 28 28 74 65 73 74 2d 69 64 20 28 72 6d 74 3a 67 ((test-id (rmt:g
bc60: 65 74 2d 74 65 73 74 2d 69 64 20 72 75 6e 2d 69 et-test-id run-i
bc70: 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d d test-name item
bc80: 2d 70 61 74 68 29 29 29 0a 20 20 20 20 28 6d 74 -path))). (mt
bc90: 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 65 2d :test-set-state-
bca0: 73 74 61 74 75 73 2d 62 79 2d 69 64 2d 75 6e 6c status-by-id-unl
bcb0: 65 73 73 2d 63 6f 6d 70 6c 65 74 65 64 20 72 75 ess-completed ru
bcc0: 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 6e 65 77 n-id test-id new
bcd0: 2d 73 74 61 74 65 20 6e 65 77 2d 73 74 61 74 75 -state new-statu
bce0: 73 20 6e 65 77 2d 63 6f 6d 6d 65 6e 74 29 29 29 s new-comment)))
bcf0: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
bd00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
bd10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
bd20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
bd30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 20 52 ==========.;; R
bd40: 20 55 20 4e 20 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d U N S.;;=======
bd50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
bd60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
bd70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
bd80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
bd90: 0a 3b 3b 20 72 75 6e 73 3a 67 65 74 2d 72 75 6e .;; runs:get-run
bda0: 73 2d 62 79 2d 70 61 74 74 0a 3b 3b 20 67 65 74 s-by-patt.;; get
bdb0: 20 72 75 6e 73 20 62 79 20 6c 69 73 74 20 6f 66 runs by list of
bdc0: 20 63 72 69 74 65 72 69 61 0a 3b 3b 20 72 65 67 criteria.;; reg
bdd0: 69 73 74 65 72 20 61 20 74 65 73 74 20 72 75 6e ister a test run
bde0: 20 77 69 74 68 20 74 68 65 20 64 62 0a 3b 3b 0a with the db.;;.
bdf0: 3b 3b 20 55 73 65 3a 20 28 64 62 2d 67 65 74 2d ;; Use: (db-get-
be00: 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 value-by-header
be10: 28 64 62 3a 67 65 74 2d 68 65 61 64 65 72 20 72 (db:get-header r
be20: 75 6e 69 6e 66 6f 29 28 64 62 3a 67 65 74 2d 72 uninfo)(db:get-r
be30: 6f 77 73 20 72 75 6e 69 6e 66 6f 29 29 0a 3b 3b ows runinfo)).;;
be40: 20 20 74 6f 20 65 78 74 72 61 63 74 20 69 6e 66 to extract inf
be50: 6f 20 66 72 6f 6d 20 74 68 65 20 73 74 72 75 63 o from the struc
be60: 74 75 72 65 20 72 65 74 75 72 6e 65 64 0a 3b 3b ture returned.;;
be70: 0a 28 64 65 66 69 6e 65 20 28 6d 74 3a 67 65 74 .(define (mt:get
be80: 2d 72 75 6e 73 2d 62 79 2d 70 61 74 74 20 6b 65 -runs-by-patt ke
be90: 79 73 20 72 75 6e 6e 61 6d 65 70 61 74 74 20 74 ys runnamepatt t
bea0: 61 72 67 70 61 74 74 29 0a 20 20 28 6c 65 74 20 argpatt). (let
beb0: 6c 6f 6f 70 20 28 28 72 75 6e 73 64 61 74 20 20 loop ((runsdat
bec0: 28 72 6d 74 3a 67 65 74 2d 72 75 6e 73 2d 62 79 (rmt:get-runs-by
bed0: 2d 70 61 74 74 20 6b 65 79 73 20 72 75 6e 6e 61 -patt keys runna
bee0: 6d 65 70 61 74 74 20 74 61 72 67 70 61 74 74 20 mepatt targpatt
bef0: 30 20 35 30 30 20 23 66 20 30 29 29 0a 09 20 20 0 500 #f 0))..
bf00: 20 20 20 28 72 65 73 20 20 20 20 20 20 27 28 29 (res '()
bf10: 29 0a 09 20 20 20 20 20 28 6f 66 66 73 65 74 20 ).. (offset
bf20: 20 20 30 29 0a 09 20 20 20 20 20 28 6c 69 6d 69 0).. (limi
bf30: 74 20 20 20 20 35 30 30 29 29 0a 20 20 20 20 3b t 500)). ;
bf40: 3b 20 28 70 72 69 6e 74 20 22 72 75 6e 73 64 61 ; (print "runsda
bf50: 74 3a 20 22 20 72 75 6e 73 64 61 74 29 0a 20 20 t: " runsdat).
bf60: 20 20 28 6c 65 74 2a 20 28 28 68 65 61 64 65 72 (let* ((header
bf70: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (vector-ref
bf80: 72 75 6e 73 64 61 74 20 30 29 29 0a 09 20 20 20 runsdat 0))..
bf90: 28 72 75 6e 73 6c 73 74 20 20 20 28 76 65 63 74 (runslst (vect
bfa0: 6f 72 2d 72 65 66 20 72 75 6e 73 64 61 74 20 31 or-ref runsdat 1
bfb0: 29 29 0a 09 20 20 20 28 66 75 6c 6c 2d 6c 69 73 )).. (full-lis
bfc0: 74 20 28 61 70 70 65 6e 64 20 72 65 73 20 72 75 t (append res ru
bfd0: 6e 73 6c 73 74 29 29 0a 09 20 20 20 28 68 61 76 nslst)).. (hav
bfe0: 65 2d 6d 6f 72 65 20 28 65 71 3f 20 28 6c 65 6e e-more (eq? (len
bff0: 67 74 68 20 72 75 6e 73 6c 73 74 29 20 6c 69 6d gth runslst) lim
c000: 69 74 29 29 29 0a 20 20 20 20 20 20 3b 3b 20 28 it))). ;; (
c010: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
c020: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
c030: 20 22 68 65 61 64 65 72 3a 20 22 20 68 65 61 64 "header: " head
c040: 65 72 20 22 20 72 75 6e 73 6c 73 74 3a 20 22 20 er " runslst: "
c050: 72 75 6e 73 6c 73 74 20 22 20 68 61 76 65 2d 6d runslst " have-m
c060: 6f 72 65 3a 20 22 20 68 61 76 65 2d 6d 6f 72 65 ore: " have-more
c070: 29 0a 20 20 20 20 20 20 28 69 66 20 68 61 76 65 ). (if have
c080: 2d 6d 6f 72 65 20 0a 09 20 20 28 6c 65 74 20 28 -more .. (let (
c090: 28 6e 65 77 2d 6f 66 66 73 65 74 20 28 2b 20 6f (new-offset (+ o
c0a0: 66 66 73 65 74 20 6c 69 6d 69 74 29 29 0a 09 09 ffset limit))...
c0b0: 28 6e 65 78 74 2d 62 61 74 63 68 20 28 72 6d 74 (next-batch (rmt
c0c0: 3a 67 65 74 2d 72 75 6e 73 2d 62 79 2d 70 61 74 :get-runs-by-pat
c0d0: 74 20 6b 65 79 73 20 72 75 6e 6e 61 6d 65 70 61 t keys runnamepa
c0e0: 74 74 20 74 61 72 67 70 61 74 74 20 6f 66 66 73 tt targpatt offs
c0f0: 65 74 20 6c 69 6d 69 74 20 23 66 20 30 29 29 29 et limit #f 0)))
c100: 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 .. (debug:pri
c110: 6e 74 2d 69 6e 66 6f 20 34 20 2a 64 65 66 61 75 nt-info 4 *defau
c120: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4d 6f lt-log-port* "Mo
c130: 72 65 20 74 68 61 6e 20 22 20 6c 69 6d 69 74 20 re than " limit
c140: 22 20 72 75 6e 73 2c 20 68 61 76 65 20 22 20 28 " runs, have " (
c150: 6c 65 6e 67 74 68 20 66 75 6c 6c 2d 6c 69 73 74 length full-list
c160: 29 20 22 20 72 75 6e 73 20 73 6f 20 66 61 72 2e ) " runs so far.
c170: 22 29 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 ").. (debug:p
c180: 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 rint-info 0 *def
c190: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
c1a0: 6e 65 78 74 2d 62 61 74 63 68 3a 20 22 20 6e 65 next-batch: " ne
c1b0: 78 74 2d 62 61 74 63 68 29 0a 09 20 20 20 20 28 xt-batch).. (
c1c0: 6c 6f 6f 70 20 6e 65 78 74 2d 62 61 74 63 68 0a loop next-batch.
c1d0: 09 09 20 20 66 75 6c 6c 2d 6c 69 73 74 0a 09 09 .. full-list...
c1e0: 20 20 6e 65 77 2d 6f 66 66 73 65 74 0a 09 09 20 new-offset...
c1f0: 20 6c 69 6d 69 74 29 29 0a 09 20 28 76 65 63 74 limit)).. (vect
c200: 6f 72 20 68 65 61 64 65 72 20 66 75 6c 6c 2d 6c or header full-l
c210: 69 73 74 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d ist)))))..;;====
c220: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
c230: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
c240: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
c250: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
c260: 3d 3d 0a 3b 3b 20 20 54 20 45 20 53 20 54 20 53 ==.;; T E S T S
c270: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
c280: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
c290: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
c2a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
c2b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 =========..(defi
c2c0: 6e 65 20 28 6d 74 3a 67 65 74 2d 74 65 73 74 73 ne (mt:get-tests
c2d0: 2d 66 6f 72 2d 72 75 6e 20 72 75 6e 2d 69 64 20 -for-run run-id
c2e0: 74 65 73 74 70 61 74 74 20 73 74 61 74 65 73 20 testpatt states
c2f0: 73 74 61 74 75 73 20 23 21 6b 65 79 20 28 6e 6f status #!key (no
c300: 74 2d 69 6e 20 23 74 29 20 28 73 6f 72 74 2d 62 t-in #t) (sort-b
c310: 79 20 27 65 76 65 6e 74 5f 74 69 6d 65 29 20 28 y 'event_time) (
c320: 73 6f 72 74 2d 6f 72 64 65 72 20 22 41 53 43 22 sort-order "ASC"
c330: 29 20 28 71 72 79 76 61 6c 73 20 23 66 29 28 6c ) (qryvals #f)(l
c340: 61 73 74 2d 75 70 64 61 74 65 20 23 66 29 29 0a ast-update #f)).
c350: 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 74 65 (let loop ((te
c360: 73 74 73 64 61 74 20 28 72 6d 74 3a 67 65 74 2d stsdat (rmt:get-
c370: 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 72 75 tests-for-run ru
c380: 6e 2d 69 64 20 74 65 73 74 70 61 74 74 20 73 74 n-id testpatt st
c390: 61 74 65 73 20 73 74 61 74 75 73 20 30 20 35 30 ates status 0 50
c3a0: 30 20 6e 6f 74 2d 69 6e 20 73 6f 72 74 2d 62 79 0 not-in sort-by
c3b0: 20 73 6f 72 74 2d 6f 72 64 65 72 20 71 72 79 76 sort-order qryv
c3c0: 61 6c 73 20 6c 61 73 74 2d 75 70 64 61 74 65 20 als last-update
c3d0: 27 6e 6f 72 6d 61 6c 29 29 0a 09 20 20 20 20 20 'normal))..
c3e0: 28 72 65 73 20 20 20 20 20 20 27 28 29 29 0a 09 (res '())..
c3f0: 20 20 20 20 20 28 6f 66 66 73 65 74 20 20 20 30 (offset 0
c400: 29 0a 09 20 20 20 20 20 28 6c 69 6d 69 74 20 20 ).. (limit
c410: 20 20 35 30 30 29 29 0a 20 20 20 20 28 6c 65 74 500)). (let
c420: 2a 20 28 28 66 75 6c 6c 2d 6c 69 73 74 20 28 61 * ((full-list (a
c430: 70 70 65 6e 64 20 72 65 73 20 74 65 73 74 73 64 ppend res testsd
c440: 61 74 29 29 0a 09 20 20 20 28 68 61 76 65 2d 6d at)).. (have-m
c450: 6f 72 65 20 28 65 71 3f 20 28 6c 65 6e 67 74 68 ore (eq? (length
c460: 20 74 65 73 74 73 64 61 74 29 20 6c 69 6d 69 74 testsdat) limit
c470: 29 29 29 0a 20 20 20 20 20 20 28 69 66 20 68 61 ))). (if ha
c480: 76 65 2d 6d 6f 72 65 20 0a 09 20 20 28 6c 65 74 ve-more .. (let
c490: 20 28 28 6e 65 77 2d 6f 66 66 73 65 74 20 28 2b ((new-offset (+
c4a0: 20 6f 66 66 73 65 74 20 6c 69 6d 69 74 29 29 29 offset limit)))
c4b0: 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 .. (debug:pri
c4c0: 6e 74 2d 69 6e 66 6f 20 34 20 2a 64 65 66 61 75 nt-info 4 *defau
c4d0: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4d 6f lt-log-port* "Mo
c4e0: 72 65 20 74 68 61 6e 20 22 20 6c 69 6d 69 74 20 re than " limit
c4f0: 22 20 74 65 73 74 73 2c 20 68 61 76 65 20 22 20 " tests, have "
c500: 28 6c 65 6e 67 74 68 20 66 75 6c 6c 2d 6c 69 73 (length full-lis
c510: 74 29 20 22 20 74 65 73 74 73 20 73 6f 20 66 61 t) " tests so fa
c520: 72 2e 22 29 0a 09 20 20 20 20 28 6c 6f 6f 70 20 r.").. (loop
c530: 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 73 2d 66 (rmt:get-tests-f
c540: 6f 72 2d 72 75 6e 20 72 75 6e 2d 69 64 20 74 65 or-run run-id te
c550: 73 74 70 61 74 74 20 73 74 61 74 65 73 20 73 74 stpatt states st
c560: 61 74 75 73 20 6e 65 77 2d 6f 66 66 73 65 74 20 atus new-offset
c570: 6c 69 6d 69 74 20 6e 6f 74 2d 69 6e 20 73 6f 72 limit not-in sor
c580: 74 2d 62 79 20 73 6f 72 74 2d 6f 72 64 65 72 20 t-by sort-order
c590: 71 72 79 76 61 6c 73 20 6c 61 73 74 2d 75 70 64 qryvals last-upd
c5a0: 61 74 65 20 27 6e 6f 72 6d 61 6c 29 0a 09 09 20 ate 'normal)...
c5b0: 20 66 75 6c 6c 2d 6c 69 73 74 0a 09 09 20 20 6e full-list... n
c5c0: 65 77 2d 6f 66 66 73 65 74 0a 09 09 20 20 6c 69 ew-offset... li
c5d0: 6d 69 74 29 29 0a 09 20 20 66 75 6c 6c 2d 6c 69 mit)).. full-li
c5e0: 73 74 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 st))))..(define
c5f0: 28 6d 74 3a 6c 61 7a 79 2d 67 65 74 2d 70 72 65 (mt:lazy-get-pre
c600: 72 65 71 73 2d 6e 6f 74 2d 6d 65 74 20 72 75 6e reqs-not-met run
c610: 2d 69 64 20 77 61 69 74 6f 6e 73 20 72 65 66 2d -id waitons ref-
c620: 69 74 65 6d 2d 70 61 74 68 20 23 21 6b 65 79 20 item-path #!key
c630: 28 6d 6f 64 65 20 27 28 6e 6f 72 6d 61 6c 29 29 (mode '(normal))
c640: 28 69 74 65 6d 6d 61 70 73 20 23 66 29 20 29 0a (itemmaps #f) ).
c650: 20 20 28 6c 65 74 2a 20 28 28 6b 65 79 20 20 20 (let* ((key
c660: 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 20 77 61 (list run-id wa
c670: 69 74 6f 6e 73 20 72 65 66 2d 69 74 65 6d 2d 70 itons ref-item-p
c680: 61 74 68 20 6d 6f 64 65 29 29 0a 09 20 28 72 65 ath mode)).. (re
c690: 73 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 s (hash-table
c6a0: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 70 72 -ref/default *pr
c6b0: 65 2d 72 65 71 73 2d 6d 65 74 2d 63 61 63 68 65 e-reqs-met-cache
c6c0: 2a 20 6b 65 79 20 23 66 29 29 0a 09 20 28 75 73 * key #f)).. (us
c6d0: 65 72 65 73 20 28 6c 65 74 20 28 28 6c 61 73 74 eres (let ((last
c6e0: 2d 74 69 6d 65 20 28 69 66 20 28 76 65 63 74 6f -time (if (vecto
c6f0: 72 3f 20 72 65 73 29 20 28 76 65 63 74 6f 72 2d r? res) (vector-
c700: 72 65 66 20 72 65 73 20 30 29 20 23 66 29 29 29 ref res 0) #f)))
c710: 0a 09 09 20 20 20 28 69 66 20 6c 61 73 74 2d 74 ... (if last-t
c720: 69 6d 65 0a 09 09 20 20 20 20 20 20 20 28 3c 20 ime... (<
c730: 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 (current-seconds
c740: 29 28 2b 20 6c 61 73 74 2d 74 69 6d 65 20 35 29 )(+ last-time 5)
c750: 29 0a 09 09 20 20 20 20 20 20 20 23 66 29 29 29 )... #f)))
c760: 29 0a 20 20 20 20 28 69 66 20 75 73 65 72 65 73 ). (if useres
c770: 0a 09 28 6c 65 74 20 28 28 72 65 73 75 6c 74 20 ..(let ((result
c780: 28 76 65 63 74 6f 72 2d 72 65 66 20 72 65 73 20 (vector-ref res
c790: 31 29 29 29 0a 09 20 20 28 64 65 62 75 67 3a 70 1))).. (debug:p
c7a0: 72 69 6e 74 20 34 20 2a 64 65 66 61 75 6c 74 2d rint 4 *default-
c7b0: 6c 6f 67 2d 70 6f 72 74 2a 20 22 55 73 69 6e 67 log-port* "Using
c7c0: 20 6c 61 7a 79 20 76 61 6c 75 65 20 72 65 73 3a lazy value res:
c7d0: 20 22 20 72 65 73 75 6c 74 29 0a 09 20 20 72 65 " result).. re
c7e0: 73 75 6c 74 29 0a 09 28 6c 65 74 20 28 28 6e 65 sult)..(let ((ne
c7f0: 77 72 65 73 20 28 72 6d 74 3a 67 65 74 2d 70 72 wres (rmt:get-pr
c800: 65 72 65 71 73 2d 6e 6f 74 2d 6d 65 74 20 72 75 ereqs-not-met ru
c810: 6e 2d 69 64 20 77 61 69 74 6f 6e 73 20 72 65 66 n-id waitons ref
c820: 2d 69 74 65 6d 2d 70 61 74 68 20 6d 6f 64 65 3a -item-path mode:
c830: 20 6d 6f 64 65 20 69 74 65 6d 6d 61 70 73 3a 20 mode itemmaps:
c840: 69 74 65 6d 6d 61 70 73 29 29 29 0a 09 20 20 28 itemmaps))).. (
c850: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set!
c860: 2a 70 72 65 2d 72 65 71 73 2d 6d 65 74 2d 63 61 *pre-reqs-met-ca
c870: 63 68 65 2a 20 6b 65 79 20 28 76 65 63 74 6f 72 che* key (vector
c880: 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 (current-second
c890: 73 29 20 6e 65 77 72 65 73 29 29 0a 09 20 20 6e s) newres)).. n
c8a0: 65 77 72 65 73 29 29 29 29 0a 0a 3b 3b 3d 3d 3d ewres))))..;;===
c8b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
c8c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
c8d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
c8e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
c8f0: 3d 3d 3d 0a 3b 3b 20 66 72 6f 6d 20 6d 65 74 61 ===.;; from meta
c900: 64 61 74 20 6c 6f 6f 6b 75 70 20 4d 45 47 41 54 dat lookup MEGAT
c910: 45 53 54 5f 56 45 52 53 49 4f 4e 0a 3b 3b 0a 28 EST_VERSION.;;.(
c920: 64 65 66 69 6e 65 20 28 63 6f 6d 6d 6f 6e 3a 67 define (common:g
c930: 65 74 2d 6c 61 73 74 2d 72 75 6e 2d 76 65 72 73 et-last-run-vers
c940: 69 6f 6e 29 20 3b 3b 20 52 41 44 54 20 3d 3e 20 ion) ;; RADT =>
c950: 48 6f 77 20 64 6f 65 73 20 74 68 69 73 20 77 6f How does this wo
c960: 72 6b 20 69 6e 20 73 65 6e 64 2d 72 65 63 65 69 rk in send-recei
c970: 76 65 20 66 75 6e 63 74 69 6f 6e 3f 3f 3b 20 61 ve function??; a
c980: 73 73 75 6d 65 20 69 74 20 69 73 20 74 68 65 20 ssume it is the
c990: 76 61 6c 75 65 20 73 61 76 65 64 20 69 6e 20 73 value saved in s
c9a0: 6f 6d 65 20 44 42 0a 20 20 28 72 6d 74 3a 67 65 ome DB. (rmt:ge
c9b0: 74 2d 76 61 72 20 23 66 20 22 4d 45 47 41 54 45 t-var #f "MEGATE
c9c0: 53 54 5f 56 45 52 53 49 4f 4e 22 29 29 0a 0a 28 ST_VERSION"))..(
c9d0: 64 65 66 69 6e 65 20 28 63 6f 6d 6d 6f 6e 3a 67 define (common:g
c9e0: 65 74 2d 6c 61 73 74 2d 72 75 6e 2d 76 65 72 73 et-last-run-vers
c9f0: 69 6f 6e 2d 6e 75 6d 62 65 72 29 0a 20 20 28 73 ion-number). (s
ca00: 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 0a 20 tring->number .
ca10: 20 20 28 73 75 62 73 74 72 69 6e 67 20 28 63 6f (substring (co
ca20: 6d 6d 6f 6e 3a 67 65 74 2d 6c 61 73 74 2d 72 75 mmon:get-last-ru
ca30: 6e 2d 76 65 72 73 69 6f 6e 29 20 30 20 36 29 29 n-version) 0 6))
ca40: 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6d 6d )..(define (comm
ca50: 6f 6e 3a 73 65 74 2d 6c 61 73 74 2d 72 75 6e 2d on:set-last-run-
ca60: 76 65 72 73 69 6f 6e 29 0a 20 20 28 72 6d 74 3a version). (rmt:
ca70: 73 65 74 2d 76 61 72 20 23 66 20 22 4d 45 47 41 set-var #f "MEGA
ca80: 54 45 53 54 5f 56 45 52 53 49 4f 4e 22 20 28 63 TEST_VERSION" (c
ca90: 6f 6d 6d 6f 6e 3a 76 65 72 73 69 6f 6e 2d 73 69 ommon:version-si
caa0: 67 6e 61 74 75 72 65 29 29 29 0a 0a 3b 3b 3d 3d gnature)))..;;==
cab0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
cac0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
cad0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
cae0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
caf0: 3d 3d 3d 3d 0a 3b 3b 20 66 61 75 78 2d 6c 6f 63 ====.;; faux-loc
cb00: 6b 20 69 73 20 64 65 70 72 65 63 61 74 65 64 2e k is deprecated.
cb10: 20 50 6c 65 61 73 65 20 75 73 65 20 73 69 6d 70 Please use simp
cb20: 6c 65 2d 6c 6f 63 6b 20 62 65 6c 6f 77 0a 3b 3b le-lock below.;;
cb30: 0a 28 64 65 66 69 6e 65 20 28 63 6f 6d 6d 6f 6e .(define (common
cb40: 3a 66 61 75 78 2d 6c 6f 63 6b 20 6b 65 79 6e 61 :faux-lock keyna
cb50: 6d 65 20 23 21 6b 65 79 20 28 77 61 69 74 2d 74 me #!key (wait-t
cb60: 69 6d 65 20 38 29 28 61 6c 6c 6f 77 2d 6c 6f 63 ime 8)(allow-loc
cb70: 6b 2d 73 74 65 61 6c 20 23 74 29 29 0a 20 20 28 k-steal #t)). (
cb80: 69 66 20 28 72 6d 74 3a 6e 6f 2d 73 79 6e 63 2d if (rmt:no-sync-
cb90: 67 65 74 2f 64 65 66 61 75 6c 74 20 6b 65 79 6e get/default keyn
cba0: 61 6d 65 20 23 66 29 20 3b 3b 20 64 6f 20 6e 6f ame #f) ;; do no
cbb0: 74 20 62 65 20 74 65 6d 70 74 65 64 20 74 6f 20 t be tempted to
cbc0: 63 6f 6d 70 61 72 65 20 74 6f 20 70 69 64 2e 20 compare to pid.
cbd0: 6c 6f 63 6b 69 6e 67 20 69 73 20 61 20 6f 6e 65 locking is a one
cbe0: 2d 73 68 6f 74 20 61 63 74 69 6f 6e 2c 20 69 66 -shot action, if
cbf0: 20 61 6c 72 65 61 64 79 20 6c 6f 63 6b 65 64 20 already locked
cc00: 66 6f 72 20 74 68 69 73 20 70 69 64 20 69 74 20 for this pid it
cc10: 64 6f 65 73 6e 27 74 20 61 63 74 75 61 6c 6c 79 doesn't actually
cc20: 20 63 6f 75 6e 74 0a 20 20 20 20 20 20 28 69 66 count. (if
cc30: 20 28 3e 20 77 61 69 74 2d 74 69 6d 65 20 30 29 (> wait-time 0)
cc40: 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 .. (begin..
cc50: 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 31 (thread-sleep! 1
cc60: 29 0a 09 20 20 20 20 28 69 66 20 28 65 71 3f 20 ).. (if (eq?
cc70: 77 61 69 74 2d 74 69 6d 65 20 31 29 20 3b 3b 20 wait-time 1) ;;
cc80: 6f 6e 6c 79 20 6f 6e 65 20 73 65 63 6f 6e 64 20 only one second
cc90: 6c 65 66 74 2c 20 73 74 65 61 6c 20 74 68 65 20 left, steal the
cca0: 6c 6f 63 6b 0a 09 09 28 62 65 67 69 6e 0a 09 09 lock...(begin...
ccb0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
ccc0: 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c nfo 0 *default-l
ccd0: 6f 67 2d 70 6f 72 74 2a 20 22 73 74 65 61 6c 69 og-port* "steali
cce0: 6e 67 20 6c 6f 63 6b 20 66 6f 72 20 22 20 6b 65 ng lock for " ke
ccf0: 79 6e 61 6d 65 29 0a 09 09 20 20 28 63 6f 6d 6d yname)... (comm
cd00: 6f 6e 3a 66 61 75 78 2d 75 6e 6c 6f 63 6b 20 6b on:faux-unlock k
cd10: 65 79 6e 61 6d 65 20 66 6f 72 63 65 3a 20 23 74 eyname force: #t
cd20: 29 29 29 0a 09 20 20 20 20 28 63 6f 6d 6d 6f 6e ))).. (common
cd30: 3a 66 61 75 78 2d 6c 6f 63 6b 20 6b 65 79 6e 61 :faux-lock keyna
cd40: 6d 65 20 77 61 69 74 2d 74 69 6d 65 3a 20 28 2d me wait-time: (-
cd50: 20 77 61 69 74 2d 74 69 6d 65 20 31 29 29 29 0a wait-time 1))).
cd60: 09 20 20 23 66 29 0a 20 20 20 20 20 20 28 62 65 . #f). (be
cd70: 67 69 6e 0a 20 20 20 20 20 20 20 20 28 72 6d 74 gin. (rmt
cd80: 3a 6e 6f 2d 73 79 6e 63 2d 73 65 74 20 6b 65 79 :no-sync-set key
cd90: 6e 61 6d 65 20 28 63 6f 6e 63 20 28 63 75 72 72 name (conc (curr
cda0: 65 6e 74 2d 70 72 6f 63 65 73 73 2d 69 64 29 29 ent-process-id))
cdb0: 29 0a 20 20 20 20 20 20 20 20 28 65 71 75 61 6c ). (equal
cdc0: 3f 20 28 63 6f 6e 63 20 28 63 75 72 72 65 6e 74 ? (conc (current
cdd0: 2d 70 72 6f 63 65 73 73 2d 69 64 29 29 20 28 63 -process-id)) (c
cde0: 6f 6e 63 20 28 72 6d 74 3a 6e 6f 2d 73 79 6e 63 onc (rmt:no-sync
cdf0: 2d 67 65 74 2f 64 65 66 61 75 6c 74 20 6b 65 79 -get/default key
ce00: 6e 61 6d 65 20 23 66 29 29 29 29 29 29 0a 0a 28 name #f))))))..(
ce10: 64 65 66 69 6e 65 20 28 63 6f 6d 6d 6f 6e 3a 66 define (common:f
ce20: 61 75 78 2d 75 6e 6c 6f 63 6b 20 6b 65 79 6e 61 aux-unlock keyna
ce30: 6d 65 20 23 21 6b 65 79 20 28 66 6f 72 63 65 20 me #!key (force
ce40: 23 66 29 29 0a 20 20 28 69 66 20 28 6f 72 20 66 #f)). (if (or f
ce50: 6f 72 63 65 20 28 65 71 75 61 6c 3f 20 28 63 6f orce (equal? (co
ce60: 6e 63 20 28 63 75 72 72 65 6e 74 2d 70 72 6f 63 nc (current-proc
ce70: 65 73 73 2d 69 64 29 29 20 28 63 6f 6e 63 20 28 ess-id)) (conc (
ce80: 72 6d 74 3a 6e 6f 2d 73 79 6e 63 2d 67 65 74 2f rmt:no-sync-get/
ce90: 64 65 66 61 75 6c 74 20 6b 65 79 6e 61 6d 65 20 default keyname
cea0: 23 66 29 29 29 29 0a 20 20 20 20 20 20 28 62 65 #f)))). (be
ceb0: 67 69 6e 0a 20 20 20 20 20 20 20 20 28 69 66 20 gin. (if
cec0: 28 72 6d 74 3a 6e 6f 2d 73 79 6e 63 2d 67 65 74 (rmt:no-sync-get
ced0: 2f 64 65 66 61 75 6c 74 20 6b 65 79 6e 61 6d 65 /default keyname
cee0: 20 23 66 29 20 28 72 6d 74 3a 6e 6f 2d 73 79 6e #f) (rmt:no-syn
cef0: 63 2d 64 65 6c 21 20 6b 65 79 6e 61 6d 65 29 29 c-del! keyname))
cf00: 0a 20 20 20 20 20 20 20 20 23 74 29 0a 20 20 20 . #t).
cf10: 20 20 20 23 66 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d #f))..;;=====
cf20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
cf30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
cf40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
cf50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
cf60: 3d 0a 3b 3b 20 70 6f 73 74 69 76 65 20 6e 75 6d =.;; postive num
cf70: 62 65 72 20 69 66 20 6d 65 67 61 74 65 73 74 20 ber if megatest
cf80: 76 65 72 73 69 6f 6e 20 3e 20 64 62 20 76 65 72 version > db ver
cf90: 73 69 6f 6e 0a 3b 3b 20 6e 65 67 61 74 69 76 65 sion.;; negative
cfa0: 20 6e 75 6d 62 65 72 20 69 66 20 6d 65 67 61 74 number if megat
cfb0: 65 73 74 20 76 65 72 73 69 6f 6e 20 3c 20 64 62 est version < db
cfc0: 20 76 65 72 73 69 6f 6e 0a 28 64 65 66 69 6e 65 version.(define
cfd0: 20 28 63 6f 6d 6d 6f 6e 3a 76 65 72 73 69 6f 6e (common:version
cfe0: 2d 64 62 2d 64 65 6c 74 61 29 0a 20 20 28 2d 20 -db-delta). (-
cff0: 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e megatest-version
d000: 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 6c 61 73 (common:get-las
d010: 74 2d 72 75 6e 2d 76 65 72 73 69 6f 6e 2d 6e 75 t-run-version-nu
d020: 6d 62 65 72 29 29 29 0a 0a 28 64 65 66 69 6e 65 mber)))..(define
d030: 20 28 63 6f 6d 6d 6f 6e 3a 76 65 72 73 69 6f 6e (common:version
d040: 2d 63 68 61 6e 67 65 64 3f 29 0a 20 20 28 6e 6f -changed?). (no
d050: 74 20 28 65 71 75 61 6c 3f 20 28 63 6f 6d 6d 6f t (equal? (commo
d060: 6e 3a 67 65 74 2d 6c 61 73 74 2d 72 75 6e 2d 76 n:get-last-run-v
d070: 65 72 73 69 6f 6e 29 0a 20 20 20 20 20 20 20 20 ersion).
d080: 20 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 76 (common:v
d090: 65 72 73 69 6f 6e 2d 73 69 67 6e 61 74 75 72 65 ersion-signature
d0a0: 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 ))))..(define (c
d0b0: 6f 6d 6d 6f 6e 3a 61 70 69 2d 63 68 61 6e 67 65 ommon:api-change
d0c0: 64 3f 29 0a 20 20 28 6e 6f 74 20 28 65 71 75 61 d?). (not (equa
d0d0: 6c 3f 20 28 73 75 62 73 74 72 69 6e 67 20 28 2d l? (substring (-
d0e0: 3e 73 74 72 69 6e 67 20 6d 65 67 61 74 65 73 74 >string megatest
d0f0: 2d 76 65 72 73 69 6f 6e 29 20 30 20 34 29 0a 20 -version) 0 4).
d100: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 (s
d110: 75 62 73 74 72 69 6e 67 20 28 63 6f 6e 63 20 28 ubstring (conc (
d120: 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 6c 61 73 74 2d common:get-last-
d130: 72 75 6e 2d 76 65 72 73 69 6f 6e 29 29 20 30 20 run-version)) 0
d140: 34 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 4))))..(define (
d150: 73 74 64 2d 65 78 69 74 2d 70 72 6f 63 65 64 75 std-exit-procedu
d160: 72 65 29 0a 20 20 3b 3b 28 63 6f 6d 6d 6f 6e 3a re). ;;(common:
d170: 74 65 6c 65 6d 65 74 72 79 2d 6c 6f 67 2d 63 6c telemetry-log-cl
d180: 6f 73 65 29 0a 20 20 28 6f 6e 2d 65 78 69 74 20 ose). (on-exit
d190: 28 6c 61 6d 62 64 61 20 28 29 20 30 29 29 0a 20 (lambda () 0)).
d1a0: 20 3b 3b 28 64 65 62 75 67 3a 70 72 69 6e 74 2d ;;(debug:print-
d1b0: 69 6e 66 6f 20 31 33 20 2a 64 65 66 61 75 6c 74 info 13 *default
d1c0: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 73 74 64 2d -log-port* "std-
d1d0: 65 78 69 74 2d 70 72 6f 63 65 64 75 72 65 20 63 exit-procedure c
d1e0: 61 6c 6c 65 64 3b 20 2a 74 69 6d 65 2d 74 6f 2d alled; *time-to-
d1f0: 65 78 69 74 2a 3d 22 2a 74 69 6d 65 2d 74 6f 2d exit*="*time-to-
d200: 65 78 69 74 2a 29 0a 20 20 28 6c 65 74 20 28 28 exit*). (let ((
d210: 6e 6f 2d 68 75 72 72 79 20 20 28 69 66 20 28 62 no-hurry (if (b
d220: 64 61 74 2d 74 69 6d 65 2d 74 6f 2d 65 78 69 74 dat-time-to-exit
d230: 20 2a 62 64 61 74 2a 29 20 3b 3b 20 68 75 72 72 *bdat*) ;; hurr
d240: 79 20 75 70 0a 09 09 20 20 20 20 20 20 20 23 66 y up... #f
d250: 0a 09 09 20 20 20 20 20 20 20 28 62 65 67 69 6e ... (begin
d260: 0a 09 09 09 20 28 62 64 61 74 2d 74 69 6d 65 2d .... (bdat-time-
d270: 74 6f 2d 65 78 69 74 2d 73 65 74 21 20 2a 62 64 to-exit-set! *bd
d280: 61 74 2a 20 23 74 29 0a 09 09 09 20 23 74 29 29 at* #t).... #t))
d290: 29 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 )). (debug:pr
d2a0: 69 6e 74 2d 69 6e 66 6f 20 34 20 2a 64 65 66 61 int-info 4 *defa
d2b0: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 73 ult-log-port* "s
d2c0: 74 61 72 74 69 6e 67 20 65 78 69 74 20 70 72 6f tarting exit pro
d2d0: 63 65 73 73 2c 20 66 69 6e 61 6c 69 7a 69 6e 67 cess, finalizing
d2e0: 20 64 61 74 61 62 61 73 65 73 2e 22 29 0a 20 20 databases.").
d2f0: 20 20 28 69 66 20 28 61 6e 64 20 6e 6f 2d 68 75 (if (and no-hu
d300: 72 72 79 20 28 64 65 62 75 67 3a 64 65 62 75 67 rry (debug:debug
d310: 2d 6d 6f 64 65 20 31 38 29 29 0a 09 28 72 6d 74 -mode 18))..(rmt
d320: 3a 70 72 69 6e 74 2d 64 62 2d 73 74 61 74 73 29 :print-db-stats)
d330: 29 0a 20 20 20 20 28 6c 65 74 20 28 28 74 68 31 ). (let ((th1
d340: 20 28 6d 61 6b 65 2d 74 68 72 65 61 64 0a 09 09 (make-thread...
d350: 28 6c 61 6d 62 64 61 20 28 29 20 3b 3b 20 74 68 (lambda () ;; th
d360: 72 65 61 64 20 66 6f 72 20 63 6c 65 61 6e 69 6e read for cleanin
d370: 67 20 75 70 2c 20 67 69 76 65 20 69 74 20 66 69 g up, give it fi
d380: 76 65 20 73 65 63 6f 6e 64 73 0a 09 09 20 20 28 ve seconds... (
d390: 6c 65 74 2a 20 28 28 73 74 61 72 74 2d 74 69 6d let* ((start-tim
d3a0: 65 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e e (current-secon
d3b0: 64 73 29 29 29 0a 09 09 20 20 20 20 28 69 66 20 ds)))... (if
d3c0: 2a 64 62 2d 73 65 72 76 2d 69 6e 66 6f 2a 0a 09 *db-serv-info*..
d3d0: 09 09 28 6c 65 74 2a 20 28 28 68 6f 73 74 20 28 ..(let* ((host (
d3e0: 73 65 72 76 64 61 74 2d 68 6f 73 74 20 2a 64 62 servdat-host *db
d3f0: 2d 73 65 72 76 2d 69 6e 66 6f 2a 29 29 0a 09 09 -serv-info*))...
d400: 09 20 20 20 20 20 20 20 28 70 6f 72 74 20 09 20 . (port .
d410: 20 20 20 20 20 20 28 73 65 72 76 64 61 74 2d 70 (servdat-p
d420: 6f 72 74 20 2a 64 62 2d 73 65 72 76 2d 69 6e 66 ort *db-serv-inf
d430: 6f 2a 29 29 29 0a 09 09 09 20 20 28 64 65 62 75 o*))).... (debu
d440: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a g:print-info 0 *
d450: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
d460: 2a 20 22 53 68 75 74 74 69 6e 67 20 64 6f 77 6e * "Shutting down
d470: 20 73 65 72 76 65 72 2f 72 65 73 70 6f 6e 64 65 server/responde
d480: 72 2e 22 29 0a 09 09 09 20 20 3b 3b 0a 09 09 09 r.").... ;;....
d490: 20 20 3b 3b 20 54 4f 44 4f 20 2d 20 61 64 64 20 ;; TODO - add
d4a0: 66 6c 75 73 68 69 6e 67 2f 77 61 69 74 69 6e 67 flushing/waiting
d4b0: 20 6f 6e 20 74 68 65 20 77 6f 72 6b 20 71 75 65 on the work que
d4c0: 75 65 0a 09 09 09 20 20 3b 3b 0a 09 09 09 20 20 ue.... ;;....
d4d0: 28 72 6d 74 3a 73 65 72 76 65 72 2d 73 68 75 74 (rmt:server-shut
d4e0: 64 6f 77 6e 20 68 6f 73 74 20 70 6f 72 74 29 0a down host port).
d4f0: 09 09 09 20 20 28 70 6f 72 74 6c 6f 67 67 65 72 ... (portlogger
d500: 3a 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 :open-run-close
d510: 70 6f 72 74 6c 6f 67 67 65 72 3a 73 65 74 2d 70 portlogger:set-p
d520: 6f 72 74 20 70 6f 72 74 20 22 72 65 6c 65 61 73 ort port "releas
d530: 65 64 22 29 29 29 0a 09 09 09 09 0a 09 09 20 20 ed")))........
d540: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
d550: 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c nfo 0 *default-l
d560: 6f 67 2d 70 6f 72 74 2a 20 22 53 68 75 74 64 6f og-port* "Shutdo
d570: 77 6e 20 61 63 74 69 76 69 74 69 65 73 20 63 6f wn activities co
d580: 6d 70 6c 65 74 65 64 20 69 6e 20 22 28 2d 20 28 mpleted in "(- (
d590: 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 current-seconds)
d5a0: 20 73 74 61 72 74 2d 74 69 6d 65 29 22 20 73 65 start-time)" se
d5b0: 63 6f 6e 64 73 22 29 29 0a 09 09 20 20 3b 3b 20 conds"))... ;;
d5c0: 28 69 66 20 2a 64 62 73 74 72 75 63 74 2d 64 62 (if *dbstruct-db
d5d0: 2a 20 28 64 62 3a 63 6c 6f 73 65 2d 61 6c 6c 20 * (db:close-all
d5e0: 2a 64 62 73 74 72 75 63 74 2d 64 62 2a 29 29 20 *dbstruct-db*))
d5f0: 3b 3b 20 6f 6e 65 20 73 65 63 6f 6e 64 20 61 6c ;; one second al
d600: 6c 6f 63 61 74 65 64 0a 09 09 20 20 23 3b 28 69 located... #;(i
d610: 66 20 28 62 64 61 74 2d 74 61 73 6b 2d 64 62 20 f (bdat-task-db
d620: 2a 62 64 61 74 2a 29 20 20 20 20 3b 3b 20 54 4f *bdat*) ;; TO
d630: 44 4f 3a 20 43 68 65 63 6b 20 74 68 61 74 20 74 DO: Check that t
d640: 68 69 73 20 69 73 20 63 6f 72 72 65 63 74 20 66 his is correct f
d650: 6f 72 20 74 61 73 6b 20 64 62 0a 09 09 20 20 28 or task db... (
d660: 6c 65 74 20 28 28 64 62 20 28 63 64 72 20 28 62 let ((db (cdr (b
d670: 64 61 74 2d 74 61 73 6b 2d 64 62 20 2a 62 64 61 dat-task-db *bda
d680: 74 2a 29 29 29 29 0a 09 09 20 20 28 69 66 20 28 t*))))... (if (
d690: 73 71 6c 69 74 65 33 3a 64 61 74 61 62 61 73 65 sqlite3:database
d6a0: 3f 20 64 62 29 0a 09 09 20 20 28 62 65 67 69 6e ? db)... (begin
d6b0: 0a 09 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e ... (debug:prin
d6c0: 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c t-info 0 *defaul
d6d0: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 43 6c 6f t-log-port* "Clo
d6e0: 73 69 6e 67 20 64 6f 77 6e 20 74 61 73 6b 20 64 sing down task d
d6f0: 62 20 22 64 62 29 0a 09 09 20 20 28 73 71 6c 69 b "db)... (sqli
d700: 74 65 33 3a 69 6e 74 65 72 72 75 70 74 21 20 64 te3:interrupt! d
d710: 62 29 0a 09 09 20 20 28 73 71 6c 69 74 65 33 3a b)... (sqlite3:
d720: 66 69 6e 61 6c 69 7a 65 21 20 64 62 20 23 74 29 finalize! db #t)
d730: 0a 09 09 20 20 28 62 64 61 74 2d 74 61 73 6b 2d ... (bdat-task-
d740: 64 62 2d 73 65 74 21 20 2a 62 64 61 74 2a 20 23 db-set! *bdat* #
d750: 66 29 29 29 29 29 0a 09 09 20 20 23 3b 28 68 74 f)))))... #;(ht
d760: 74 70 2d 63 6c 69 65 6e 74 23 63 6c 6f 73 65 2d tp-client#close-
d770: 69 64 6c 65 2d 63 6f 6e 6e 65 63 74 69 6f 6e 73 idle-connections
d780: 21 29 0a 09 09 20 20 28 69 66 20 28 6e 6f 74 20 !)... (if (not
d790: 28 65 71 3f 20 2a 64 65 66 61 75 6c 74 2d 6c 6f (eq? *default-lo
d7a0: 67 2d 70 6f 72 74 2a 20 28 63 75 72 72 65 6e 74 g-port* (current
d7b0: 2d 65 72 72 6f 72 2d 70 6f 72 74 29 29 29 0a 09 -error-port)))..
d7c0: 09 20 20 20 20 20 20 28 63 6c 6f 73 65 2d 6f 75 . (close-ou
d7d0: 74 70 75 74 2d 70 6f 72 74 20 2a 64 65 66 61 75 tput-port *defau
d7e0: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 29 29 0a 09 lt-log-port*))..
d7f0: 09 20 20 28 73 65 74 21 20 2a 64 65 66 61 75 6c . (set! *defaul
d800: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 28 63 75 72 t-log-port* (cur
d810: 72 65 6e 74 2d 65 72 72 6f 72 2d 70 6f 72 74 29 rent-error-port)
d820: 29 29 20 22 43 6c 65 61 6e 75 70 20 64 62 20 65 )) "Cleanup db e
d830: 78 69 74 20 74 68 72 65 61 64 22 29 29 0a 09 20 xit thread"))..
d840: 20 28 74 68 32 20 28 6d 61 6b 65 2d 74 68 72 65 (th2 (make-thre
d850: 61 64 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 ad (lambda ()...
d860: 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
d870: 69 6e 74 20 34 20 2a 64 65 66 61 75 6c 74 2d 6c int 4 *default-l
d880: 6f 67 2d 70 6f 72 74 2a 20 22 41 74 74 65 6d 70 og-port* "Attemp
d890: 74 69 6e 67 20 63 6c 65 61 6e 20 65 78 69 74 2e ting clean exit.
d8a0: 20 4d 6f 64 65 3d 22 28 69 66 20 6e 6f 2d 68 75 Mode="(if no-hu
d8b0: 72 72 79 20 22 6e 6f 2d 68 75 72 72 79 22 20 22 rry "no-hurry" "
d8c0: 6e 6f 72 6d 61 6c 22 29 0a 09 09 09 09 09 20 20 normal")......
d8d0: 20 22 20 50 6c 65 61 73 65 20 62 65 20 70 61 74 " Please be pat
d8e0: 69 65 6e 74 20 61 6e 64 20 77 61 69 74 20 61 20 ient and wait a
d8f0: 66 65 77 20 73 65 63 6f 6e 64 73 2e 2e 2e 22 29 few seconds...")
d900: 0a 09 09 09 20 20 20 20 20 20 28 69 66 20 6e 6f .... (if no
d910: 2d 68 75 72 72 79 0a 20 20 20 20 20 20 20 20 20 -hurry.
d920: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d930: 20 20 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a (begin.
d940: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d950: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d960: 20 20 20 20 28 74 68 72 65 61 64 2d 73 6c 65 65 (thread-slee
d970: 70 21 20 35 29 29 20 3b 3b 20 67 69 76 65 20 74 p! 5)) ;; give t
d980: 68 65 20 63 6c 65 61 6e 20 75 70 20 66 65 77 20 he clean up few
d990: 73 65 63 6f 6e 64 73 20 74 6f 20 64 6f 20 69 74 seconds to do it
d9a0: 27 73 20 73 74 75 66 66 0a 20 20 20 20 20 20 20 's stuff.
d9b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d9c0: 20 20 20 20 20 20 20 20 20 20 20 28 62 65 67 69 (begi
d9d0: 6e 0a 09 09 09 09 20 20 20 20 28 74 68 72 65 61 n..... (threa
d9e0: 64 2d 73 6c 65 65 70 21 20 32 29 29 29 0a 20 20 d-sleep! 2))).
d9f0: 20 20 20 20 09 09 09 20 20 20 20 20 20 28 64 65 ... (de
da00: 62 75 67 3a 70 72 69 6e 74 20 34 20 2a 64 65 66 bug:print 4 *def
da10: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
da20: 20 2e 2e 2e 20 64 6f 6e 65 22 29 0a 20 20 20 20 ... done").
da30: 20 20 09 09 09 20 20 20 20 20 20 29 0a 09 09 09 ... )....
da40: 20 20 20 20 22 63 6c 65 61 6e 20 65 78 69 74 22 "clean exit"
da50: 29 29 29 0a 20 20 20 20 20 20 28 74 68 72 65 61 ))). (threa
da60: 64 2d 73 74 61 72 74 21 20 74 68 31 29 0a 20 20 d-start! th1).
da70: 20 20 20 20 28 74 68 72 65 61 64 2d 73 74 61 72 (thread-star
da80: 74 21 20 74 68 32 29 0a 20 20 20 20 20 20 28 74 t! th2). (t
da90: 68 72 65 61 64 2d 6a 6f 69 6e 21 20 74 68 31 29 hread-join! th1)
daa0: 0a 20 20 20 20 20 20 29 0a 20 20 20 20 29 0a 0a . ). )..
dab0: 20 20 30 29 0a 0a 3b 3b 20 63 61 6c 6c 65 64 20 0)..;; called
dac0: 69 6e 20 6d 65 67 61 74 65 73 74 2e 73 63 6d 2c in megatest.scm,
dad0: 20 68 6f 73 74 2d 70 6f 72 74 20 69 73 20 73 74 host-port is st
dae0: 72 69 6e 67 20 68 6f 73 74 6e 61 6d 65 3a 70 6f ring hostname:po
daf0: 72 74 0a 3b 3b 0a 3b 3b 20 4e 4f 54 45 3a 20 54 rt.;;.;; NOTE: T
db00: 68 69 73 20 69 73 20 4e 4f 54 20 63 61 6c 6c 65 his is NOT calle
db10: 64 20 64 69 72 65 63 74 6c 79 20 66 72 6f 6d 20 d directly from
db20: 63 6c 69 65 6e 74 73 20 61 73 20 6e 6f 74 20 61 clients as not a
db30: 6c 6c 20 74 72 61 6e 73 70 6f 72 74 73 20 73 75 ll transports su
db40: 70 70 6f 72 74 20 61 20 63 6c 69 65 6e 74 20 72 pport a client r
db50: 75 6e 6e 69 6e 67 0a 3b 3b 20 20 20 20 20 20 20 unning.;;
db60: 69 6e 20 74 68 65 20 73 61 6d 65 20 70 72 6f 63 in the same proc
db70: 65 73 73 20 61 73 20 74 68 65 20 73 65 72 76 65 ess as the serve
db80: 72 2e 20 0a 3b 3b 0a 3b 3b 20 63 6f 6e 6e 20 69 r. .;;.;; conn i
db90: 73 20 61 20 63 6f 6e 6e 64 61 74 20 72 65 63 6f s a conndat reco
dba0: 72 64 0a 3b 3b 0a 23 3b 28 64 65 66 69 6e 65 20 rd.;;.#;(define
dbb0: 28 73 65 72 76 65 72 3a 70 69 6e 67 20 75 63 6f (server:ping uco
dbc0: 6e 6e 20 23 21 6b 65 79 20 28 64 6f 2d 65 78 69 nn #!key (do-exi
dbd0: 74 20 23 66 29 29 0a 20 20 28 6c 65 74 2a 20 28 t #f)). (let* (
dbe0: 28 73 72 76 6b 65 79 20 28 63 6f 6e 6e 64 61 74 (srvkey (conndat
dbf0: 2d 73 72 76 6b 65 79 20 75 63 6f 6e 6e 29 29 0a -srvkey uconn)).
dc00: 09 20 28 6d 73 67 20 28 73 65 78 70 72 2d 3e 73 . (msg (sexpr->s
dc10: 74 72 69 6e 67 20 27 28 70 69 6e 67 20 2c 73 72 tring '(ping ,sr
dc20: 76 6b 65 79 29 29 29 29 0a 20 20 20 20 28 73 65 vkey)))). (se
dc30: 6e 64 2d 72 65 63 65 69 76 65 20 75 63 6f 6e 6e nd-receive uconn
dc40: 20 27 70 69 6e 67 20 6d 73 67 29 29 29 20 3b 3b 'ping msg))) ;;
dc50: 20 28 73 65 72 76 65 72 2d 72 65 61 64 79 3f 20 (server-ready?
dc60: 68 6f 73 74 20 70 6f 72 74 20 73 65 72 76 65 72 host port server
dc70: 2d 69 64 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d -id))..;;=======
dc80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
dc90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
dca0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
dcb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
dcc0: 3b 3b 20 68 74 74 70 2d 74 72 61 6e 73 70 6f 72 ;; http-transpor
dcd0: 74 6d 6f 64 2e 73 63 6d 20 63 6f 6e 74 65 6e 74 tmod.scm content
dce0: 73 20 6d 6f 76 65 64 20 68 65 72 65 0a 3b 3b 3d s moved here.;;=
dcf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
dd00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
dd10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
dd20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
dd30: 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 =====..(define (
dd40: 68 74 74 70 2d 74 72 61 6e 73 70 6f 72 74 3a 6d http-transport:m
dd50: 61 6b 65 2d 73 65 72 76 65 72 2d 75 72 6c 20 68 ake-server-url h
dd60: 6f 73 74 70 6f 72 74 29 0a 20 20 28 69 66 20 28 ostport). (if (
dd70: 6e 6f 74 20 68 6f 73 74 70 6f 72 74 29 0a 20 20 not hostport).
dd80: 20 20 20 20 23 66 0a 20 20 20 20 20 20 28 63 6f #f. (co
dd90: 6e 63 20 22 68 74 74 70 3a 2f 2f 22 20 28 63 61 nc "http://" (ca
dda0: 72 20 68 6f 73 74 70 6f 72 74 29 20 22 3a 22 20 r hostport) ":"
ddb0: 28 63 61 64 72 20 68 6f 73 74 70 6f 72 74 29 29 (cadr hostport))
ddc0: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
ddd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
dde0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ddf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
de00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
de10: 53 20 45 20 52 20 56 20 45 20 52 0a 3b 3b 20 3d S E R V E R.;; =
de20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
de30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
de40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
de50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
de60: 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 28 64 65 66 69 6e =====..;; (defin
de70: 65 20 28 68 74 74 70 2d 67 65 74 2d 66 75 6e 63 e (http-get-func
de80: 74 69 6f 6e 20 66 6e 6b 65 79 29 0a 3b 3b 20 20 tion fnkey).;;
de90: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
dea0: 2f 64 65 66 61 75 6c 74 20 2a 68 74 74 70 2d 66 /default *http-f
deb0: 75 6e 63 74 69 6f 6e 73 2a 20 66 6e 6b 65 79 20 unctions* fnkey
dec0: 28 6c 61 6d 62 64 61 20 28 29 20 22 6e 6f 74 68 (lambda () "noth
ded0: 69 6e 67 20 68 65 72 65 20 79 65 74 22 29 29 29 ing here yet")))
dee0: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
def0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
df00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
df10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
df20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 20 ==========.;; C
df30: 4c 20 49 20 45 20 4e 20 54 20 53 0a 3b 3b 3d 3d L I E N T S.;;==
df40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
df50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
df60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
df70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
df80: 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 72 ====..(define (r
df90: 6d 74 3a 67 65 74 2d 74 69 6d 65 2d 74 6f 2d 63 mt:get-time-to-c
dfa0: 6c 65 61 6e 75 70 29 0a 20 20 28 6c 65 74 20 28 leanup). (let (
dfb0: 28 72 65 73 20 23 66 29 29 0a 20 20 20 20 28 6d (res #f)). (m
dfc0: 75 74 65 78 2d 6c 6f 63 6b 21 20 2a 68 74 74 70 utex-lock! *http
dfd0: 2d 6d 75 74 65 78 2a 29 0a 20 20 20 20 28 73 65 -mutex*). (se
dfe0: 74 21 20 72 65 73 20 28 3e 20 28 63 75 72 72 65 t! res (> (curre
dff0: 6e 74 2d 73 65 63 6f 6e 64 73 29 20 2a 68 74 74 nt-seconds) *htt
e000: 70 2d 63 6f 6e 6e 65 63 74 69 6f 6e 73 2d 6e 65 p-connections-ne
e010: 78 74 2d 63 6c 65 61 6e 75 70 2a 29 29 0a 20 20 xt-cleanup*)).
e020: 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 (mutex-unlock!
e030: 20 2a 68 74 74 70 2d 6d 75 74 65 78 2a 29 0a 20 *http-mutex*).
e040: 20 20 20 72 65 73 29 29 0a 0a 28 64 65 66 69 6e res))..(defin
e050: 65 20 28 72 6d 74 3a 69 6e 63 2d 72 65 71 75 65 e (rmt:inc-reque
e060: 73 74 73 2d 63 6f 75 6e 74 29 0a 20 20 28 6d 75 sts-count). (mu
e070: 74 65 78 2d 6c 6f 63 6b 21 20 2a 68 74 74 70 2d tex-lock! *http-
e080: 6d 75 74 65 78 2a 29 0a 20 20 28 73 65 74 21 20 mutex*). (set!
e090: 2a 68 74 74 70 2d 72 65 71 75 65 73 74 73 2d 69 *http-requests-i
e0a0: 6e 2d 70 72 6f 67 72 65 73 73 2a 20 28 2b 20 31 n-progress* (+ 1
e0b0: 20 2a 68 74 74 70 2d 72 65 71 75 65 73 74 73 2d *http-requests-
e0c0: 69 6e 2d 70 72 6f 67 72 65 73 73 2a 29 29 0a 20 in-progress*)).
e0d0: 20 3b 3b 20 55 73 65 20 74 68 69 73 20 6f 70 70 ;; Use this opp
e0e0: 6f 72 74 75 6e 69 74 79 20 74 6f 20 73 6c 6f 77 ortunity to slow
e0f0: 20 74 68 69 6e 67 73 20 64 6f 77 6e 20 69 66 66 things down iff
e100: 20 74 68 65 72 65 20 61 72 65 20 74 6f 6f 20 6d there are too m
e110: 61 6e 79 20 72 65 71 75 65 73 74 73 20 69 6e 20 any requests in
e120: 66 6c 69 67 68 74 0a 20 20 28 69 66 20 28 3e 20 flight. (if (>
e130: 2a 68 74 74 70 2d 72 65 71 75 65 73 74 73 2d 69 *http-requests-i
e140: 6e 2d 70 72 6f 67 72 65 73 73 2a 20 35 29 0a 20 n-progress* 5).
e150: 20 20 20 20 20 28 62 65 67 69 6e 0a 09 28 64 65 (begin..(de
e160: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 bug:print-info 0
e170: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
e180: 72 74 2a 20 22 57 68 6f 61 20 74 68 65 72 65 20 rt* "Whoa there
e190: 62 75 64 64 79 2c 20 65 61 73 65 20 75 70 2e 2e buddy, ease up..
e1a0: 2e 22 29 0a 09 28 74 68 72 65 61 64 2d 73 6c 65 .")..(thread-sle
e1b0: 65 70 21 20 31 29 29 29 0a 20 20 28 6d 75 74 65 ep! 1))). (mute
e1c0: 78 2d 75 6e 6c 6f 63 6b 21 20 2a 68 74 74 70 2d x-unlock! *http-
e1d0: 6d 75 74 65 78 2a 29 29 0a 0a 28 64 65 66 69 6e mutex*))..(defin
e1e0: 65 20 28 72 6d 74 3a 64 65 63 2d 72 65 71 75 65 e (rmt:dec-reque
e1f0: 73 74 73 2d 63 6f 75 6e 74 20 70 72 6f 63 29 20 sts-count proc)
e200: 0a 20 20 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 . (mutex-lock!
e210: 2a 68 74 74 70 2d 6d 75 74 65 78 2a 29 0a 20 20 *http-mutex*).
e220: 28 70 72 6f 63 29 0a 20 20 28 73 65 74 21 20 2a (proc). (set! *
e230: 68 74 74 70 2d 72 65 71 75 65 73 74 73 2d 69 6e http-requests-in
e240: 2d 70 72 6f 67 72 65 73 73 2a 20 28 2d 20 2a 68 -progress* (- *h
e250: 74 74 70 2d 72 65 71 75 65 73 74 73 2d 69 6e 2d ttp-requests-in-
e260: 70 72 6f 67 72 65 73 73 2a 20 31 29 29 0a 20 20 progress* 1)).
e270: 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 2a (mutex-unlock! *
e280: 68 74 74 70 2d 6d 75 74 65 78 2a 29 29 0a 0a 28 http-mutex*))..(
e290: 64 65 66 69 6e 65 20 28 72 6d 74 3a 64 65 63 2d define (rmt:dec-
e2a0: 72 65 71 75 65 73 74 73 2d 63 6f 75 6e 74 2d 61 requests-count-a
e2b0: 6e 64 2d 63 6c 6f 73 65 2d 61 6c 6c 2d 63 6f 6e nd-close-all-con
e2c0: 6e 65 63 74 69 6f 6e 73 29 0a 20 20 28 73 65 74 nections). (set
e2d0: 21 20 2a 68 74 74 70 2d 72 65 71 75 65 73 74 73 ! *http-requests
e2e0: 2d 69 6e 2d 70 72 6f 67 72 65 73 73 2a 20 28 2d -in-progress* (-
e2f0: 20 2a 68 74 74 70 2d 72 65 71 75 65 73 74 73 2d *http-requests-
e300: 69 6e 2d 70 72 6f 67 72 65 73 73 2a 20 31 29 29 in-progress* 1))
e310: 0a 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 65 . (let loop ((e
e320: 74 69 6d 65 20 28 2b 20 28 63 75 72 72 65 6e 74 time (+ (current
e330: 2d 73 65 63 6f 6e 64 73 29 20 35 29 29 29 20 3b -seconds) 5))) ;
e340: 3b 20 67 69 76 65 20 75 70 20 69 6e 20 66 69 76 ; give up in fiv
e350: 65 20 73 65 63 6f 6e 64 73 0a 20 20 20 20 28 69 e seconds. (i
e360: 66 20 28 3e 20 2a 68 74 74 70 2d 72 65 71 75 65 f (> *http-reque
e370: 73 74 73 2d 69 6e 2d 70 72 6f 67 72 65 73 73 2a sts-in-progress*
e380: 20 30 29 0a 09 28 69 66 20 28 3e 20 65 74 69 6d 0)..(if (> etim
e390: 65 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e e (current-secon
e3a0: 64 73 29 29 0a 09 20 20 20 20 28 62 65 67 69 6e ds)).. (begin
e3b0: 0a 09 20 20 20 20 20 20 28 74 68 72 65 61 64 2d .. (thread-
e3c0: 73 6c 65 65 70 21 20 30 2e 30 35 32 29 0a 09 20 sleep! 0.052)..
e3d0: 20 20 20 20 20 28 6c 6f 6f 70 20 65 74 69 6d 65 (loop etime
e3e0: 29 29 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 )).. (debug:p
e3f0: 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 rint-error 0 *de
e400: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 0a fault-log-port*.
e410: 09 09 09 20 20 20 20 20 20 20 22 72 65 71 75 65 ... "reque
e420: 73 74 73 20 73 74 69 6c 6c 20 69 6e 20 70 72 6f sts still in pro
e430: 67 72 65 73 73 20 61 66 74 65 72 20 35 20 73 65 gress after 5 se
e440: 63 6f 6e 64 73 20 6f 66 20 77 61 69 74 69 6e 67 conds of waiting
e450: 2e 20 49 27 6d 20 67 6f 69 6e 67 20 74 6f 20 70 . I'm going to p
e460: 61 73 73 20 6f 6e 20 63 6c 65 61 6e 69 6e 67 20 ass on cleaning
e470: 75 70 20 68 74 74 70 20 63 6f 6e 6e 65 63 74 69 up http connecti
e480: 6f 6e 73 22 29 29 0a 09 23 3b 28 63 6c 6f 73 65 ons"))..#;(close
e490: 2d 69 64 6c 65 2d 63 6f 6e 6e 65 63 74 69 6f 6e -idle-connection
e4a0: 73 21 29 29 29 0a 20 20 28 73 65 74 21 20 2a 68 s!))). (set! *h
e4b0: 74 74 70 2d 63 6f 6e 6e 65 63 74 69 6f 6e 73 2d ttp-connections-
e4c0: 6e 65 78 74 2d 63 6c 65 61 6e 75 70 2a 20 28 2b next-cleanup* (+
e4d0: 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 (current-second
e4e0: 73 29 20 31 30 29 29 0a 20 20 28 6d 75 74 65 78 s) 10)). (mutex
e4f0: 2d 75 6e 6c 6f 63 6b 21 20 2a 68 74 74 70 2d 6d -unlock! *http-m
e500: 75 74 65 78 2a 29 29 0a 0a 28 64 65 66 69 6e 65 utex*))..(define
e510: 20 28 72 6d 74 3a 69 6e 63 2d 72 65 71 75 65 73 (rmt:inc-reques
e520: 74 73 2d 61 6e 64 2d 70 72 65 70 2d 74 6f 2d 63 ts-and-prep-to-c
e530: 6c 6f 73 65 2d 61 6c 6c 2d 63 6f 6e 6e 65 63 74 lose-all-connect
e540: 69 6f 6e 73 29 0a 20 20 28 6d 75 74 65 78 2d 6c ions). (mutex-l
e550: 6f 63 6b 21 20 2a 68 74 74 70 2d 6d 75 74 65 78 ock! *http-mutex
e560: 2a 29 0a 20 20 28 73 65 74 21 20 2a 68 74 74 70 *). (set! *http
e570: 2d 72 65 71 75 65 73 74 73 2d 69 6e 2d 70 72 6f -requests-in-pro
e580: 67 72 65 73 73 2a 20 28 2b 20 31 20 2a 68 74 74 gress* (+ 1 *htt
e590: 70 2d 72 65 71 75 65 73 74 73 2d 69 6e 2d 70 72 p-requests-in-pr
e5a0: 6f 67 72 65 73 73 2a 29 29 29 0a 0a 0a 0a 29 0a ogress*)))....).
e5b0: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
e5c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e5d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e5e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e5f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 41 20 54 =========.;; A T
e600: 20 54 20 49 20 43 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d T I C.;;=======
e610: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e620: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e630: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e640: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
e650: 0a .