Artifact
db63cb4f1dd1a1a330c071a045fefabd4e2f51f7:
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 31 37 2c 20 4d 61 74 74 right 2017, 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 3d 3d 3d 3d 3d 3d 3d 3d ====..;;========
0390: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
03d0: 3b 20 43 70 75 6d 6f 64 3a 0a 3b 3b 0a 3b 3b 20 ; Cpumod:.;;.;;
03e0: 20 20 50 75 74 20 74 68 69 6e 67 73 20 68 65 72 Put things her
03f0: 65 20 64 6f 6e 27 74 20 66 69 74 20 61 6e 79 77 e don't fit anyw
0400: 68 65 72 65 20 65 6c 73 65 0a 3b 3b 3d 3d 3d 3d here else.;;====
0410: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0420: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0430: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0440: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0450: 3d 3d 0a 0a 28 64 65 63 6c 61 72 65 20 28 75 6e ==..(declare (un
0460: 69 74 20 74 65 73 74 73 6d 6f 64 29 29 0a 28 64 it testsmod)).(d
0470: 65 63 6c 61 72 65 20 28 75 73 65 73 20 64 65 62 eclare (uses deb
0480: 75 67 70 72 69 6e 74 29 29 0a 28 64 65 63 6c 61 ugprint)).(decla
0490: 72 65 20 28 75 73 65 73 20 6d 74 61 72 67 73 29 re (uses mtargs)
04a0: 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ).(declare (uses
04b0: 20 63 6f 6d 6d 6f 6e 6d 6f 64 29 29 0a 28 64 65 commonmod)).(de
04c0: 63 6c 61 72 65 20 28 75 73 65 73 20 63 6f 6e 66 clare (uses conf
04d0: 69 67 66 6d 6f 64 29 29 0a 28 64 65 63 6c 61 72 igfmod)).(declar
04e0: 65 20 28 75 73 65 73 20 64 62 6d 6f 64 29 29 0a e (uses dbmod)).
04f0: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 64 (declare (uses d
0500: 62 66 69 6c 65 29 29 0a 28 64 65 63 6c 61 72 65 bfile)).(declare
0510: 20 28 75 73 65 73 20 6d 65 67 61 74 65 73 74 6d (uses megatestm
0520: 6f 64 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 od)).(declare (u
0530: 73 65 73 20 72 6d 74 6d 6f 64 29 29 0a 28 64 65 ses rmtmod)).(de
0540: 63 6c 61 72 65 20 28 75 73 65 73 20 73 74 6d 6c clare (uses stml
0550: 32 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 2)).(declare (us
0560: 65 73 20 6d 74 6d 6f 64 29 29 0a 28 64 65 63 6c es mtmod)).(decl
0570: 61 72 65 20 28 75 73 65 73 20 73 65 72 76 65 72 are (uses server
0580: 6d 6f 64 29 29 0a 28 64 65 63 6c 61 72 65 20 28 mod)).(declare (
0590: 75 73 65 73 20 66 73 6d 6f 64 29 29 0a 0a 28 75 uses fsmod))..(u
05a0: 73 65 20 73 72 66 69 2d 36 39 29 0a 0a 28 6d 6f se srfi-69)..(mo
05b0: 64 75 6c 65 20 74 65 73 74 73 6d 6f 64 0a 09 28 dule testsmod..(
05c0: 0a 09 20 74 65 73 74 73 3a 73 75 6d 6d 61 72 69 .. tests:summari
05d0: 7a 65 2d 69 74 65 6d 73 0a 09 20 74 65 73 74 73 ze-items.. tests
05e0: 3a 66 69 6c 74 65 72 2d 6e 6f 6e 2d 72 75 6e 6e :filter-non-runn
05f0: 61 62 6c 65 0a 09 20 74 65 73 74 73 3a 73 6f 72 able.. tests:sor
0600: 74 2d 62 79 2d 70 72 69 6f 72 69 74 79 2d 61 6e t-by-priority-an
0610: 64 2d 77 61 69 74 6f 6e 0a 0a 09 20 74 65 73 74 d-waiton... test
0620: 73 3a 73 75 6d 6d 61 72 69 7a 65 2d 74 65 73 74 s:summarize-test
0630: 0a 09 20 74 65 73 74 73 3a 73 61 76 65 2d 66 69 .. tests:save-fi
0640: 6e 61 6c 2d 73 74 61 74 75 73 0a 09 20 74 65 73 nal-status.. tes
0650: 74 73 3a 75 70 64 61 74 65 2d 63 65 6e 74 72 61 ts:update-centra
0660: 6c 2d 6d 65 74 61 2d 69 6e 66 6f 0a 09 20 74 65 l-meta-info.. te
0670: 73 74 73 3a 73 65 74 2d 66 75 6c 6c 2d 6d 65 74 sts:set-full-met
0680: 61 2d 69 6e 66 6f 0a 09 20 74 65 73 74 73 3a 67 a-info.. tests:g
0690: 65 74 2d 63 6f 6d 70 72 65 73 73 65 64 2d 73 74 et-compressed-st
06a0: 65 70 73 0a 09 20 74 65 73 74 73 3a 63 72 65 61 eps.. tests:crea
06b0: 74 65 2d 68 74 6d 6c 2d 73 75 6d 6d 61 72 79 0a te-html-summary.
06c0: 09 20 74 65 73 74 73 3a 63 72 65 61 74 65 2d 68 . tests:create-h
06d0: 74 6d 6c 2d 73 75 6d 6d 61 72 79 0a 09 20 74 65 tml-summary.. te
06e0: 73 74 73 3a 63 72 65 61 74 65 2d 68 74 6d 6c 2d sts:create-html-
06f0: 74 72 65 65 0a 09 20 74 65 73 74 73 3a 73 75 6d tree.. tests:sum
0700: 6d 61 72 69 7a 65 2d 69 74 65 6d 73 0a 09 20 74 marize-items.. t
0710: 65 73 74 73 3a 74 65 73 74 2d 67 65 74 2d 70 61 ests:test-get-pa
0720: 74 68 73 2d 6d 61 74 63 68 69 6e 67 0a 09 20 29 ths-matching.. )
0730: 0a 0a 28 69 6d 70 6f 72 74 20 73 63 68 65 6d 65 ..(import scheme
0740: 29 0a 28 63 6f 6e 64 2d 65 78 70 61 6e 64 0a 20 ).(cond-expand.
0750: 28 63 68 69 63 6b 65 6e 2d 34 0a 20 20 0a 20 20 (chicken-4. .
0760: 28 69 6d 70 6f 72 74 20 63 68 69 63 6b 65 6e 0a (import chicken.
0770: 09 20 20 70 6f 72 74 73 0a 09 20 20 28 70 72 65 . ports.. (pre
0780: 66 69 78 20 62 61 73 65 36 34 20 62 61 73 65 36 fix base64 base6
0790: 34 3a 29 0a 0a 09 20 20 28 70 72 65 66 69 78 20 4:)... (prefix
07a0: 73 71 6c 69 74 65 33 20 73 71 6c 69 74 65 33 3a sqlite3 sqlite3:
07b0: 29 0a 09 20 20 64 61 74 61 2d 73 74 72 75 63 74 ).. data-struct
07c0: 75 72 65 73 0a 09 20 20 65 78 74 72 61 73 0a 09 ures.. extras..
07d0: 20 20 66 69 6c 65 73 0a 09 20 20 6d 61 74 63 68 files.. match
07e0: 61 62 6c 65 0a 09 20 20 6d 64 35 0a 09 20 20 6d able.. md5.. m
07f0: 65 73 73 61 67 65 2d 64 69 67 65 73 74 0a 09 20 essage-digest..
0800: 20 70 61 74 68 6e 61 6d 65 2d 65 78 70 61 6e 64 pathname-expand
0810: 0a 09 20 20 70 6f 73 69 78 0a 09 20 20 70 6f 73 .. posix.. pos
0820: 69 78 2d 65 78 74 72 61 73 0a 09 20 20 72 65 67 ix-extras.. reg
0830: 65 78 0a 09 20 20 72 65 67 65 78 2d 63 61 73 65 ex.. regex-case
0840: 0a 09 20 20 73 70 61 72 73 65 2d 76 65 63 74 6f .. sparse-vecto
0850: 72 73 0a 09 20 20 73 72 66 69 2d 31 0a 09 20 20 rs.. srfi-1..
0860: 73 72 66 69 2d 31 33 0a 09 20 20 73 72 66 69 2d srfi-13.. srfi-
0870: 31 38 0a 09 20 20 73 72 66 69 2d 36 39 0a 09 20 18.. srfi-69..
0880: 20 74 79 70 65 64 2d 72 65 63 6f 72 64 73 0a 09 typed-records..
0890: 20 20 7a 33 0a 09 20 20 0a 09 20 20 64 65 62 75 z3.. .. debu
08a0: 67 70 72 69 6e 74 0a 09 20 20 28 70 72 65 66 69 gprint.. (prefi
08b0: 78 20 6d 74 61 72 67 73 20 61 72 67 73 3a 29 0a x mtargs args:).
08c0: 09 20 20 29 0a 20 20 28 75 73 65 20 73 72 66 69 . ). (use srfi
08d0: 2d 36 39 29 29 0a 20 28 63 68 69 63 6b 65 6e 2d -69)). (chicken-
08e0: 35 0a 20 20 28 69 6d 70 6f 72 74 20 28 70 72 65 5. (import (pre
08f0: 66 69 78 20 73 71 6c 69 74 65 33 20 73 71 6c 69 fix sqlite3 sqli
0900: 74 65 33 3a 29 0a 09 20 20 3b 3b 20 64 61 74 61 te3:).. ;; data
0910: 2d 73 74 72 75 63 74 75 72 65 73 0a 09 20 20 3b -structures.. ;
0920: 3b 20 65 78 74 72 61 73 0a 09 20 20 3b 3b 20 66 ; extras.. ;; f
0930: 69 6c 65 73 0a 09 20 20 3b 3b 20 70 6f 73 69 78 iles.. ;; posix
0940: 0a 09 20 20 3b 3b 20 70 6f 73 69 78 2d 65 78 74 .. ;; posix-ext
0950: 72 61 73 0a 09 20 20 63 68 69 63 6b 65 6e 2e 62 ras.. chicken.b
0960: 61 73 65 0a 09 20 20 63 68 69 63 6b 65 6e 2e 63 ase.. chicken.c
0970: 6f 6e 64 69 74 69 6f 6e 0a 09 20 20 63 68 69 63 ondition.. chic
0980: 6b 65 6e 2e 66 69 6c 65 0a 09 20 20 63 68 69 63 ken.file.. chic
0990: 6b 65 6e 2e 66 69 6c 65 2e 70 6f 73 69 78 0a 09 ken.file.posix..
09a0: 20 20 63 68 69 63 6b 65 6e 2e 69 6f 0a 09 20 20 chicken.io..
09b0: 63 68 69 63 6b 65 6e 2e 70 61 74 68 6e 61 6d 65 chicken.pathname
09c0: 0a 09 20 20 63 68 69 63 6b 65 6e 2e 70 6f 72 74 .. chicken.port
09d0: 0a 09 20 20 63 68 69 63 6b 65 6e 2e 70 72 6f 63 .. chicken.proc
09e0: 65 73 73 0a 09 20 20 63 68 69 63 6b 65 6e 2e 70 ess.. chicken.p
09f0: 72 6f 63 65 73 73 2d 63 6f 6e 74 65 78 74 0a 09 rocess-context..
0a00: 20 20 63 68 69 63 6b 65 6e 2e 70 72 6f 63 65 73 chicken.proces
0a10: 73 2d 63 6f 6e 74 65 78 74 2e 70 6f 73 69 78 0a s-context.posix.
0a20: 09 20 20 63 68 69 63 6b 65 6e 2e 73 6f 72 74 0a . chicken.sort.
0a30: 09 20 20 63 68 69 63 6b 65 6e 2e 73 74 72 69 6e . chicken.strin
0a40: 67 0a 09 20 20 63 68 69 63 6b 65 6e 2e 74 69 6d g.. chicken.tim
0a50: 65 0a 09 20 20 63 68 69 63 6b 65 6e 2e 74 69 6d e.. chicken.tim
0a60: 65 2e 70 6f 73 69 78 0a 09 20 20 0a 09 20 20 6d e.posix.. .. m
0a70: 61 74 63 68 61 62 6c 65 0a 09 20 20 6d 64 35 0a atchable.. md5.
0a80: 09 20 20 6d 65 73 73 61 67 65 2d 64 69 67 65 73 . message-diges
0a90: 74 0a 09 20 20 70 61 74 68 6e 61 6d 65 2d 65 78 t.. pathname-ex
0aa0: 70 61 6e 64 0a 09 20 20 72 65 67 65 78 0a 09 20 pand.. regex..
0ab0: 20 72 65 67 65 78 2d 63 61 73 65 0a 09 20 20 73 regex-case.. s
0ac0: 72 66 69 2d 31 0a 09 20 20 73 72 66 69 2d 31 38 rfi-1.. srfi-18
0ad0: 0a 09 20 20 73 72 66 69 2d 36 39 0a 09 20 20 74 .. srfi-69.. t
0ae0: 79 70 65 64 2d 72 65 63 6f 72 64 73 0a 09 20 20 yped-records..
0af0: 73 79 73 74 65 6d 2d 69 6e 66 6f 72 6d 61 74 69 system-informati
0b00: 6f 6e 0a 0a 09 20 20 64 65 62 75 67 70 72 69 6e on... debugprin
0b10: 74 0a 20 20 29 29 29 0a 0a 28 69 6d 70 6f 72 74 t. )))..(import
0b20: 20 64 69 72 65 63 74 6f 72 79 2d 75 74 69 6c 73 directory-utils
0b30: 0a 0a 09 64 65 62 75 67 70 72 69 6e 74 0a 09 63 ...debugprint..c
0b40: 6f 6d 6d 6f 6e 6d 6f 64 0a 09 63 6f 6e 66 69 67 ommonmod..config
0b50: 66 6d 6f 64 0a 09 64 62 6d 6f 64 0a 09 64 62 66 fmod..dbmod..dbf
0b60: 69 6c 65 0a 09 6d 65 67 61 74 65 73 74 6d 6f 64 ile..megatestmod
0b70: 0a 09 72 6d 74 6d 6f 64 0a 09 73 74 6d 6c 32 0a ..rmtmod..stml2.
0b80: 09 6d 74 6d 6f 64 0a 09 73 65 72 76 65 72 6d 6f .mtmod..servermo
0b90: 64 0a 09 66 73 6d 6f 64 0a 09 29 0a 0a 3b 3b 20 d..fsmod..)..;;
0ba0: 28 69 6e 63 6c 75 64 65 20 22 63 6f 6d 6d 6f 6e (include "common
0bb0: 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 3b _records.scm").;
0bc0: 3b 20 28 69 6e 63 6c 75 64 65 20 22 6b 65 79 5f ; (include "key_
0bd0: 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 3b 3b records.scm").;;
0be0: 20 28 69 6e 63 6c 75 64 65 20 22 64 62 5f 72 65 (include "db_re
0bf0: 63 6f 72 64 73 2e 73 63 6d 22 29 0a 28 69 6e 63 cords.scm").(inc
0c00: 6c 75 64 65 20 22 72 75 6e 5f 72 65 63 6f 72 64 lude "run_record
0c10: 73 2e 73 63 6d 22 29 0a 3b 3b 20 28 69 6e 63 6c s.scm").;; (incl
0c20: 75 64 65 20 22 74 65 73 74 5f 72 65 63 6f 72 64 ude "test_record
0c30: 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 s.scm").(include
0c40: 20 22 6a 73 2d 70 61 74 68 2e 73 63 6d 22 29 0a "js-path.scm").
0c50: 0a 28 64 65 66 69 6e 65 20 28 69 6e 69 74 2d 6a .(define (init-j
0c60: 61 76 61 2d 73 63 72 69 70 74 2d 6c 69 62 29 0a ava-script-lib).
0c70: 20 20 28 73 65 74 21 20 2a 6a 61 76 61 2d 73 63 (set! *java-sc
0c80: 72 69 70 74 2d 6c 69 62 2a 20 28 63 6f 6e 63 20 ript-lib* (conc
0c90: 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 69 6e 73 (common:get-ins
0ca0: 74 61 6c 6c 2d 61 72 65 61 29 20 22 2f 73 68 61 tall-area) "/sha
0cb0: 72 65 2f 6a 73 2f 6a 71 75 65 72 79 2d 33 2e 31 re/js/jquery-3.1
0cc0: 2e 30 2e 73 6c 69 6d 2e 6d 69 6e 2e 6a 73 22 29 .0.slim.min.js")
0cd0: 29 0a 20 20 29 0a 28 64 65 66 69 6e 65 20 28 74 ). ).(define (t
0ce0: 65 73 74 73 3a 73 75 6d 6d 61 72 69 7a 65 2d 69 ests:summarize-i
0cf0: 74 65 6d 73 20 72 75 6e 2d 69 64 20 74 65 73 74 tems run-id test
0d00: 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 66 6f -id test-name fo
0d10: 72 63 65 29 0a 20 20 3b 3b 20 69 66 20 6e 6f 74 rce). ;; if not
0d20: 20 66 6f 72 63 65 20 74 68 65 6e 20 6f 6e 6c 79 force then only
0d30: 20 75 70 64 61 74 65 20 74 68 65 20 72 65 63 6f update the reco
0d40: 72 64 20 69 66 20 6f 6e 65 20 6f 66 20 74 68 65 rd if one of the
0d50: 73 65 20 69 73 20 74 72 75 65 3a 0a 20 20 3b 3b se is true:. ;;
0d60: 20 20 20 31 2e 20 6c 6f 67 66 20 69 73 20 22 6c 1. logf is "l
0d70: 6f 67 2f 66 69 6e 61 6c 2e 6c 6f 67 0a 20 20 3b og/final.log. ;
0d80: 3b 20 20 20 32 2e 20 6c 6f 67 66 20 69 73 20 73 ; 2. logf is s
0d90: 61 6d 65 20 61 73 20 6f 75 74 70 75 74 66 69 6c ame as outputfil
0da0: 65 6e 61 6d 65 0a 20 20 28 6c 65 74 2a 20 28 28 ename. (let* ((
0db0: 6f 75 74 70 75 74 66 69 6c 65 6e 61 6d 65 20 28 outputfilename (
0dc0: 63 6f 6e 63 20 22 6d 65 67 61 74 65 73 74 2d 72 conc "megatest-r
0dd0: 6f 6c 6c 75 70 2d 22 20 74 65 73 74 2d 6e 61 6d ollup-" test-nam
0de0: 65 20 22 2e 68 74 6d 6c 22 29 29 0a 09 20 28 6f e ".html")).. (o
0df0: 72 69 67 2d 64 69 72 20 20 20 20 20 20 20 28 63 rig-dir (c
0e00: 75 72 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 urrent-directory
0e10: 29 29 0a 09 20 28 6c 6f 67 66 2d 69 6e 66 6f 20 )).. (logf-info
0e20: 20 20 20 20 20 28 72 6d 74 3a 74 65 73 74 2d 67 (rmt:test-g
0e30: 65 74 2d 6c 6f 67 66 69 6c 65 2d 69 6e 66 6f 20 et-logfile-info
0e40: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
0e50: 29 29 0a 09 20 28 6c 6f 67 66 20 20 20 20 20 20 )).. (logf
0e60: 20 20 20 20 20 28 69 66 20 6c 6f 67 66 2d 69 6e (if logf-in
0e70: 66 6f 20 28 63 61 64 72 20 6c 6f 67 66 2d 69 6e fo (cadr logf-in
0e80: 66 6f 29 20 23 66 29 29 0a 09 20 28 70 61 74 68 fo) #f)).. (path
0e90: 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 6c (if l
0ea0: 6f 67 66 2d 69 6e 66 6f 20 28 63 61 72 20 20 6c ogf-info (car l
0eb0: 6f 67 66 2d 69 6e 66 6f 29 20 23 66 29 29 29 0a ogf-info) #f))).
0ec0: 20 20 20 20 3b 3b 20 54 68 69 73 20 71 75 65 72 ;; This quer
0ed0: 79 20 66 69 6e 64 73 20 74 68 65 20 70 61 74 68 y finds the path
0ee0: 20 61 6e 64 20 63 68 61 6e 67 65 73 20 74 68 65 and changes the
0ef0: 20 64 69 72 65 63 74 6f 72 79 20 74 6f 20 69 74 directory to it
0f00: 20 66 6f 72 20 74 68 65 20 74 65 73 74 0a 20 20 for the test.
0f10: 20 20 28 69 66 20 28 61 6e 64 20 28 73 74 72 69 (if (and (stri
0f20: 6e 67 3f 20 70 61 74 68 29 0a 09 20 20 20 20 20 ng? path)..
0f30: 28 64 69 72 65 63 74 6f 72 79 3f 20 70 61 74 68 (directory? path
0f40: 29 29 20 3b 3b 20 63 61 6e 20 67 65 74 20 23 66 )) ;; can get #f
0f50: 20 68 65 72 65 20 75 6e 64 65 72 20 73 6f 6d 65 here under some
0f60: 20 77 69 65 72 64 20 63 6f 6e 64 69 74 69 6f 6e wierd condition
0f70: 73 2e 20 77 68 79 2c 20 75 6e 6b 6e 6f 77 6e 20 s. why, unknown
0f80: 2e 2e 2e 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 .....(begin.. (
0f90: 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 2a 64 debug:print 4 *d
0fa0: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
0fb0: 20 22 46 6f 75 6e 64 20 70 61 74 68 3a 20 22 20 "Found path: "
0fc0: 70 61 74 68 29 0a 09 20 20 28 63 68 61 6e 67 65 path).. (change
0fd0: 2d 64 69 72 65 63 74 6f 72 79 20 70 61 74 68 29 -directory path)
0fe0: 29 0a 09 3b 3b 20 28 73 65 74 21 20 6f 75 74 70 )..;; (set! outp
0ff0: 75 74 66 69 6c 65 6e 61 6d 65 20 28 63 6f 6e 63 utfilename (conc
1000: 20 70 61 74 68 20 22 2f 22 20 6f 75 74 70 75 74 path "/" output
1010: 66 69 6c 65 6e 61 6d 65 29 29 29 0a 09 28 64 65 filename)))..(de
1020: 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 bug:print-error
1030: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
1040: 6f 72 74 2a 20 22 73 75 6d 6d 61 72 69 7a 65 2d ort* "summarize-
1050: 69 74 65 6d 73 20 66 6f 72 20 72 75 6e 2d 69 64 items for run-id
1060: 3d 22 20 72 75 6e 2d 69 64 20 22 2c 20 74 65 73 =" run-id ", tes
1070: 74 2d 6e 61 6d 65 3d 22 20 74 65 73 74 2d 6e 61 t-name=" test-na
1080: 6d 65 20 22 2c 20 6e 6f 20 73 75 63 68 20 70 61 me ", no such pa
1090: 74 68 3a 20 22 20 70 61 74 68 29 29 0a 20 20 20 th: " path)).
10a0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 (debug:print 4
10b0: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
10c0: 74 2a 20 22 73 75 6d 6d 61 72 69 7a 65 2d 69 74 t* "summarize-it
10d0: 65 6d 73 20 77 69 74 68 20 6c 6f 67 66 20 22 20 ems with logf "
10e0: 6c 6f 67 66 20 22 2c 20 6f 75 74 70 75 74 66 69 logf ", outputfi
10f0: 6c 65 6e 61 6d 65 20 22 20 6f 75 74 70 75 74 66 lename " outputf
1100: 69 6c 65 6e 61 6d 65 20 22 20 61 6e 64 20 66 6f ilename " and fo
1110: 72 63 65 20 22 20 66 6f 72 63 65 29 0a 20 20 20 rce " force).
1120: 20 28 69 66 20 28 6f 72 20 28 65 71 75 61 6c 3f (if (or (equal?
1130: 20 6c 6f 67 66 20 22 6c 6f 67 73 2f 66 69 6e 61 logf "logs/fina
1140: 6c 2e 6c 6f 67 22 29 0a 09 20 20 20 20 28 65 71 l.log").. (eq
1150: 75 61 6c 3f 20 6c 6f 67 66 20 6f 75 74 70 75 74 ual? logf output
1160: 66 69 6c 65 6e 61 6d 65 29 0a 09 20 20 20 20 66 filename).. f
1170: 6f 72 63 65 29 0a 09 28 6c 65 74 20 28 28 6d 79 orce)..(let ((my
1180: 2d 73 74 61 72 74 2d 74 69 6d 65 20 28 63 75 72 -start-time (cur
1190: 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 0a 09 rent-seconds))..
11a0: 20 20 20 20 20 20 28 6c 6f 63 6b 66 20 20 20 20 (lockf
11b0: 20 20 20 20 20 28 63 6f 6e 63 20 6f 75 74 70 75 (conc outpu
11c0: 74 66 69 6c 65 6e 61 6d 65 20 22 2e 6c 6f 63 6b tfilename ".lock
11d0: 22 29 29 29 0a 09 20 20 28 6c 65 74 20 6c 6f 6f "))).. (let loo
11e0: 70 20 28 28 68 61 76 65 2d 6c 6f 63 6b 20 20 28 p ((have-lock (
11f0: 63 6f 6d 6d 6f 6e 3a 73 69 6d 70 6c 65 2d 66 69 common:simple-fi
1200: 6c 65 2d 6c 6f 63 6b 20 6c 6f 63 6b 66 29 29 29 le-lock lockf)))
1210: 0a 09 20 20 20 20 28 69 66 20 68 61 76 65 2d 6c .. (if have-l
1220: 6f 63 6b 0a 09 09 28 6c 65 74 20 28 28 73 63 72 ock...(let ((scr
1230: 69 70 74 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f ipt (configf:loo
1240: 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 kup *configdat*
1250: 22 74 65 73 74 72 6f 6c 6c 75 70 22 20 74 65 73 "testrollup" tes
1260: 74 2d 6e 61 6d 65 29 29 29 0a 09 09 20 20 28 64 t-name)))... (d
1270: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 ebug:print 0 *de
1280: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
1290: 22 4f 62 74 61 69 6e 65 64 20 6c 6f 63 6b 20 66 "Obtained lock f
12a0: 6f 72 20 22 20 6f 75 74 70 75 74 66 69 6c 65 6e or " outputfilen
12b0: 61 6d 65 29 0a 09 09 20 20 28 72 6d 74 3a 73 65 ame)... (rmt:se
12c0: 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d 61 t-state-status-a
12d0: 6e 64 2d 72 6f 6c 6c 2d 75 70 2d 69 74 65 6d 73 nd-roll-up-items
12e0: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
12f0: 65 20 22 22 20 23 66 20 23 66 20 23 66 29 0a 09 e "" #f #f #f)..
1300: 09 20 20 28 69 66 20 73 63 72 69 70 74 0a 09 09 . (if script...
1310: 20 20 20 20 20 20 28 73 79 73 74 65 6d 20 28 63 (system (c
1320: 6f 6e 63 20 73 63 72 69 70 74 20 22 20 3e 20 22 onc script " > "
1330: 20 6f 75 74 70 75 74 66 69 6c 65 6e 61 6d 65 20 outputfilename
1340: 22 20 26 20 22 29 29 0a 09 09 20 20 20 20 20 20 " & "))...
1350: 28 74 65 73 74 73 3a 67 65 6e 65 72 61 74 65 2d (tests:generate-
1360: 68 74 6d 6c 2d 73 75 6d 6d 61 72 79 2d 66 6f 72 html-summary-for
1370: 2d 69 74 65 72 61 74 65 64 2d 74 65 73 74 20 72 -iterated-test r
1380: 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 74 65 un-id test-id te
1390: 73 74 2d 6e 61 6d 65 20 6f 75 74 70 75 74 66 69 st-name outputfi
13a0: 6c 65 6e 61 6d 65 29 29 0a 09 09 20 20 28 63 6f lename))... (co
13b0: 6d 6d 6f 6e 3a 73 69 6d 70 6c 65 2d 66 69 6c 65 mmon:simple-file
13c0: 2d 72 65 6c 65 61 73 65 2d 6c 6f 63 6b 20 6c 6f -release-lock lo
13d0: 63 6b 66 29 0a 09 09 20 20 28 63 68 61 6e 67 65 ckf)... (change
13e0: 2d 64 69 72 65 63 74 6f 72 79 20 6f 72 69 67 2d -directory orig-
13f0: 64 69 72 29 0a 09 09 20 20 3b 3b 20 4e 42 2f 2f dir)... ;; NB//
1400: 20 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d tests:test-set-
1410: 74 6f 70 6c 6f 67 21 20 69 73 20 72 65 6d 6f 74 toplog! is remot
1420: 65 20 69 6e 74 65 72 6e 61 6c 2e 2e 2e 0a 09 09 e internal......
1430: 20 20 28 74 65 73 74 73 3a 74 65 73 74 2d 73 65 (tests:test-se
1440: 74 2d 74 6f 70 6c 6f 67 21 20 72 75 6e 2d 69 64 t-toplog! run-id
1450: 20 74 65 73 74 2d 6e 61 6d 65 20 6f 75 74 70 75 test-name outpu
1460: 74 66 69 6c 65 6e 61 6d 65 29 29 0a 09 09 3b 3b tfilename))...;;
1470: 20 64 69 64 6e 27 74 20 67 65 74 20 74 68 65 20 didn't get the
1480: 6c 6f 63 6b 2c 20 63 68 65 63 6b 20 74 6f 20 73 lock, check to s
1490: 65 65 20 69 66 20 63 75 72 72 65 6e 74 20 75 70 ee if current up
14a0: 64 61 74 65 20 73 74 61 72 74 65 64 20 6c 61 74 date started lat
14b0: 65 72 20 74 68 61 6e 20 74 68 69 73 20 0a 09 09 er than this ...
14c0: 3b 3b 20 75 70 64 61 74 65 2c 20 69 66 20 73 6f ;; update, if so
14d0: 20 77 65 20 63 61 6e 20 65 78 69 74 20 77 69 74 we can exit wit
14e0: 68 6f 75 74 20 64 6f 69 6e 67 20 61 6e 79 20 77 hout doing any w
14f0: 6f 72 6b 0a 09 09 28 69 66 20 28 3e 20 6d 79 2d ork...(if (> my-
1500: 73 74 61 72 74 2d 74 69 6d 65 20 28 68 61 6e 64 start-time (hand
1510: 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 09 le-exceptions...
1520: 09 09 09 20 65 78 6e 0a 09 09 09 09 20 20 20 20 ... exn.....
1530: 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 09 20 (begin......
1540: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a (debug:print 0 *
1550: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
1560: 2a 20 22 66 61 69 6c 65 64 20 74 6f 20 67 65 74 * "failed to get
1570: 20 6d 6f 64 20 74 69 6d 65 20 6f 6e 20 22 20 6c mod time on " l
1580: 6f 63 6b 66 20 22 2c 20 65 78 6e 3d 22 20 65 78 ockf ", exn=" ex
1590: 6e 29 0a 09 09 09 09 09 20 30 29 0a 09 09 09 09 n)...... 0).....
15a0: 20 20 20 20 20 20 20 28 66 69 6c 65 2d 6d 6f 64 (file-mod
15b0: 69 66 69 63 61 74 69 6f 6e 2d 74 69 6d 65 20 6c ification-time l
15c0: 6f 63 6b 66 29 29 29 0a 09 09 20 20 20 20 3b 3b ockf)))... ;;
15d0: 20 77 65 20 73 74 61 72 74 65 64 20 73 69 6e 63 we started sinc
15e0: 65 20 63 75 72 72 65 6e 74 20 72 65 2d 67 65 6e e current re-gen
15f0: 20 69 6e 20 66 6c 69 67 68 74 2c 20 64 65 6c 61 in flight, dela
1600: 79 20 61 20 6c 69 74 74 6c 65 20 61 6e 64 20 74 y a little and t
1610: 72 79 20 61 67 61 69 6e 0a 09 09 20 20 20 20 28 ry again... (
1620: 62 65 67 69 6e 0a 09 09 20 20 20 20 20 20 28 64 begin... (d
1630: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
1640: 31 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 1 *default-log-p
1650: 6f 72 74 2a 20 22 57 61 69 74 69 6e 67 20 74 6f ort* "Waiting to
1660: 20 75 70 64 61 74 65 20 22 20 6f 75 74 70 75 74 update " output
1670: 66 69 6c 65 6e 61 6d 65 20 22 2c 20 61 6e 6f 74 filename ", anot
1680: 68 65 72 20 74 65 73 74 20 63 75 72 72 65 6e 74 her test current
1690: 6c 79 20 75 70 64 61 74 69 6e 67 20 69 74 22 29 ly updating it")
16a0: 0a 09 09 20 20 20 20 20 20 28 74 68 72 65 61 64 ... (thread
16b0: 2d 73 6c 65 65 70 21 20 28 2b 20 35 20 28 72 61 -sleep! (+ 5 (ra
16c0: 6e 64 6f 6d 20 35 29 29 29 20 3b 3b 20 64 65 6c ndom 5))) ;; del
16d0: 61 79 20 62 65 74 77 65 65 6e 20 35 20 61 6e 64 ay between 5 and
16e0: 20 31 30 20 73 65 63 6f 6e 64 73 0a 09 09 20 20 10 seconds...
16f0: 20 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6d 6d 6f (loop (commo
1700: 6e 3a 73 69 6d 70 6c 65 2d 66 69 6c 65 2d 6c 6f n:simple-file-lo
1710: 63 6b 20 6c 6f 63 6b 66 29 29 29 29 29 29 29 29 ck lockf))))))))
1720: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 65 73 ))..(define (tes
1730: 74 73 3a 67 65 6e 65 72 61 74 65 2d 68 74 6d 6c ts:generate-html
1740: 2d 73 75 6d 6d 61 72 79 2d 66 6f 72 2d 69 74 65 -summary-for-ite
1750: 72 61 74 65 64 2d 74 65 73 74 20 72 75 6e 2d 69 rated-test run-i
1760: 64 20 74 65 73 74 2d 69 64 20 74 65 73 74 2d 6e d test-id test-n
1770: 61 6d 65 20 6f 75 74 70 75 74 66 69 6c 65 6e 61 ame outputfilena
1780: 6d 65 29 0a 20 20 28 6c 65 74 20 28 28 63 6f 75 me). (let ((cou
1790: 6e 74 73 20 20 20 20 20 20 20 20 20 20 20 20 20 nts
17a0: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
17b0: 65 29 29 0a 09 28 73 74 61 74 65 63 6f 75 6e 74 e))..(statecount
17c0: 73 20 20 20 20 20 20 20 20 20 28 6d 61 6b 65 2d s (make-
17d0: 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 09 28 6f hash-table))..(o
17e0: 75 74 74 78 74 20 20 20 20 20 20 20 20 20 20 20 uttxt
17f0: 20 20 20 22 22 29 0a 09 28 74 6f 74 20 20 20 20 "")..(tot
1800: 20 20 20 20 20 20 20 20 20 20 20 20 20 30 29 0a 0).
1810: 09 28 74 65 73 74 64 61 74 20 20 20 20 20 20 20 .(testdat
1820: 20 20 20 20 20 20 28 72 6d 74 3a 74 65 73 74 2d (rmt:test-
1830: 67 65 74 2d 72 65 63 6f 72 64 73 2d 66 6f 72 2d get-records-for-
1840: 69 6e 64 65 78 2d 66 69 6c 65 20 72 75 6e 2d 69 index-file run-i
1850: 64 20 74 65 73 74 2d 6e 61 6d 65 29 29 29 0a 20 d test-name))).
1860: 20 20 20 28 77 69 74 68 2d 6f 75 74 70 75 74 2d (with-output-
1870: 74 6f 2d 66 69 6c 65 20 6f 75 74 70 75 74 66 69 to-file outputfi
1880: 6c 65 6e 61 6d 65 0a 20 20 20 20 20 20 28 6c 61 lename. (la
1890: 6d 62 64 61 20 28 29 0a 09 28 73 65 74 21 20 6f mbda ()..(set! o
18a0: 75 74 74 78 74 20 28 63 6f 6e 63 20 6f 75 74 74 uttxt (conc outt
18b0: 78 74 20 22 3c 68 74 6d 6c 3e 3c 74 69 74 6c 65 xt "<html><title
18c0: 3e 53 75 6d 6d 61 72 79 3a 20 22 20 74 65 73 74 >Summary: " test
18d0: 2d 6e 61 6d 65 20 0a 09 09 09 20 20 20 22 3c 2f -name .... "</
18e0: 74 69 74 6c 65 3e 3c 62 6f 64 79 3e 3c 68 32 3e title><body><h2>
18f0: 53 75 6d 6d 61 72 79 20 66 6f 72 20 22 20 74 65 Summary for " te
1900: 73 74 2d 6e 61 6d 65 20 22 3c 2f 68 32 3e 22 29 st-name "</h2>")
1910: 29 0a 09 28 66 6f 72 2d 65 61 63 68 0a 09 20 28 )..(for-each.. (
1920: 6c 61 6d 62 64 61 20 28 74 65 73 74 72 65 63 6f lambda (testreco
1930: 72 64 29 0a 09 20 20 20 28 6c 65 74 20 28 28 69 rd).. (let ((i
1940: 64 20 20 20 20 20 20 20 20 20 20 20 20 20 28 76 d (v
1950: 65 63 74 6f 72 2d 72 65 66 20 74 65 73 74 72 65 ector-ref testre
1960: 63 6f 72 64 20 30 29 29 0a 09 09 20 28 69 74 65 cord 0))... (ite
1970: 6d 70 61 74 68 20 20 20 20 20 20 20 28 76 65 63 mpath (vec
1980: 74 6f 72 2d 72 65 66 20 74 65 73 74 72 65 63 6f tor-ref testreco
1990: 72 64 20 31 29 29 0a 09 09 20 28 73 74 61 74 65 rd 1))... (state
19a0: 20 20 20 20 20 20 20 20 20 20 28 76 65 63 74 6f (vecto
19b0: 72 2d 72 65 66 20 74 65 73 74 72 65 63 6f 72 64 r-ref testrecord
19c0: 20 32 29 29 0a 09 09 20 28 73 74 61 74 75 73 20 2))... (status
19d0: 20 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d (vector-
19e0: 72 65 66 20 74 65 73 74 72 65 63 6f 72 64 20 33 ref testrecord 3
19f0: 29 29 0a 09 09 20 28 72 75 6e 5f 64 75 72 61 74 ))... (run_durat
1a00: 69 6f 6e 20 20 20 28 76 65 63 74 6f 72 2d 72 65 ion (vector-re
1a10: 66 20 74 65 73 74 72 65 63 6f 72 64 20 34 29 29 f testrecord 4))
1a20: 0a 09 09 20 28 6c 6f 67 66 20 20 20 20 20 20 20 ... (logf
1a30: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (vector-ref
1a40: 74 65 73 74 72 65 63 6f 72 64 20 35 29 29 0a 09 testrecord 5))..
1a50: 09 20 28 63 6f 6d 6d 65 6e 74 20 20 20 20 20 20 . (comment
1a60: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 74 65 (vector-ref te
1a70: 73 74 72 65 63 6f 72 64 20 36 29 29 29 0a 09 20 strecord 6)))..
1a80: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table-
1a90: 73 65 74 21 20 63 6f 75 6e 74 73 20 73 74 61 74 set! counts stat
1aa0: 75 73 20 28 2b 20 31 20 28 68 61 73 68 2d 74 61 us (+ 1 (hash-ta
1ab0: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
1ac0: 63 6f 75 6e 74 73 20 73 74 61 74 75 73 20 30 29 counts status 0)
1ad0: 29 29 0a 09 20 20 20 20 20 28 68 61 73 68 2d 74 )).. (hash-t
1ae0: 61 62 6c 65 2d 73 65 74 21 20 73 74 61 74 65 63 able-set! statec
1af0: 6f 75 6e 74 73 20 73 74 61 74 65 20 28 2b 20 31 ounts state (+ 1
1b00: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
1b10: 2f 64 65 66 61 75 6c 74 20 73 74 61 74 65 63 6f /default stateco
1b20: 75 6e 74 73 20 73 74 61 74 65 20 30 29 29 29 0a unts state 0))).
1b30: 09 20 20 20 20 20 28 73 65 74 21 20 6f 75 74 74 . (set! outt
1b40: 78 74 20 28 63 6f 6e 63 20 6f 75 74 74 78 74 20 xt (conc outtxt
1b50: 22 3c 74 72 3e 22 0a 09 09 09 09 3b 3b 20 22 3c "<tr>".....;; "<
1b60: 74 64 3e 3c 61 20 68 72 65 66 3d 5c 22 22 20 69 td><a href=\"" i
1b70: 74 65 6d 70 61 74 68 20 22 2f 22 20 6c 6f 67 66 tempath "/" logf
1b80: 20 22 5c 22 3e 20 22 20 69 74 65 6d 70 61 74 68 "\"> " itempath
1b90: 20 22 3c 2f 61 3e 3c 2f 74 64 3e 22 20 0a 09 09 "</a></td>" ...
1ba0: 09 09 22 3c 74 64 3e 3c 61 20 68 72 65 66 3d 5c .."<td><a href=\
1bb0: 22 22 20 69 74 65 6d 70 61 74 68 20 22 2f 74 65 "" itempath "/te
1bc0: 73 74 2d 73 75 6d 6d 61 72 79 2e 68 74 6d 6c 5c st-summary.html\
1bd0: 22 3e 20 22 20 69 74 65 6d 70 61 74 68 20 22 3c "> " itempath "<
1be0: 2f 61 3e 3c 2f 74 64 3e 22 20 0a 09 09 09 09 22 /a></td>" ....."
1bf0: 3c 74 64 3e 22 20 73 74 61 74 65 20 20 20 20 22 <td>" state "
1c00: 3c 2f 74 64 3e 22 20 0a 09 09 09 09 22 3c 74 64 </td>" ....."<td
1c10: 3e 3c 66 6f 6e 74 20 63 6f 6c 6f 72 3d 22 20 28 ><font color=" (
1c20: 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 63 6f 6c 6f 72 common:get-color
1c30: 2d 66 72 6f 6d 2d 73 74 61 74 75 73 20 73 74 61 -from-status sta
1c40: 74 75 73 29 0a 09 09 09 09 22 3e 22 20 20 20 73 tus).....">" s
1c50: 74 61 74 75 73 20 20 20 22 3c 2f 66 6f 6e 74 3e tatus "</font>
1c60: 3c 2f 74 64 3e 22 0a 09 09 09 09 22 3c 74 64 3e </td>"....."<td>
1c70: 22 20 28 69 66 20 28 65 71 75 61 6c 3f 20 63 6f " (if (equal? co
1c80: 6d 6d 65 6e 74 20 22 22 29 0a 09 09 09 09 09 20 mment "")......
1c90: 20 20 22 26 6e 62 73 70 3b 22 0a 09 09 09 09 09 " "......
1ca0: 20 20 20 63 6f 6d 6d 65 6e 74 29 20 22 3c 2f 74 comment) "</t
1cb0: 64 3e 22 0a 09 09 09 09 09 20 20 20 22 3c 2f 74 d>"...... "</t
1cc0: 72 3e 22 29 29 29 29 0a 09 20 28 69 66 20 28 6c r>")))).. (if (l
1cd0: 69 73 74 3f 20 74 65 73 74 64 61 74 29 0a 09 20 ist? testdat)..
1ce0: 20 20 20 20 74 65 73 74 64 61 74 0a 09 20 20 20 testdat..
1cf0: 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 20 (begin..
1d00: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
1d10: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
1d20: 74 2a 20 22 45 52 52 4f 52 3a 20 66 61 69 6c 65 t* "ERROR: faile
1d30: 64 20 74 6f 20 67 65 74 20 72 65 63 6f 72 64 73 d to get records
1d40: 20 77 69 74 68 20 72 6d 74 3a 74 65 73 74 2d 67 with rmt:test-g
1d50: 65 74 2d 72 65 63 6f 72 64 73 2d 66 6f 72 2d 69 et-records-for-i
1d60: 6e 64 65 78 2d 66 69 6c 65 20 72 75 6e 2d 69 64 ndex-file run-id
1d70: 3d 22 20 72 75 6e 2d 69 64 20 22 74 65 73 74 2d =" run-id "test-
1d80: 6e 61 6d 65 3d 22 20 74 65 73 74 2d 6e 61 6d 65 name=" test-name
1d90: 29 0a 09 20 20 20 20 20 20 20 27 28 29 29 29 29 ).. '())))
1da0: 0a 09 0a 09 28 70 72 69 6e 74 20 22 3c 74 61 62 ....(print "<tab
1db0: 6c 65 3e 3c 74 72 3e 3c 74 64 20 76 61 6c 69 67 le><tr><td valig
1dc0: 6e 3d 5c 22 74 6f 70 5c 22 3e 22 29 0a 09 3b 3b n=\"top\">")..;;
1dd0: 20 50 72 69 6e 74 20 6f 75 74 20 73 74 61 74 73 Print out stats
1de0: 20 66 6f 72 20 73 74 61 74 75 73 0a 09 28 73 65 for status..(se
1df0: 74 21 20 74 6f 74 20 30 29 0a 09 28 70 72 69 6e t! tot 0)..(prin
1e00: 74 20 22 3c 74 61 62 6c 65 20 63 65 6c 6c 73 70 t "<table cellsp
1e10: 61 63 69 6e 67 3d 5c 22 30 5c 22 20 62 6f 72 64 acing=\"0\" bord
1e20: 65 72 3d 5c 22 31 5c 22 3e 3c 74 72 3e 3c 74 64 er=\"1\"><tr><td
1e30: 20 63 6f 6c 73 70 61 6e 3d 5c 22 32 5c 22 3e 3c colspan=\"2\"><
1e40: 68 32 3e 53 74 61 74 65 20 73 74 61 74 73 3c 2f h2>State stats</
1e50: 68 32 3e 3c 2f 74 64 3e 3c 2f 74 72 3e 22 29 0a h2></td></tr>").
1e60: 09 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 .(for-each (lamb
1e70: 64 61 20 28 73 74 61 74 65 29 0a 09 09 20 20 20 da (state)...
1e80: 20 28 73 65 74 21 20 74 6f 74 20 28 2b 20 74 6f (set! tot (+ to
1e90: 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 t (hash-table-re
1ea0: 66 20 73 74 61 74 65 63 6f 75 6e 74 73 20 73 74 f statecounts st
1eb0: 61 74 65 29 29 29 0a 09 09 20 20 20 20 28 70 72 ate)))... (pr
1ec0: 69 6e 74 20 22 3c 74 72 3e 3c 74 64 3e 22 20 73 int "<tr><td>" s
1ed0: 74 61 74 65 20 22 3c 2f 74 64 3e 3c 74 64 3e 22 tate "</td><td>"
1ee0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
1ef0: 20 73 74 61 74 65 63 6f 75 6e 74 73 20 73 74 61 statecounts sta
1f00: 74 65 29 20 22 3c 2f 74 64 3e 3c 2f 74 72 3e 22 te) "</td></tr>"
1f10: 29 29 0a 09 09 20 20 28 68 61 73 68 2d 74 61 62 ))... (hash-tab
1f20: 6c 65 2d 6b 65 79 73 20 73 74 61 74 65 63 6f 75 le-keys statecou
1f30: 6e 74 73 29 29 0a 09 28 70 72 69 6e 74 20 22 3c nts))..(print "<
1f40: 74 72 3e 3c 74 64 3e 54 6f 74 61 6c 3c 2f 74 64 tr><td>Total</td
1f50: 3e 3c 74 64 3e 22 20 74 6f 74 20 22 3c 2f 74 64 ><td>" tot "</td
1f60: 3e 3c 2f 74 72 3e 3c 2f 74 61 62 6c 65 3e 22 29 ></tr></table>")
1f70: 0a 09 28 70 72 69 6e 74 20 22 3c 2f 74 64 3e 3c ..(print "</td><
1f80: 74 64 20 76 61 6c 69 67 6e 3d 5c 22 74 6f 70 5c td valign=\"top\
1f90: 22 3e 22 29 0a 09 3b 3b 20 50 72 69 6e 74 20 6f ">")..;; Print o
1fa0: 75 74 20 73 74 61 74 73 20 66 6f 72 20 73 74 61 ut stats for sta
1fb0: 74 65 0a 09 28 73 65 74 21 20 74 6f 74 20 30 29 te..(set! tot 0)
1fc0: 0a 09 28 70 72 69 6e 74 20 22 3c 74 61 62 6c 65 ..(print "<table
1fd0: 20 63 65 6c 6c 73 70 61 63 69 6e 67 3d 5c 22 30 cellspacing=\"0
1fe0: 5c 22 20 62 6f 72 64 65 72 3d 5c 22 31 5c 22 3e \" border=\"1\">
1ff0: 3c 74 72 3e 3c 74 64 20 63 6f 6c 73 70 61 6e 3d <tr><td colspan=
2000: 5c 22 32 5c 22 3e 3c 68 32 3e 53 74 61 74 75 73 \"2\"><h2>Status
2010: 20 73 74 61 74 73 3c 2f 68 32 3e 3c 2f 74 64 3e stats</h2></td>
2020: 3c 2f 74 72 3e 22 29 0a 09 28 66 6f 72 2d 65 61 </tr>")..(for-ea
2030: 63 68 20 28 6c 61 6d 62 64 61 20 28 73 74 61 74 ch (lambda (stat
2040: 75 73 29 0a 09 09 20 20 20 20 28 73 65 74 21 20 us)... (set!
2050: 74 6f 74 20 28 2b 20 74 6f 74 20 28 68 61 73 68 tot (+ tot (hash
2060: 2d 74 61 62 6c 65 2d 72 65 66 20 63 6f 75 6e 74 -table-ref count
2070: 73 20 73 74 61 74 75 73 29 29 29 0a 09 09 20 20 s status)))...
2080: 20 20 28 70 72 69 6e 74 20 22 3c 74 72 3e 3c 74 (print "<tr><t
2090: 64 3e 3c 66 6f 6e 74 20 63 6f 6c 6f 72 3d 5c 22 d><font color=\"
20a0: 22 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 63 6f " (common:get-co
20b0: 6c 6f 72 2d 66 72 6f 6d 2d 73 74 61 74 75 73 20 lor-from-status
20c0: 73 74 61 74 75 73 29 20 22 5c 22 3e 22 20 73 74 status) "\">" st
20d0: 61 74 75 73 0a 09 09 09 20 20 20 22 3c 2f 66 6f atus.... "</fo
20e0: 6e 74 3e 3c 2f 74 64 3e 3c 74 64 3e 22 20 28 68 nt></td><td>" (h
20f0: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 63 6f ash-table-ref co
2100: 75 6e 74 73 20 73 74 61 74 75 73 29 20 22 3c 2f unts status) "</
2110: 74 64 3e 3c 2f 74 72 3e 22 29 29 0a 09 09 20 20 td></tr>"))...
2120: 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 (hash-table-keys
2130: 20 63 6f 75 6e 74 73 29 29 0a 09 28 70 72 69 6e counts))..(prin
2140: 74 20 22 3c 74 72 3e 3c 74 64 3e 54 6f 74 61 6c t "<tr><td>Total
2150: 3c 2f 74 64 3e 3c 74 64 3e 22 20 74 6f 74 20 22 </td><td>" tot "
2160: 3c 2f 74 64 3e 3c 2f 74 72 3e 3c 2f 74 61 62 6c </td></tr></tabl
2170: 65 3e 22 29 0a 09 28 70 72 69 6e 74 20 22 3c 2f e>")..(print "</
2180: 74 64 3e 3c 2f 74 64 3e 3c 2f 74 72 3e 3c 2f 74 td></td></tr></t
2190: 61 62 6c 65 3e 22 29 0a 09 0a 09 28 70 72 69 6e able>")....(prin
21a0: 74 20 22 3c 74 61 62 6c 65 20 63 65 6c 6c 73 70 t "<table cellsp
21b0: 61 63 69 6e 67 3d 5c 22 30 5c 22 20 62 6f 72 64 acing=\"0\" bord
21c0: 65 72 3d 5c 22 31 5c 22 3e 22 20 0a 09 20 20 20 er=\"1\">" ..
21d0: 20 20 20 20 22 3c 74 72 3e 3c 74 64 3e 49 74 65 "<tr><td>Ite
21e0: 6d 3c 2f 74 64 3e 3c 74 64 3e 53 74 61 74 65 3c m</td><td>State<
21f0: 2f 74 64 3e 3c 74 64 3e 53 74 61 74 75 73 3c 2f /td><td>Status</
2200: 74 64 3e 3c 74 64 3e 43 6f 6d 6d 65 6e 74 3c 2f td><td>Comment</
2210: 74 64 3e 22 0a 09 20 20 20 20 20 20 20 6f 75 74 td>".. out
2220: 74 78 74 20 22 3c 2f 74 61 62 6c 65 3e 3c 2f 62 txt "</table></b
2230: 6f 64 79 3e 3c 2f 68 74 6d 6c 3e 22 29 0a 09 3b ody></html>")..;
2240: 3b 20 28 72 65 6c 65 61 73 65 2d 64 6f 74 2d 6c ; (release-dot-l
2250: 6f 63 6b 20 6f 75 74 70 75 74 66 69 6c 65 6e 61 ock outputfilena
2260: 6d 65 29 0a 09 3b 3b 28 72 6d 74 3a 75 70 64 61 me)..;;(rmt:upda
2270: 74 65 2d 72 75 6e 2d 73 74 61 74 73 20 0a 09 3b te-run-stats ..;
2280: 3b 20 72 75 6e 2d 69 64 0a 09 3b 3b 20 28 68 61 ; run-id..;; (ha
2290: 73 68 2d 74 61 62 6c 65 2d 6d 61 70 0a 09 3b 3b sh-table-map..;;
22a0: 20 20 73 74 61 74 65 2d 73 74 61 74 75 73 2d 63 state-status-c
22b0: 6f 75 6e 74 73 0a 09 3b 3b 20 20 28 6c 61 6d 62 ounts..;; (lamb
22c0: 64 61 20 28 6b 65 79 20 76 61 6c 29 0a 09 3b 3b da (key val)..;;
22d0: 09 28 61 70 70 65 6e 64 20 6b 65 79 20 28 6c 69 .(append key (li
22e0: 73 74 20 76 61 6c 29 29 29 29 29 0a 09 29 29 29 st val)))))..)))
22f0: 29 0a 0a 28 64 65 66 69 6e 65 20 74 65 73 74 73 )..(define tests
2300: 3a 63 73 73 2d 6a 73 63 72 69 70 74 2d 62 6c 6f :css-jscript-blo
2310: 63 6b 0a 23 3c 3c 45 4f 46 0a 3c 73 74 79 6c 65 ck.#<<EOF.<style
2320: 20 74 79 70 65 3d 22 74 65 78 74 2f 63 73 73 22 type="text/css"
2330: 3e 0a 75 6c 2e 4c 69 6e 6b 65 64 4c 69 73 74 20 >.ul.LinkedList
2340: 7b 20 64 69 73 70 6c 61 79 3a 20 62 6c 6f 63 6b { display: block
2350: 3b 20 7d 0a 2f 2a 20 75 6c 2e 4c 69 6e 6b 65 64 ; }./* ul.Linked
2360: 4c 69 73 74 20 75 6c 20 7b 20 64 69 73 70 6c 61 List ul { displa
2370: 79 3a 20 6e 6f 6e 65 3b 20 7d 20 2a 2f 0a 2e 48 y: none; } */..H
2380: 61 6e 64 43 75 72 73 6f 72 53 74 79 6c 65 20 7b andCursorStyle {
2390: 20 63 75 72 73 6f 72 3a 20 70 6f 69 6e 74 65 72 cursor: pointer
23a0: 3b 20 63 75 72 73 6f 72 3a 20 68 61 6e 64 3b 20 ; cursor: hand;
23b0: 7d 20 20 2f 2a 20 46 6f 72 20 49 45 20 2a 2f 0a } /* For IE */.
23c0: 74 68 20 7b 62 61 63 6b 67 72 6f 75 6e 64 2d 63 th {background-c
23d0: 6f 6c 6f 72 3a 20 23 38 63 38 63 38 63 3b 7d 0a olor: #8c8c8c;}.
23e0: 74 64 2e 74 65 73 74 20 7b 62 61 63 6b 67 72 6f td.test {backgro
23f0: 75 6e 64 2d 63 6f 6c 6f 72 3a 20 23 64 39 64 62 und-color: #d9db
2400: 64 64 3b 7d 0a 74 64 2e 50 41 53 53 20 7b 62 61 dd;}.td.PASS {ba
2410: 63 6b 67 72 6f 75 6e 64 2d 63 6f 6c 6f 72 3a 20 ckground-color:
2420: 23 33 34 37 35 33 33 3b 7d 0a 74 64 2e 46 41 49 #347533;}.td.FAI
2430: 4c 20 7b 62 61 63 6b 67 72 6f 75 6e 64 2d 63 6f L {background-co
2440: 6c 6f 72 3a 20 23 63 63 32 38 31 32 3b 7d 0a 74 lor: #cc2812;}.t
2450: 64 2e 53 4b 49 50 7b 62 61 63 6b 67 72 6f 75 6e d.SKIP{backgroun
2460: 64 2d 63 6f 6c 6f 72 3a 20 23 46 46 44 37 33 33 d-color: #FFD733
2470: 3b 7d 0a 74 64 2e 57 41 52 4e 20 7b 62 61 63 6b ;}.td.WARN {back
2480: 67 72 6f 75 6e 64 2d 63 6f 6c 6f 72 3a 20 23 45 ground-color: #E
2490: 41 38 37 32 34 3b 7d 0a 74 64 2e 57 41 49 56 45 A8724;}.td.WAIVE
24a0: 44 20 7b 62 61 63 6b 67 72 6f 75 6e 64 2d 63 6f D {background-co
24b0: 6c 6f 72 3a 20 23 38 33 38 41 31 32 3b 7d 0a 74 lor: #838A12;}.t
24c0: 64 2e 41 42 4f 52 54 7b 62 61 63 6b 67 72 6f 75 d.ABORT{backgrou
24d0: 6e 64 2d 63 6f 6c 6f 72 3a 20 23 45 41 32 34 42 nd-color: #EA24B
24e0: 37 3b 7d 0a 2e 50 41 53 53 20 2e 6c 69 6e 6b 2c 7;}..PASS .link,
24f0: 20 2e 53 4b 49 50 20 2e 6c 69 6e 6b 2c 20 2e 57 .SKIP .link, .W
2500: 41 52 4e 20 2e 6c 69 6e 6b 2c 2e 57 41 49 56 45 ARN .link,.WAIVE
2510: 44 20 2e 6c 69 6e 6b 2c 2e 41 42 4f 52 54 20 2e D .link,.ABORT .
2520: 6c 69 6e 6b 2c 20 2e 46 41 49 4c 20 2e 6c 69 6e link, .FAIL .lin
2530: 6b 7b 63 6f 6c 6f 72 3a 20 23 46 46 46 46 46 46 k{color: #FFFFFF
2540: 3b 7d 0a 0a 0a 3c 2f 73 74 79 6c 65 3e 0a 0a 0a ;}...</style>...
2550: 20 20 3c 73 63 72 69 70 74 20 74 79 70 65 3d 22 <script type="
2560: 74 65 78 74 2f 4a 61 76 61 53 63 72 69 70 74 22 text/JavaScript"
2570: 3e 0a 0a 20 20 20 20 66 75 6e 63 74 69 6f 6e 20 >.. function
2580: 66 69 6c 74 65 72 73 6f 6d 65 28 29 20 7b 0a 20 filtersome() {.
2590: 20 24 28 22 74 72 22 29 2e 73 68 6f 77 28 29 3b $("tr").show();
25a0: 0a 20 20 24 28 22 2e 74 65 73 74 22 29 2e 66 69 . $(".test").fi
25b0: 6c 74 65 72 28 0a 20 20 20 20 66 75 6e 63 74 69 lter(. functi
25c0: 6f 6e 28 29 20 7b 0a 20 20 20 20 20 20 76 61 72 on() {. var
25d0: 20 6e 61 6d 65 73 20 3d 20 24 28 27 23 74 65 73 names = $('#tes
25e0: 74 6e 61 6d 65 27 29 2e 76 61 6c 28 29 2e 73 70 tname').val().sp
25f0: 6c 69 74 28 27 2c 27 29 3b 0a 20 20 20 20 20 20 lit(',');.
2600: 76 61 72 20 67 6f 6f 64 3d 31 3b 0a 20 20 20 20 var good=1;.
2610: 20 20 66 6f 72 20 28 76 61 72 20 69 3d 30 2c 20 for (var i=0,
2620: 6c 65 6e 3d 6e 61 6d 65 73 2e 6c 65 6e 67 74 68 len=names.length
2630: 3b 20 69 3c 6c 65 6e 3b 20 69 2b 2b 29 20 7b 0a ; i<len; i++) {.
2640: 20 20 20 20 20 20 20 20 76 61 72 20 75 6e 61 6d var unam
2650: 65 3d 6e 61 6d 65 73 5b 69 5d 3b 0a 20 20 20 20 e=names[i];.
2660: 20 20 20 20 63 6f 6e 73 6f 6c 65 2e 6c 6f 67 28 console.log(
2670: 22 54 72 79 69 6e 67 20 74 6f 20 63 68 65 63 6b "Trying to check
2680: 20 66 6f 72 20 22 20 2b 20 75 6e 61 6d 65 29 3b for " + uname);
2690: 20 0a 20 20 20 20 20 20 20 20 69 66 28 24 28 74 . if($(t
26a0: 68 69 73 29 2e 74 65 78 74 28 29 2e 69 6e 64 65 his).text().inde
26b0: 78 4f 66 28 75 6e 61 6d 65 29 20 21 3d 20 2d 31 xOf(uname) != -1
26c0: 29 20 7b 0a 20 20 20 20 20 20 20 20 20 20 67 6f ) {. go
26d0: 6f 64 3d 20 30 3b 0a 20 20 20 20 20 20 20 20 20 od= 0;.
26e0: 20 63 6f 6e 73 6f 6c 65 2e 6c 6f 67 28 22 46 6f console.log("Fo
26f0: 75 6e 64 20 22 2b 75 6e 61 6d 65 29 3b 0a 20 20 und "+uname);.
2700: 20 20 20 20 20 20 7d 0a 20 20 20 20 20 20 7d 0a }. }.
2710: 20 20 20 20 20 20 72 65 74 75 72 6e 20 67 6f 6f return goo
2720: 64 3b 20 0a 20 20 20 20 7d 0a 20 20 29 2e 70 61 d; . }. ).pa
2730: 72 65 6e 74 28 29 2e 68 69 64 65 28 29 3b 0a 2f rent().hide();./
2740: 2f 20 20 24 28 22 2e 73 75 6d 22 29 2e 73 68 6f / $(".sum").sho
2750: 77 28 29 3b 0a 7d 0a 20 20 0a 20 20 20 20 2f 2f w();.}. . //
2760: 20 41 64 64 20 74 68 69 73 20 74 6f 20 74 68 65 Add this to the
2770: 20 6f 6e 6c 6f 61 64 20 65 76 65 6e 74 20 6f 66 onload event of
2780: 20 74 68 65 20 42 4f 44 59 20 65 6c 65 6d 65 6e the BODY elemen
2790: 74 0a 20 20 20 20 66 75 6e 63 74 69 6f 6e 20 61 t. function a
27a0: 64 64 45 76 65 6e 74 73 28 29 20 7b 0a 20 20 20 ddEvents() {.
27b0: 20 20 20 61 63 74 69 76 61 74 65 54 72 65 65 28 activateTree(
27c0: 64 6f 63 75 6d 65 6e 74 2e 67 65 74 45 6c 65 6d document.getElem
27d0: 65 6e 74 42 79 49 64 28 22 4c 69 6e 6b 65 64 4c entById("LinkedL
27e0: 69 73 74 31 22 29 29 3b 0a 20 20 20 20 7d 0a 0a ist1"));. }..
27f0: 20 20 20 20 2f 2f 20 54 68 69 73 20 66 75 6e 63 // This func
2800: 74 69 6f 6e 20 74 72 61 76 65 72 73 65 73 20 74 tion traverses t
2810: 68 65 20 6c 69 73 74 20 61 6e 64 20 61 64 64 20 he list and add
2820: 6c 69 6e 6b 73 20 0a 20 20 20 20 2f 2f 20 74 6f links . // to
2830: 20 6e 65 73 74 65 64 20 6c 69 73 74 20 69 74 65 nested list ite
2840: 6d 73 0a 20 20 20 20 66 75 6e 63 74 69 6f 6e 20 ms. function
2850: 61 63 74 69 76 61 74 65 54 72 65 65 28 6f 4c 69 activateTree(oLi
2860: 73 74 29 20 7b 0a 20 20 20 20 20 20 2f 2f 20 43 st) {. // C
2870: 6f 6c 6c 61 70 73 65 20 74 68 65 20 74 72 65 65 ollapse the tree
2880: 0a 20 20 20 20 20 20 66 6f 72 20 28 76 61 72 20 . for (var
2890: 69 3d 30 3b 20 69 20 3c 20 6f 4c 69 73 74 2e 67 i=0; i < oList.g
28a0: 65 74 45 6c 65 6d 65 6e 74 73 42 79 54 61 67 4e etElementsByTagN
28b0: 61 6d 65 28 22 75 6c 22 29 2e 6c 65 6e 67 74 68 ame("ul").length
28c0: 3b 20 69 2b 2b 29 20 7b 0a 20 20 20 20 20 20 20 ; i++) {.
28d0: 20 6f 4c 69 73 74 2e 67 65 74 45 6c 65 6d 65 6e oList.getElemen
28e0: 74 73 42 79 54 61 67 4e 61 6d 65 28 22 75 6c 22 tsByTagName("ul"
28f0: 29 5b 69 5d 2e 73 74 79 6c 65 2e 64 69 73 70 6c )[i].style.displ
2900: 61 79 3d 22 6e 6f 6e 65 22 3b 20 20 20 20 20 20 ay="none";
2910: 20 20 20 20 20 20 0a 20 20 20 20 20 20 7d 20 20 . }
2920: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2930: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2940: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2950: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2960: 0a 20 20 20 20 20 20 2f 2f 20 41 64 64 20 74 68 . // Add th
2970: 65 20 63 6c 69 63 6b 2d 65 76 65 6e 74 20 68 61 e click-event ha
2980: 6e 64 6c 65 72 20 74 6f 20 74 68 65 20 6c 69 73 ndler to the lis
2990: 74 20 69 74 65 6d 73 0a 20 20 20 20 20 20 69 66 t items. if
29a0: 20 28 6f 4c 69 73 74 2e 61 64 64 45 76 65 6e 74 (oList.addEvent
29b0: 4c 69 73 74 65 6e 65 72 29 20 7b 0a 20 20 20 20 Listener) {.
29c0: 20 20 20 20 6f 4c 69 73 74 2e 61 64 64 45 76 65 oList.addEve
29d0: 6e 74 4c 69 73 74 65 6e 65 72 28 22 63 6c 69 63 ntListener("clic
29e0: 6b 22 2c 20 74 6f 67 67 6c 65 42 72 61 6e 63 68 k", toggleBranch
29f0: 2c 20 66 61 6c 73 65 29 3b 0a 20 20 20 20 20 20 , false);.
2a00: 7d 20 65 6c 73 65 20 69 66 20 28 6f 4c 69 73 74 } else if (oList
2a10: 2e 61 74 74 61 63 68 45 76 65 6e 74 29 20 7b 20 .attachEvent) {
2a20: 2f 2f 20 46 6f 72 20 49 45 0a 20 20 20 20 20 20 // For IE.
2a30: 20 20 6f 4c 69 73 74 2e 61 74 74 61 63 68 45 76 oList.attachEv
2a40: 65 6e 74 28 22 6f 6e 63 6c 69 63 6b 22 2c 20 74 ent("onclick", t
2a50: 6f 67 67 6c 65 42 72 61 6e 63 68 29 3b 0a 20 20 oggleBranch);.
2a60: 20 20 20 20 7d 0a 20 20 20 20 20 20 2f 2f 20 4d }. // M
2a70: 61 6b 65 20 74 68 65 20 6e 65 73 74 65 64 20 69 ake the nested i
2a80: 74 65 6d 73 20 6c 6f 6f 6b 20 6c 69 6b 65 20 6c tems look like l
2a90: 69 6e 6b 73 0a 20 20 20 20 20 20 61 64 64 4c 69 inks. addLi
2aa0: 6e 6b 73 54 6f 42 72 61 6e 63 68 65 73 28 6f 4c nksToBranches(oL
2ab0: 69 73 74 29 3b 0a 20 20 20 20 7d 0a 0a 20 20 20 ist);. }..
2ac0: 20 2f 2f 20 54 68 69 73 20 69 73 20 74 68 65 20 // This is the
2ad0: 63 6c 69 63 6b 2d 65 76 65 6e 74 20 68 61 6e 64 click-event hand
2ae0: 6c 65 72 0a 20 20 20 20 66 75 6e 63 74 69 6f 6e ler. function
2af0: 20 74 6f 67 67 6c 65 42 72 61 6e 63 68 28 65 76 toggleBranch(ev
2b00: 65 6e 74 29 20 7b 0a 20 20 20 20 20 20 76 61 72 ent) {. var
2b10: 20 6f 42 72 61 6e 63 68 2c 20 63 53 75 62 42 72 oBranch, cSubBr
2b20: 61 6e 63 68 65 73 3b 0a 20 20 20 20 20 20 69 66 anches;. if
2b30: 20 28 65 76 65 6e 74 2e 74 61 72 67 65 74 29 20 (event.target)
2b40: 7b 0a 20 20 20 20 20 20 20 20 6f 42 72 61 6e 63 {. oBranc
2b50: 68 20 3d 20 65 76 65 6e 74 2e 74 61 72 67 65 74 h = event.target
2b60: 3b 0a 20 20 20 20 20 20 7d 20 65 6c 73 65 20 69 ;. } else i
2b70: 66 20 28 65 76 65 6e 74 2e 73 72 63 45 6c 65 6d f (event.srcElem
2b80: 65 6e 74 29 20 7b 20 2f 2f 20 46 6f 72 20 49 45 ent) { // For IE
2b90: 0a 20 20 20 20 20 20 20 20 6f 42 72 61 6e 63 68 . oBranch
2ba0: 20 3d 20 65 76 65 6e 74 2e 73 72 63 45 6c 65 6d = event.srcElem
2bb0: 65 6e 74 3b 0a 20 20 20 20 20 20 7d 0a 20 20 20 ent;. }.
2bc0: 20 20 20 63 53 75 62 42 72 61 6e 63 68 65 73 20 cSubBranches
2bd0: 3d 20 6f 42 72 61 6e 63 68 2e 67 65 74 45 6c 65 = oBranch.getEle
2be0: 6d 65 6e 74 73 42 79 54 61 67 4e 61 6d 65 28 22 mentsByTagName("
2bf0: 75 6c 22 29 3b 0a 20 20 20 20 20 20 69 66 20 28 ul");. if (
2c00: 63 53 75 62 42 72 61 6e 63 68 65 73 2e 6c 65 6e cSubBranches.len
2c10: 67 74 68 20 3e 20 30 29 20 7b 0a 20 20 20 20 20 gth > 0) {.
2c20: 20 20 20 69 66 20 28 63 53 75 62 42 72 61 6e 63 if (cSubBranc
2c30: 68 65 73 5b 30 5d 2e 73 74 79 6c 65 2e 64 69 73 hes[0].style.dis
2c40: 70 6c 61 79 20 3d 3d 20 22 62 6c 6f 63 6b 22 29 play == "block")
2c50: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 63 53 75 {. cSu
2c60: 62 42 72 61 6e 63 68 65 73 5b 30 5d 2e 73 74 79 bBranches[0].sty
2c70: 6c 65 2e 64 69 73 70 6c 61 79 20 3d 20 22 6e 6f le.display = "no
2c80: 6e 65 22 3b 0a 20 20 20 20 20 20 20 20 7d 20 65 ne";. } e
2c90: 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 20 20 lse {.
2ca0: 63 53 75 62 42 72 61 6e 63 68 65 73 5b 30 5d 2e cSubBranches[0].
2cb0: 73 74 79 6c 65 2e 64 69 73 70 6c 61 79 20 3d 20 style.display =
2cc0: 22 62 6c 6f 63 6b 22 3b 0a 20 20 20 20 20 20 20 "block";.
2cd0: 20 7d 0a 20 20 20 20 20 20 7d 0a 20 20 20 20 7d }. }. }
2ce0: 0a 0a 20 20 20 20 2f 2f 20 54 68 69 73 20 66 75 .. // This fu
2cf0: 6e 63 74 69 6f 6e 20 6d 61 6b 65 73 20 6e 65 73 nction makes nes
2d00: 74 65 64 20 6c 69 73 74 20 69 74 65 6d 73 20 6c ted list items l
2d10: 6f 6f 6b 20 6c 69 6b 65 20 6c 69 6e 6b 73 0a 20 ook like links.
2d20: 20 20 20 66 75 6e 63 74 69 6f 6e 20 61 64 64 4c function addL
2d30: 69 6e 6b 73 54 6f 42 72 61 6e 63 68 65 73 28 6f inksToBranches(o
2d40: 4c 69 73 74 29 20 7b 0a 20 20 20 20 20 20 76 61 List) {. va
2d50: 72 20 63 42 72 61 6e 63 68 65 73 20 3d 20 6f 4c r cBranches = oL
2d60: 69 73 74 2e 67 65 74 45 6c 65 6d 65 6e 74 73 42 ist.getElementsB
2d70: 79 54 61 67 4e 61 6d 65 28 22 6c 69 22 29 3b 0a yTagName("li");.
2d80: 20 20 20 20 20 20 76 61 72 20 69 2c 20 6e 2c 20 var i, n,
2d90: 63 53 75 62 42 72 61 6e 63 68 65 73 3b 0a 20 20 cSubBranches;.
2da0: 20 20 20 20 69 66 20 28 63 42 72 61 6e 63 68 65 if (cBranche
2db0: 73 2e 6c 65 6e 67 74 68 20 3e 20 30 29 20 7b 0a s.length > 0) {.
2dc0: 20 20 20 20 20 20 20 20 66 6f 72 20 28 69 3d 30 for (i=0
2dd0: 2c 20 6e 20 3d 20 63 42 72 61 6e 63 68 65 73 2e , n = cBranches.
2de0: 6c 65 6e 67 74 68 3b 20 69 20 3c 20 6e 3b 20 69 length; i < n; i
2df0: 2b 2b 29 20 7b 0a 20 20 20 20 20 20 20 20 20 20 ++) {.
2e00: 63 53 75 62 42 72 61 6e 63 68 65 73 20 3d 20 63 cSubBranches = c
2e10: 42 72 61 6e 63 68 65 73 5b 69 5d 2e 67 65 74 45 Branches[i].getE
2e20: 6c 65 6d 65 6e 74 73 42 79 54 61 67 4e 61 6d 65 lementsByTagName
2e30: 28 22 75 6c 22 29 3b 0a 20 20 20 20 20 20 20 20 ("ul");.
2e40: 20 20 69 66 20 28 63 53 75 62 42 72 61 6e 63 68 if (cSubBranch
2e50: 65 73 2e 6c 65 6e 67 74 68 20 3e 20 30 29 20 7b es.length > 0) {
2e60: 0a 20 20 20 20 20 20 20 20 20 20 20 20 61 64 64 . add
2e70: 4c 69 6e 6b 73 54 6f 42 72 61 6e 63 68 65 73 28 LinksToBranches(
2e80: 63 53 75 62 42 72 61 6e 63 68 65 73 5b 30 5d 29 cSubBranches[0])
2e90: 3b 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 42 ;. cB
2ea0: 72 61 6e 63 68 65 73 5b 69 5d 2e 63 6c 61 73 73 ranches[i].class
2eb0: 4e 61 6d 65 20 3d 20 22 48 61 6e 64 43 75 72 73 Name = "HandCurs
2ec0: 6f 72 53 74 79 6c 65 22 3b 0a 20 20 20 20 20 20 orStyle";.
2ed0: 20 20 20 20 20 20 63 42 72 61 6e 63 68 65 73 5b cBranches[
2ee0: 69 5d 2e 73 74 79 6c 65 2e 63 6f 6c 6f 72 20 3d i].style.color =
2ef0: 20 22 62 6c 75 65 22 3b 0a 20 20 20 20 20 20 20 "blue";.
2f00: 20 20 20 20 20 63 53 75 62 42 72 61 6e 63 68 65 cSubBranche
2f10: 73 5b 30 5d 2e 73 74 79 6c 65 2e 63 6f 6c 6f 72 s[0].style.color
2f20: 20 3d 20 22 62 6c 61 63 6b 22 3b 0a 20 20 20 20 = "black";.
2f30: 20 20 20 20 20 20 20 20 63 53 75 62 42 72 61 6e cSubBran
2f40: 63 68 65 73 5b 30 5d 2e 73 74 79 6c 65 2e 63 75 ches[0].style.cu
2f50: 72 73 6f 72 20 3d 20 22 61 75 74 6f 22 3b 0a 20 rsor = "auto";.
2f60: 20 20 20 20 20 20 20 20 20 7d 0a 20 20 20 20 20 }.
2f70: 20 20 20 7d 0a 20 20 20 20 20 20 7d 0a 20 20 20 }. }.
2f80: 20 7d 0a 20 20 3c 2f 73 63 72 69 70 74 3e 0a 45 }. </script>.E
2f90: 4f 46 0a 29 0a 0a 28 64 65 66 69 6e 65 20 74 65 OF.)..(define te
2fa0: 73 74 73 3a 63 73 73 2d 6a 73 63 72 69 70 74 2d sts:css-jscript-
2fb0: 62 6c 6f 63 6b 2d 64 79 6e 61 6d 69 63 20 0a 23 block-dynamic .#
2fc0: 3c 3c 45 4f 46 0a 20 20 20 20 20 20 20 20 20 20 <<EOF.
2fd0: 20 3c 73 63 72 69 70 74 20 73 72 63 3d 20 2e 2f <script src= ./
2fe0: 6a 71 75 65 72 79 33 2e 31 2e 30 2e 6a 73 3e 3c jquery3.1.0.js><
2ff0: 2f 73 63 72 69 70 74 3e 20 0a 45 4f 46 0a 29 0a /script> .EOF.).
3000: 0a 28 64 65 66 69 6e 65 20 20 28 74 65 73 74 3a .(define (test:
3010: 6a 73 2d 62 6c 6f 63 6b 20 6a 61 76 61 73 63 72 js-block javascr
3020: 69 70 74 2d 6c 69 62 29 0a 20 20 20 28 63 6f 6e ipt-lib). (con
3030: 63 20 20 22 3c 73 63 72 69 70 74 20 73 72 63 3d c "<script src=
3040: 22 20 6a 61 76 61 73 63 72 69 70 74 2d 6c 69 62 " javascript-lib
3050: 20 22 3e 3c 2f 73 63 72 69 70 74 3e 22 20 29 29 "></script>" ))
3060: 0a 0a 0a 28 64 65 66 69 6e 65 20 74 65 73 74 73 ...(define tests
3070: 3a 63 73 73 2d 6a 73 63 72 69 70 74 2d 62 6c 6f :css-jscript-blo
3080: 63 6b 2d 73 74 61 74 69 63 20 28 74 65 73 74 3a ck-static (test:
3090: 6a 73 2d 62 6c 6f 63 6b 20 2a 6a 61 76 61 2d 73 js-block *java-s
30a0: 63 72 69 70 74 2d 6c 69 62 2a 29 29 0a 0a 28 64 cript-lib*))..(d
30b0: 65 66 69 6e 65 20 28 74 65 73 74 73 3a 63 73 73 efine (tests:css
30c0: 2d 6a 73 63 72 69 70 74 2d 62 6c 6f 63 6b 2d 63 -jscript-block-c
30d0: 6f 6e 64 20 64 79 6e 61 6d 69 63 29 20 0a 20 20 ond dynamic) .
30e0: 20 20 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 (if (equal?
30f0: 64 79 6e 61 6d 69 63 20 20 23 74 29 0a 20 20 20 dynamic #t).
3100: 20 20 20 20 74 65 73 74 73 3a 63 73 73 2d 6a 73 tests:css-js
3110: 63 72 69 70 74 2d 62 6c 6f 63 6b 2d 64 79 6e 61 cript-block-dyna
3120: 6d 69 63 0a 20 20 20 20 20 20 20 74 65 73 74 73 mic. tests
3130: 3a 63 73 73 2d 6a 73 63 72 69 70 74 2d 62 6c 6f :css-jscript-blo
3140: 63 6b 2d 73 74 61 74 69 63 29 29 0a 0a 20 20 20 ck-static))..
3150: 20 20 20 20 0a 28 64 65 66 69 6e 65 20 28 74 65 .(define (te
3160: 73 74 73 3a 72 75 6e 2d 72 65 63 6f 72 64 2d 3e sts:run-record->
3170: 74 65 73 74 2d 70 61 74 68 20 72 75 6e 20 6e 75 test-path run nu
3180: 6d 6b 65 79 73 29 0a 20 20 20 28 61 70 70 65 6e mkeys). (appen
3190: 64 20 28 74 61 6b 65 20 28 76 65 63 74 6f 72 2d d (take (vector-
31a0: 3e 6c 69 73 74 20 72 75 6e 29 20 6e 75 6d 6b 65 >list run) numke
31b0: 79 73 29 0a 09 20 20 20 28 6c 69 73 74 20 28 76 ys).. (list (v
31c0: 65 63 74 6f 72 2d 72 65 66 20 72 75 6e 20 28 2b ector-ref run (+
31d0: 20 31 20 6e 75 6d 6b 65 79 73 29 29 29 29 29 0a 1 numkeys))))).
31e0: 0a 0a 28 64 65 66 69 6e 65 20 28 74 65 73 74 73 ..(define (tests
31f0: 3a 67 65 74 2d 72 65 73 74 2d 64 61 74 61 20 72 :get-rest-data r
3200: 75 6e 73 20 68 65 61 64 65 72 20 6e 75 6d 6b 65 uns header numke
3210: 79 73 29 0a 20 20 20 28 6c 65 74 20 28 28 72 65 ys). (let ((re
3220: 73 68 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 sh (make-hash-ta
3230: 62 6c 65 29 29 29 0a 20 20 20 28 66 6f 72 2d 65 ble))). (for-e
3240: 61 63 68 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 ach. (lambda
3250: 20 28 72 75 6e 29 0a 20 20 20 20 20 20 20 20 28 (run). (
3260: 6c 65 74 2a 20 28 28 72 75 6e 2d 69 64 20 28 64 let* ((run-id (d
3270: 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 b:get-value-by-h
3280: 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 eader run header
3290: 20 22 69 64 22 29 29 0a 20 20 20 20 20 20 20 20 "id")).
32a0: 20 20 20 20 20 20 20 28 72 75 6e 2d 64 69 72 20 (run-dir
32b0: 20 20 20 20 20 28 74 65 73 74 73 3a 72 75 6e 2d (tests:run-
32c0: 72 65 63 6f 72 64 2d 3e 74 65 73 74 2d 70 61 74 record->test-pat
32d0: 68 20 72 75 6e 20 6e 75 6d 6b 65 79 73 29 29 0a h run numkeys)).
32e0: 09 20 20 20 20 20 20 20 28 74 65 73 74 2d 64 61 . (test-da
32f0: 74 61 20 20 20 20 28 72 6d 74 3a 67 65 74 2d 74 ta (rmt:get-t
3300: 65 73 74 73 2d 66 6f 72 2d 72 75 6e 0a 09 09 09 ests-for-run....
3310: 09 20 20 20 72 75 6e 2d 69 64 0a 20 20 20 20 20 . run-id.
3320: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3330: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 22 25 "%
3340: 22 20 20 20 20 20 20 20 3b 3b 20 74 65 73 74 6e " ;; testn
3350: 61 6d 65 70 61 74 74 0a 09 09 09 09 20 20 20 27 amepatt..... '
3360: 28 29 20 20 20 20 20 20 20 20 3b 3b 20 73 74 61 () ;; sta
3370: 74 65 73 0a 09 09 09 09 20 20 20 27 28 29 20 20 tes..... '()
3380: 20 20 20 20 20 20 3b 3b 20 73 74 61 74 75 73 65 ;; statuse
3390: 73 0a 09 09 09 09 20 20 20 23 66 20 20 20 20 20 s..... #f
33a0: 20 20 20 20 3b 3b 20 6f 66 66 73 65 74 0a 09 09 ;; offset...
33b0: 09 09 20 20 20 23 66 20 20 20 20 20 20 20 20 20 .. #f
33c0: 3b 3b 20 6e 75 6d 2d 74 6f 2d 67 65 74 0a 09 09 ;; num-to-get...
33d0: 09 09 20 20 20 23 66 20 20 20 20 20 20 20 20 20 .. #f
33e0: 3b 3b 20 68 69 64 65 2f 6e 6f 74 2d 68 69 64 65 ;; hide/not-hide
33f0: 0a 09 09 09 09 20 20 20 23 66 20 20 20 20 20 20 ..... #f
3400: 20 20 20 3b 3b 20 73 6f 72 74 2d 62 79 0a 09 09 ;; sort-by...
3410: 09 09 20 20 20 23 66 20 20 20 20 20 20 20 20 20 .. #f
3420: 3b 3b 20 73 6f 72 74 2d 6f 72 64 65 72 0a 09 09 ;; sort-order...
3430: 09 09 20 20 20 23 66 20 20 20 20 20 20 20 20 20 .. #f
3440: 3b 3b 20 27 73 68 6f 72 74 6c 69 73 74 20 20 20 ;; 'shortlist
3450: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3460: 20 20 20 20 20 20 20 20 3b 3b 20 71 72 79 74 79 ;; qryty
3470: 70 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 pe.
3480: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3490: 20 20 20 20 20 20 30 20 20 20 20 20 20 20 20 20 0
34a0: 3b 3b 20 6c 61 73 74 20 75 70 64 61 74 65 0a 09 ;; last update..
34b0: 09 09 09 20 20 20 23 66 29 29 29 0a 20 20 20 20 ... #f))).
34c0: 20 20 20 20 20 20 20 20 0a 20 20 20 20 20 20 20 .
34d0: 20 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 (map (lambd
34e0: 61 20 28 74 65 73 74 29 0a 20 20 20 20 20 20 20 a (test).
34f0: 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 2a 20 (let*
3500: 28 28 74 65 73 74 2d 6e 61 6d 65 20 28 76 65 63 ((test-name (vec
3510: 74 6f 72 2d 72 65 66 20 74 65 73 74 20 32 29 29 tor-ref test 2))
3520: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3530: 20 20 20 20 20 20 20 20 20 28 74 65 73 74 2d 68 (test-h
3540: 74 6d 6c 2d 70 61 74 68 20 28 63 6f 6e 63 20 28 tml-path (conc (
3550: 76 65 63 74 6f 72 2d 72 65 66 20 74 65 73 74 20 vector-ref test
3560: 31 30 29 20 22 2f 22 20 28 76 65 63 74 6f 72 2d 10) "/" (vector-
3570: 72 65 66 20 74 65 73 74 20 31 33 29 29 29 0a 20 ref test 13))).
3580: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3590: 20 20 20 20 20 20 20 28 74 65 73 74 2d 69 74 65 (test-ite
35a0: 6d 20 28 63 6f 6e 63 20 74 65 73 74 2d 6e 61 6d m (conc test-nam
35b0: 65 20 22 3a 22 20 28 76 65 63 74 6f 72 2d 72 65 e ":" (vector-re
35c0: 66 20 74 65 73 74 20 31 31 29 29 29 0a 20 20 20 f test 11))).
35d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
35e0: 20 20 20 20 20 28 74 65 73 74 2d 73 74 61 74 75 (test-statu
35f0: 73 20 28 76 65 63 74 6f 72 2d 72 65 66 20 74 65 s (vector-ref te
3600: 73 74 20 34 29 29 29 0a 20 20 20 20 20 20 20 20 st 4))).
3610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3620: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3630: 20 20 28 69 66 20 28 6e 6f 74 20 28 68 61 73 68 (if (not (hash
3640: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
3650: 6c 74 20 72 65 73 68 20 74 65 73 74 2d 6e 61 6d lt resh test-nam
3660: 65 20 20 23 66 29 29 0a 20 20 20 20 20 20 20 20 e #f)).
3670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 68 (h
3680: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 ash-table-set! r
3690: 65 73 68 20 74 65 73 74 2d 6e 61 6d 65 20 20 20 esh test-name
36a0: 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 (make-hash-table
36b0: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
36c0: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 68 61 (if (not (ha
36d0: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
36e0: 61 75 6c 74 20 28 68 61 73 68 2d 74 61 62 6c 65 ault (hash-table
36f0: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 72 65 73 -ref/default res
3700: 68 20 74 65 73 74 2d 6e 61 6d 65 20 20 23 66 29 h test-name #f)
3710: 20 20 74 65 73 74 2d 69 74 65 6d 20 20 23 66 29 test-item #f)
3720: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
3730: 20 20 20 20 20 20 20 20 20 28 68 61 73 68 2d 74 (hash-t
3740: 61 62 6c 65 2d 73 65 74 21 20 28 68 61 73 68 2d able-set! (hash-
3750: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
3760: 74 20 72 65 73 68 20 74 65 73 74 2d 6e 61 6d 65 t resh test-name
3770: 20 20 23 66 29 20 74 65 73 74 2d 69 74 65 6d 20 #f) test-item
3780: 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 (make-hash-tab
3790: 6c 65 29 29 29 20 0a 20 20 20 20 20 20 20 20 20 le))) .
37a0: 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c (hash-tabl
37b0: 65 2d 73 65 74 21 20 20 28 68 61 73 68 2d 74 61 e-set! (hash-ta
37c0: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
37d0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
37e0: 64 65 66 61 75 6c 74 20 72 65 73 68 20 74 65 73 default resh tes
37f0: 74 2d 6e 61 6d 65 20 20 23 66 29 20 74 65 73 74 t-name #f) test
3800: 2d 69 74 65 6d 20 23 66 29 20 72 75 6e 2d 69 64 -item #f) run-id
3810: 20 28 6c 69 73 74 20 74 65 73 74 2d 73 74 61 74 (list test-stat
3820: 75 73 20 74 65 73 74 2d 68 74 6d 6c 2d 70 61 74 us test-html-pat
3830: 68 29 29 29 29 20 0a 20 20 20 20 20 20 20 20 74 h)))) . t
3840: 65 73 74 2d 64 61 74 61 29 29 29 0a 20 20 20 20 est-data))).
3850: 20 20 72 75 6e 73 29 0a 20 20 20 72 65 73 68 29 runs). resh)
3860: 29 0a 0a 0a 3b 3b 20 74 65 73 74 73 3a 67 65 6e )...;; tests:gen
3870: 72 61 74 65 20 64 61 73 68 62 6f 61 72 64 20 62 rate dashboard b
3880: 6f 64 79 20 0a 3b 3b 0a 0a 28 64 65 66 69 6e 65 ody .;;..(define
3890: 20 28 74 65 73 74 73 3a 64 61 73 68 62 6f 61 72 (tests:dashboar
38a0: 64 2d 62 6f 64 79 20 70 61 67 65 20 70 67 2d 73 d-body page pg-s
38b0: 69 7a 65 20 6b 65 79 73 20 6e 75 6d 6b 65 79 73 ize keys numkeys
38c0: 20 20 74 6f 74 61 6c 2d 72 75 6e 73 20 6c 69 6e total-runs lin
38d0: 6b 74 72 65 65 20 61 72 65 61 2d 6e 61 6d 65 20 ktree area-name
38e0: 67 65 74 2d 70 72 65 76 2d 6c 69 6e 6b 73 20 67 get-prev-links g
38f0: 65 74 2d 6e 65 78 74 2d 6c 69 6e 6b 73 20 66 6c et-next-links fl
3900: 61 67 20 72 75 6e 2d 70 61 74 74 20 74 61 72 67 ag run-patt targ
3910: 65 74 2d 70 61 74 74 29 0a 20 20 28 6c 65 74 2a et-patt). (let*
3920: 20 28 28 73 74 61 72 74 20 28 2a 20 70 61 67 65 ((start (* page
3930: 20 70 67 2d 73 69 7a 65 29 29 20 0a 09 09 09 09 pg-size)) .....
3940: 09 3b 28 72 75 6e 73 64 61 74 20 20 20 28 72 6d .;(runsdat (rm
3950: 74 3a 67 65 74 2d 72 75 6e 73 20 22 25 22 20 70 t:get-runs "%" p
3960: 67 2d 73 69 7a 65 20 73 74 61 72 74 20 28 6d 61 g-size start (ma
3970: 70 20 28 6c 61 6d 62 64 61 20 28 78 29 28 6c 69 p (lambda (x)(li
3980: 73 74 20 78 20 22 25 22 29 29 20 6b 65 79 73 29 st x "%")) keys)
3990: 29 29 0a 20 20 20 20 20 20 20 20 20 28 72 75 6e )). (run
39a0: 73 64 61 74 20 20 20 28 72 6d 74 3a 67 65 74 2d sdat (rmt:get-
39b0: 72 75 6e 73 2d 62 79 2d 70 61 74 74 20 20 6b 65 runs-by-patt ke
39c0: 79 73 20 72 75 6e 2d 70 61 74 74 20 74 61 72 67 ys run-patt targ
39d0: 65 74 2d 70 61 74 74 20 73 74 61 72 74 20 70 67 et-patt start pg
39e0: 2d 73 69 7a 65 20 23 66 20 30 20 73 6f 72 74 2d -size #f 0 sort-
39f0: 6f 72 64 65 72 3a 20 22 64 65 73 63 22 29 29 0a order: "desc")).
3a00: 09 09 09 09 09 3b 20 64 62 3a 67 65 74 2d 72 75 .....; db:get-ru
3a10: 6e 73 2d 62 79 2d 70 61 74 74 20 20 20 6b 65 79 ns-by-patt key
3a20: 73 20 72 75 6e 6e 61 6d 65 70 61 74 74 20 74 61 s runnamepatt ta
3a30: 72 67 70 61 74 74 20 6f 66 66 73 65 74 20 6c 69 rgpatt offset li
3a40: 6d 69 74 20 66 69 65 6c 64 73 20 6c 61 73 74 2d mit fields last-
3a50: 75 70 64 61 74 65 20 20 20 0a 09 20 28 68 65 61 update .. (hea
3a60: 64 65 72 20 20 20 20 28 76 65 63 74 6f 72 2d 72 der (vector-r
3a70: 65 66 20 72 75 6e 73 64 61 74 20 30 29 29 0a 09 ef runsdat 0))..
3a80: 20 28 72 75 6e 73 20 20 20 20 20 20 28 76 65 63 (runs (vec
3a90: 74 6f 72 2d 72 65 66 20 72 75 6e 73 64 61 74 20 tor-ref runsdat
3aa0: 31 29 29 0a 20 20 20 20 20 20 20 20 20 28 63 74 1)). (ct
3ab0: 72 20 30 29 0a 20 20 20 20 20 20 20 20 20 28 74 r 0). (t
3ac0: 65 73 74 2d 72 75 6e 73 2d 68 61 73 68 20 28 74 est-runs-hash (t
3ad0: 65 73 74 73 3a 67 65 74 2d 72 65 73 74 2d 64 61 ests:get-rest-da
3ae0: 74 61 20 72 75 6e 73 20 68 65 61 64 65 72 20 6e ta runs header n
3af0: 75 6d 6b 65 79 73 29 29 0a 20 20 20 20 20 20 20 umkeys)).
3b00: 20 20 28 74 65 73 74 2d 6c 69 73 74 20 28 68 61 (test-list (ha
3b10: 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 74 65 sh-table-keys te
3b20: 73 74 2d 72 75 6e 73 2d 68 61 73 68 29 29 29 20 st-runs-hash)))
3b30: 0a 20 20 20 20 0a 20 20 20 20 28 73 3a 68 74 6d . . (s:htm
3b40: 6c 20 74 65 73 74 73 3a 63 73 73 2d 6a 73 63 72 l tests:css-jscr
3b50: 69 70 74 2d 62 6c 6f 63 6b 20 28 74 65 73 74 73 ipt-block (tests
3b60: 3a 63 73 73 2d 6a 73 63 72 69 70 74 2d 62 6c 6f :css-jscript-blo
3b70: 63 6b 2d 63 6f 6e 64 20 66 6c 61 67 29 0a 09 20 ck-cond flag)..
3b80: 20 20 20 28 73 3a 74 69 74 6c 65 20 22 53 75 6d (s:title "Sum
3b90: 6d 61 72 79 20 66 6f 72 20 22 20 61 72 65 61 2d mary for " area-
3ba0: 6e 61 6d 65 29 0a 09 20 20 20 20 28 73 3a 62 6f name).. (s:bo
3bb0: 64 79 20 27 6f 6e 6c 6f 61 64 20 22 61 64 64 45 dy 'onload "addE
3bc0: 76 65 6e 74 73 28 29 3b 22 0a 09 09 20 20 20 20 vents();"...
3bd0: 28 67 65 74 2d 70 72 65 76 2d 6c 69 6e 6b 73 20 (get-prev-links
3be0: 70 61 67 65 20 6c 69 6e 6b 74 72 65 65 29 0a 09 page linktree)..
3bf0: 09 20 20 20 20 28 67 65 74 2d 6e 65 78 74 2d 6c . (get-next-l
3c00: 69 6e 6b 73 20 70 61 67 65 20 6c 69 6e 6b 74 72 inks page linktr
3c10: 65 65 20 74 6f 74 61 6c 2d 72 75 6e 73 29 0a 09 ee total-runs)..
3c20: 09 20 20 20 20 0a 09 09 20 20 20 20 28 73 3a 68 . ... (s:h
3c30: 31 20 22 53 75 6d 6d 61 72 79 20 66 6f 72 20 22 1 "Summary for "
3c40: 20 61 72 65 61 2d 6e 61 6d 65 29 0a 09 09 20 20 area-name)...
3c50: 20 20 28 73 3a 68 33 20 22 46 69 6c 74 65 72 22 (s:h3 "Filter"
3c60: 20 29 0a 09 09 20 20 20 20 28 73 3a 69 6e 70 75 )... (s:inpu
3c70: 74 20 27 74 79 70 65 20 22 74 65 78 74 22 20 20 t 'type "text"
3c80: 27 6e 61 6d 65 20 22 74 65 73 74 6e 61 6d 65 22 'name "testname"
3c90: 20 27 69 64 20 22 74 65 73 74 6e 61 6d 65 22 20 'id "testname"
3ca0: 27 6c 65 6e 67 74 68 20 22 33 30 22 20 27 6f 6e 'length "30" 'on
3cb0: 6b 65 79 75 70 20 22 66 69 6c 74 65 72 73 6f 6d keyup "filtersom
3cc0: 65 28 29 22 29 0a 09 09 20 20 20 20 3b 3b 20 74 e()")... ;; t
3cd0: 6f 70 20 6c 69 73 74 0a 09 09 20 20 20 20 0a 09 op list... ..
3ce0: 09 20 20 20 20 28 73 3a 74 61 62 6c 65 20 27 69 . (s:table 'i
3cf0: 64 20 22 4c 69 6e 6b 65 64 4c 69 73 74 31 22 20 d "LinkedList1"
3d00: 27 62 6f 72 64 65 72 20 22 31 22 20 27 63 65 6c 'border "1" 'cel
3d10: 6c 73 70 61 63 69 6e 67 20 30 0a 09 09 09 20 20 lspacing 0....
3d20: 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 (map (lambda
3d30: 28 6b 65 79 29 0a 09 09 09 09 20 20 20 20 28 6c (key)..... (l
3d40: 65 74 2a 20 28 28 72 65 73 20 28 73 3a 74 72 20 et* ((res (s:tr
3d50: 27 63 6c 61 73 73 20 22 73 6f 6d 65 74 68 69 6e 'class "somethin
3d60: 67 22 20 0a 09 09 09 09 09 09 20 20 20 20 20 20 g" .......
3d70: 28 73 3a 74 68 20 6b 65 79 20 29 0a 09 09 09 09 (s:th key ).....
3d80: 09 09 20 20 20 20 20 20 28 6d 61 70 20 28 6c 61 .. (map (la
3d90: 6d 62 64 61 20 28 72 75 6e 29 0a 09 09 09 09 09 mbda (run)......
3da0: 09 09 20 20 20 20 20 28 73 3a 74 68 20 20 28 76 .. (s:th (v
3db0: 65 63 74 6f 72 2d 72 65 66 20 72 75 6e 20 63 74 ector-ref run ct
3dc0: 72 29 29 29 0a 09 09 09 09 09 09 09 20 20 20 72 r)))........ r
3dd0: 75 6e 73 29 29 29 29 0a 09 09 09 09 20 20 20 20 uns)))).....
3de0: 20 20 28 73 65 74 21 20 63 74 72 20 28 2b 20 63 (set! ctr (+ c
3df0: 74 72 20 31 29 29 0a 09 09 09 09 20 20 20 20 20 tr 1)).....
3e00: 20 72 65 73 29 29 0a 09 09 09 09 20 20 6b 65 79 res))..... key
3e10: 73 29 0a 09 09 09 20 20 20 20 20 28 73 3a 74 72 s).... (s:tr
3e20: 0a 09 09 09 20 20 20 20 20 20 28 73 3a 74 68 20 .... (s:th
3e30: 22 52 75 6e 20 4e 61 6d 65 22 29 0a 09 09 09 20 "Run Name")....
3e40: 20 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 (map (lambd
3e50: 61 20 28 72 75 6e 29 0a 09 09 09 09 20 20 20 20 a (run).....
3e60: 20 28 73 3a 74 68 20 28 64 62 3a 67 65 74 2d 76 (s:th (db:get-v
3e70: 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 alue-by-header r
3e80: 75 6e 20 68 65 61 64 65 72 20 22 72 75 6e 6e 61 un header "runna
3e90: 6d 65 22 29 29 29 0a 09 09 09 09 20 20 20 72 75 me")))..... ru
3ea0: 6e 73 29 29 0a 09 09 09 20 20 20 20 20 0a 09 09 ns)).... ...
3eb0: 09 20 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 . (map (lamb
3ec0: 64 61 20 28 74 65 73 74 2d 6e 61 6d 65 29 0a 09 da (test-name)..
3ed0: 09 09 09 20 20 20 20 28 6c 65 74 2a 20 28 28 69 ... (let* ((i
3ee0: 74 65 6d 2d 68 61 73 68 20 28 68 61 73 68 2d 74 tem-hash (hash-t
3ef0: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
3f00: 20 74 65 73 74 2d 72 75 6e 73 2d 68 61 73 68 20 test-runs-hash
3f10: 74 65 73 74 2d 6e 61 6d 65 20 20 23 66 29 29 0a test-name #f)).
3f20: 09 09 09 09 09 20 20 20 28 69 74 65 6d 2d 6b 65 ..... (item-ke
3f30: 79 73 20 28 73 6f 72 74 20 28 68 61 73 68 2d 74 ys (sort (hash-t
3f40: 61 62 6c 65 2d 6b 65 79 73 20 69 74 65 6d 2d 68 able-keys item-h
3f50: 61 73 68 29 20 73 74 72 69 6e 67 3c 3d 3f 29 29 ash) string<=?))
3f60: 29 20 0a 09 09 09 09 20 20 20 20 20 20 28 6d 61 ) ..... (ma
3f70: 70 20 28 6c 61 6d 62 64 61 20 28 69 74 65 6d 2d p (lambda (item-
3f80: 6e 61 6d 65 29 20 20 0a 20 20 09 09 20 20 20 20 name) . ..
3f90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3fa0: 20 20 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 (let* (
3fb0: 28 72 65 73 20 28 73 3a 74 72 20 20 27 63 6c 61 (res (s:tr 'cla
3fc0: 73 73 20 69 74 65 6d 2d 6e 61 6d 65 0a 09 09 09 ss item-name....
3fd0: 09 09 09 09 09 28 73 3a 74 64 20 20 69 74 65 6d .....(s:td item
3fe0: 2d 6e 61 6d 65 20 27 63 6c 61 73 73 20 22 74 65 -name 'class "te
3ff0: 73 74 22 20 29 0a 09 09 09 09 09 09 09 09 28 6d st" ).........(m
4000: 61 70 20 28 6c 61 6d 62 64 61 20 28 72 75 6e 29 ap (lambda (run)
4010: 0a 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 .........
4020: 28 6c 65 74 2a 20 28 28 72 75 6e 2d 74 65 73 74 (let* ((run-test
4030: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
4040: 2f 64 65 66 61 75 6c 74 20 69 74 65 6d 2d 68 61 /default item-ha
4050: 73 68 20 69 74 65 6d 2d 6e 61 6d 65 20 20 23 66 sh item-name #f
4060: 29 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 ))..........
4070: 20 20 28 72 75 6e 2d 69 64 20 28 64 62 3a 67 65 (run-id (db:ge
4080: 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 t-value-by-heade
4090: 72 20 72 75 6e 20 68 65 61 64 65 72 20 22 69 64 r run header "id
40a0: 22 29 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 "))..........
40b0: 20 20 20 28 72 65 73 75 6c 74 20 28 68 61 73 68 (result (hash
40c0: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
40d0: 6c 74 20 72 75 6e 2d 74 65 73 74 20 72 75 6e 2d lt run-test run-
40e0: 69 64 20 22 6e 2f 61 22 29 29 0a 09 09 09 09 09 id "n/a"))......
40f0: 3b 28 72 65 6c 61 74 69 76 65 2d 70 61 74 68 20 ;(relative-path
4100: 28 67 65 74 2d 72 65 6c 61 74 69 76 65 2d 70 61 (get-relative-pa
4110: 74 68 29 29 20 0a 09 09 09 09 09 09 09 09 09 20 th)) ..........
4120: 20 20 20 20 20 28 73 74 61 74 75 73 20 28 69 66 (status (if
4130: 20 28 73 74 72 69 6e 67 3f 20 72 65 73 75 6c 74 (string? result
4140: 29 0a 09 09 09 09 09 09 09 09 09 09 09 20 20 72 )............ r
4150: 65 73 75 6c 74 0a 09 09 09 09 09 09 09 09 09 09 esult...........
4160: 09 20 20 28 63 61 72 20 72 65 73 75 6c 74 29 29 . (car result))
4170: 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 )..........
4180: 20 28 6c 69 6e 6b 20 28 69 66 20 28 73 74 72 69 (link (if (stri
4190: 6e 67 3f 20 72 65 73 75 6c 74 29 0a 09 09 09 09 ng? result).....
41a0: 09 09 09 09 09 09 09 72 65 73 75 6c 74 0a 09 09 .......result...
41b0: 09 09 09 09 09 09 09 09 09 28 69 66 20 28 65 71 .........(if (eq
41c0: 75 61 6c 3f 20 66 6c 61 67 20 23 74 29 20 0a 09 ual? flag #t) ..
41d0: 09 09 09 09 09 09 09 09 09 09 20 20 20 20 28 73 .......... (s
41e0: 3a 61 20 28 63 61 72 20 72 65 73 75 6c 74 29 20 :a (car result)
41f0: 27 68 72 65 66 20 28 63 6f 6e 63 20 22 2e 2f 74 'href (conc "./t
4200: 65 73 74 5f 6c 6f 67 3f 72 75 6e 69 64 3d 22 20 est_log?runid="
4210: 72 75 6e 2d 69 64 20 22 26 74 65 73 74 6e 61 6d run-id "&testnam
4220: 65 3d 22 20 20 69 74 65 6d 2d 6e 61 6d 65 20 29 e=" item-name )
4230: 29 0a 09 09 09 09 09 09 09 09 09 09 09 20 20 20 )............
4240: 20 28 73 3a 61 20 28 63 61 72 20 72 65 73 75 6c (s:a (car resul
4250: 74 29 20 27 68 72 65 66 20 28 73 74 72 69 6e 67 t) 'href (string
4260: 2d 73 75 62 73 74 69 74 75 74 65 20 20 28 63 6f -substitute (co
4270: 6e 63 20 6c 69 6e 6b 74 72 65 65 20 22 2f 22 29 nc linktree "/")
4280: 20 20 22 22 20 28 63 61 64 72 20 72 65 73 75 6c "" (cadr resul
4290: 74 29 20 20 22 2d 22 29 29 29 29 29 29 0a 09 09 t) "-"))))))...
42a0: 09 09 09 09 09 09 09 20 28 73 3a 74 64 20 20 6c ....... (s:td l
42b0: 69 6e 6b 20 27 63 6c 61 73 73 20 73 74 61 74 75 ink 'class statu
42c0: 73 29 29 29 0a 09 09 09 09 09 09 09 09 20 20 20 s))).........
42d0: 20 20 72 75 6e 73 29 29 29 29 0a 09 09 09 09 09 runs))))......
42e0: 20 20 20 20 20 20 20 72 65 73 29 29 0a 09 09 09 res))....
42f0: 09 09 20 20 20 69 74 65 6d 2d 6b 65 79 73 29 29 .. item-keys))
4300: 29 0a 09 09 09 09 20 20 74 65 73 74 2d 6c 69 73 )..... test-lis
4310: 74 29 29 29 29 29 29 20 0a 0a 3b 3b 20 28 74 65 t)))))) ..;; (te
4320: 73 74 73 3a 63 72 65 61 74 65 2d 68 74 6d 6c 2d sts:create-html-
4330: 74 72 65 65 20 22 74 65 73 74 2d 69 6e 64 65 78 tree "test-index
4340: 2e 68 74 6d 6c 22 29 0a 3b 3b 0a 28 64 65 66 69 .html").;;.(defi
4350: 6e 65 20 28 74 65 73 74 73 3a 63 72 65 61 74 65 ne (tests:create
4360: 2d 68 74 6d 6c 2d 74 72 65 65 20 6f 75 74 66 29 -html-tree outf)
4370: 0a 20 20 28 6c 65 74 2a 20 28 28 6c 6f 63 6b 66 . (let* ((lockf
4380: 69 6c 65 20 20 28 63 6f 6e 63 20 6f 75 74 66 20 ile (conc outf
4390: 22 2e 6c 6f 63 6b 22 29 29 0a 09 20 28 72 75 6e ".lock")).. (run
43a0: 73 2d 74 6f 2d 70 72 6f 63 65 73 73 20 27 28 29 s-to-process '()
43b0: 29 0a 20 20 20 20 20 20 20 20 20 28 6c 69 6e 6b ). (link
43c0: 74 72 65 65 20 20 28 63 6f 6d 6d 6f 6e 3a 67 65 tree (common:ge
43d0: 74 2d 6c 69 6e 6b 74 72 65 65 29 29 0a 20 20 20 t-linktree)).
43e0: 20 20 20 20 20 20 28 61 72 65 61 2d 6e 61 6d 65 (area-name
43f0: 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 74 65 73 (common:get-tes
4400: 74 73 75 69 74 65 2d 6e 61 6d 65 29 29 0a 09 20 tsuite-name))..
4410: 28 6b 65 79 73 20 20 20 20 20 20 28 72 6d 74 3a (keys (rmt:
4420: 67 65 74 2d 6b 65 79 73 29 29 0a 09 20 28 6e 75 get-keys)).. (nu
4430: 6d 6b 65 79 73 20 20 20 28 6c 65 6e 67 74 68 20 mkeys (length
4440: 6b 65 79 73 29 29 0a 20 20 20 20 20 20 20 20 20 keys)).
4450: 28 72 75 6e 2d 70 61 74 74 20 28 6f 72 20 28 61 (run-patt (or (a
4460: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
4470: 6e 2d 70 61 74 74 22 29 0a 09 09 20 20 20 20 20 n-patt")...
4480: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
4490: 22 2d 72 75 6e 6e 61 6d 65 22 29 0a 09 09 20 20 "-runname")...
44a0: 20 20 20 20 20 22 25 22 29 29 0a 20 20 20 20 20 "%")).
44b0: 20 20 20 20 28 74 61 72 67 65 74 20 28 6f 72 20 (target (or
44c0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
44d0: 2d 74 61 72 67 65 74 2d 70 61 74 74 22 29 20 0a -target-patt") .
44e0: 09 09 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 .. (args:ge
44f0: 74 2d 61 72 67 20 22 2d 74 61 72 67 65 74 22 29 t-arg "-target")
4500: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4510: 20 20 20 20 20 20 20 22 25 22 29 29 0a 20 20 20 "%")).
4520: 20 20 20 20 20 20 28 74 61 72 67 6c 69 73 74 20 (targlist
4530: 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 74 61 (string-split ta
4540: 72 67 65 74 20 22 2f 22 29 29 0a 20 20 20 20 20 rget "/")).
4550: 20 20 20 20 28 6e 75 6d 74 61 72 67 20 20 28 6c (numtarg (l
4560: 65 6e 67 74 68 20 74 61 72 67 6c 69 73 74 29 29 ength targlist))
4570: 20 20 0a 20 20 20 20 20 20 20 20 20 28 74 61 72 . (tar
4580: 67 74 77 65 61 6b 65 64 20 28 69 66 20 28 3e 20 gtweaked (if (>
4590: 6e 75 6d 6b 65 79 73 20 6e 75 6d 74 61 72 67 29 numkeys numtarg)
45a0: 0a 09 09 09 20 20 28 61 70 70 65 6e 64 20 74 61 .... (append ta
45b0: 72 67 6c 69 73 74 20 28 6d 61 6b 65 2d 6c 69 73 rglist (make-lis
45c0: 74 20 28 2d 20 6e 75 6d 6b 65 79 73 20 6e 75 6d t (- numkeys num
45d0: 74 61 72 67 29 20 22 25 22 29 29 0a 09 09 09 20 targ) "%"))....
45e0: 20 74 61 72 67 6c 69 73 74 29 29 0a 20 20 20 20 targlist)).
45f0: 20 20 20 20 20 28 74 61 72 67 65 74 2d 70 61 74 (target-pat
4600: 74 20 28 73 74 72 69 6e 67 2d 6a 6f 69 6e 20 74 t (string-join t
4610: 61 72 67 74 77 65 61 6b 65 64 20 22 2f 22 29 29 argtweaked "/"))
4620: 0a 09 09 09 09 09 3b 28 74 6f 74 61 6c 2d 72 75 ......;(total-ru
4630: 6e 73 20 20 28 72 6d 74 3a 67 65 74 2d 6e 75 6d ns (rmt:get-num
4640: 2d 72 75 6e 73 20 22 25 22 29 29 20 3b 3b 74 68 -runs "%")) ;;th
4650: 69 73 20 6e 65 65 64 73 20 74 6f 20 62 65 20 63 is needs to be c
4660: 68 61 6e 67 65 64 20 74 6f 20 66 69 6c 74 65 72 hanged to filter
4670: 20 62 79 20 74 61 72 67 65 74 0a 09 20 28 74 6f by target.. (to
4680: 74 61 6c 2d 72 75 6e 73 20 28 72 6d 74 3a 67 65 tal-runs (rmt:ge
4690: 74 2d 72 75 6e 73 2d 63 6e 74 2d 62 79 2d 70 61 t-runs-cnt-by-pa
46a0: 74 74 20 72 75 6e 2d 70 61 74 74 20 74 61 72 67 tt run-patt targ
46b0: 65 74 2d 70 61 74 74 20 6b 65 79 73 20 29 29 20 et-patt keys ))
46c0: 0a 20 20 20 20 20 20 20 20 20 28 70 67 2d 73 69 . (pg-si
46d0: 7a 65 20 31 30 29 29 0a 20 20 20 20 28 69 66 20 ze 10)). (if
46e0: 28 63 6f 6d 6d 6f 6e 3a 73 69 6d 70 6c 65 2d 66 (common:simple-f
46f0: 69 6c 65 2d 6c 6f 63 6b 20 6c 6f 63 6b 66 69 6c ile-lock lockfil
4700: 65 29 0a 20 20 20 20 20 20 20 20 28 62 65 67 69 e). (begi
4710: 6e 0a 09 09 09 09 09 3b 28 70 72 69 6e 74 20 74 n......;(print t
4720: 6f 74 61 6c 2d 72 75 6e 73 29 20 20 20 20 0a 09 otal-runs) ..
4730: 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 70 61 (let loop ((pa
4740: 67 65 20 30 29 29 0a 09 20 20 20 20 28 6c 65 74 ge 0)).. (let
4750: 2a 20 28 28 6f 75 70 20 20 20 20 20 20 20 20 20 * ((oup
4760: 20 20 20 28 6f 70 65 6e 2d 6f 75 74 70 75 74 2d (open-output-
4770: 66 69 6c 65 20 28 6f 72 20 6f 75 74 66 20 28 63 file (or outf (c
4780: 6f 6e 63 20 6c 69 6e 6b 74 72 65 65 20 22 2f 70 onc linktree "/p
4790: 61 67 65 22 20 70 61 67 65 20 22 2e 68 74 6d 6c age" page ".html
47a0: 22 29 29 29 29 0a 09 09 20 20 20 28 67 65 74 2d "))))... (get-
47b0: 70 72 65 76 2d 6c 69 6e 6b 73 20 28 6c 61 6d 62 prev-links (lamb
47c0: 64 61 20 28 70 61 67 65 20 6c 69 6e 6b 74 72 65 da (page linktre
47d0: 65 20 29 20 20 20 0a 09 09 09 09 20 20 20 20 20 e ) .....
47e0: 28 6c 65 74 2a 20 28 28 6c 69 6e 6b 20 20 28 69 (let* ((link (i
47f0: 66 20 28 6e 6f 74 20 28 65 71 3f 20 70 61 67 65 f (not (eq? page
4800: 20 30 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 0)).......
4810: 20 20 28 73 3a 61 20 22 26 6c 74 3b 26 6c 74 3b (s:a "<<
4820: 70 72 65 76 22 20 27 68 72 65 66 20 28 63 6f 6e prev" 'href (con
4830: 63 20 20 22 70 61 67 65 22 20 28 2d 20 70 61 67 c "page" (- pag
4840: 65 20 31 29 20 22 2e 68 74 6d 6c 22 29 29 0a 09 e 1) ".html"))..
4850: 09 09 09 09 09 20 20 20 20 20 20 20 28 73 3a 61 ..... (s:a
4860: 20 22 22 20 27 68 72 65 66 20 28 63 6f 6e 63 20 "" 'href (conc
4870: 20 20 22 70 61 67 65 22 20 20 70 61 67 65 20 22 "page" page "
4880: 2e 68 74 6d 6c 22 29 29 29 29 29 0a 09 09 09 09 .html"))))).....
4890: 20 20 20 20 20 20 20 6c 69 6e 6b 29 29 29 0a 09 link)))..
48a0: 09 20 20 20 28 67 65 74 2d 6e 65 78 74 2d 6c 69 . (get-next-li
48b0: 6e 6b 73 20 28 6c 61 6d 62 64 61 20 28 70 61 67 nks (lambda (pag
48c0: 65 20 6c 69 6e 6b 74 72 65 65 20 74 6f 74 61 6c e linktree total
48d0: 2d 72 75 6e 73 29 20 20 20 0a 09 09 09 09 20 20 -runs) .....
48e0: 20 20 20 28 6c 65 74 2a 20 28 28 6c 69 6e 6b 20 (let* ((link
48f0: 20 28 69 66 20 28 3e 20 74 6f 74 61 6c 2d 72 75 (if (> total-ru
4900: 6e 73 20 28 2b 20 31 30 20 28 2a 20 70 61 67 65 ns (+ 10 (* page
4910: 20 70 67 2d 73 69 7a 65 29 29 29 0a 09 09 09 09 pg-size))).....
4920: 09 09 20 20 20 20 20 20 20 28 73 3a 61 20 22 6e .. (s:a "n
4930: 65 78 74 26 67 74 3b 26 67 74 3b 22 20 27 68 72 ext>>" 'hr
4940: 65 66 20 28 63 6f 6e 63 20 20 22 70 61 67 65 22 ef (conc "page"
4950: 20 20 28 2b 20 70 61 67 65 20 31 29 20 22 2e 68 (+ page 1) ".h
4960: 74 6d 6c 22 29 29 0a 09 09 09 09 09 09 20 20 20 tml")).......
4970: 20 20 20 20 28 73 3a 61 20 22 22 20 27 68 72 65 (s:a "" 'hre
4980: 66 20 28 63 6f 6e 63 20 20 20 22 70 61 67 65 22 f (conc "page"
4990: 20 70 61 67 65 20 20 22 2e 68 74 6d 6c 22 29 29 page ".html"))
49a0: 29 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 6c )))..... l
49b0: 69 6e 6b 29 29 29 20 29 0a 09 20 20 20 20 20 20 ink))) )..
49c0: 28 70 72 69 6e 74 20 22 74 6f 74 61 6c 20 72 75 (print "total ru
49d0: 6e 73 3a 20 22 20 74 6f 74 61 6c 2d 72 75 6e 73 ns: " total-runs
49e0: 29 20 0a 09 20 20 20 20 20 20 28 73 3a 6f 75 74 ) .. (s:out
49f0: 70 75 74 2d 6e 65 77 0a 09 20 20 20 20 20 20 20 put-new..
4a00: 6f 75 70 0a 09 20 20 20 20 20 20 20 28 74 65 73 oup.. (tes
4a10: 74 73 3a 64 61 73 68 62 6f 61 72 64 2d 62 6f 64 ts:dashboard-bod
4a20: 79 20 70 61 67 65 20 70 67 2d 73 69 7a 65 20 6b y page pg-size k
4a30: 65 79 73 20 6e 75 6d 6b 65 79 73 20 74 6f 74 61 eys numkeys tota
4a40: 6c 2d 72 75 6e 73 20 6c 69 6e 6b 74 72 65 65 20 l-runs linktree
4a50: 61 72 65 61 2d 6e 61 6d 65 20 67 65 74 2d 70 72 area-name get-pr
4a60: 65 76 2d 6c 69 6e 6b 73 20 67 65 74 2d 6e 65 78 ev-links get-nex
4a70: 74 2d 6c 69 6e 6b 73 20 23 66 20 72 75 6e 2d 70 t-links #f run-p
4a80: 61 74 74 20 74 61 72 67 65 74 2d 70 61 74 74 29 att target-patt)
4a90: 29 20 3b 3b 20 75 70 64 61 74 65 20 74 68 69 73 ) ;; update this
4aa0: 20 66 75 6e 63 74 69 6f 6e 0a 09 20 20 20 20 20 function..
4ab0: 20 28 63 6c 6f 73 65 2d 6f 75 74 70 75 74 2d 70 (close-output-p
4ac0: 6f 72 74 20 6f 75 70 29 0a 09 09 09 09 09 3b 20 ort oup)......;
4ad0: 28 73 65 74 21 20 70 61 67 65 20 28 2b 20 31 20 (set! page (+ 1
4ae0: 70 61 67 65 29 29 0a 09 20 20 20 20 20 20 28 69 page)).. (i
4af0: 66 20 28 3e 20 74 6f 74 61 6c 2d 72 75 6e 73 20 f (> total-runs
4b00: 28 2a 20 28 2b 20 31 20 70 61 67 65 29 20 70 67 (* (+ 1 page) pg
4b10: 2d 73 69 7a 65 29 29 0a 09 09 20 20 28 6c 6f 6f -size))... (loo
4b20: 70 20 28 2b 20 31 20 20 70 61 67 65 29 29 29 29 p (+ 1 page))))
4b30: 29 0a 09 20 20 28 63 6f 6d 6d 6f 6e 3a 73 69 6d ).. (common:sim
4b40: 70 6c 65 2d 66 69 6c 65 2d 72 65 6c 65 61 73 65 ple-file-release
4b50: 2d 6c 6f 63 6b 20 6c 6f 63 6b 66 69 6c 65 29 29 -lock lockfile))
4b60: 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 65 62 ..(begin.. (deb
4b70: 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 ug:print 0 *defa
4b80: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 ult-log-port* "F
4b90: 61 69 6c 65 64 20 74 6f 20 67 65 74 20 6c 6f 63 ailed to get loc
4ba0: 6b 20 6f 6e 20 66 69 6c 65 20 6f 75 74 66 2c 20 k on file outf,
4bb0: 6c 6f 63 6b 66 69 6c 65 3a 20 22 20 6c 6f 63 6b lockfile: " lock
4bc0: 66 69 6c 65 29 20 23 66 29 29 29 29 0a 0a 0a 28 file) #f))))...(
4bd0: 64 65 66 69 6e 65 20 28 74 65 73 74 73 3a 72 65 define (tests:re
4be0: 61 64 6c 69 6e 65 73 20 66 69 6c 65 6e 61 6d 65 adlines filename
4bf0: 29 0a 20 20 28 63 61 6c 6c 2d 77 69 74 68 2d 69 ). (call-with-i
4c00: 6e 70 75 74 2d 66 69 6c 65 20 66 69 6c 65 6e 61 nput-file filena
4c10: 6d 65 0a 20 20 20 20 28 6c 61 6d 62 64 61 20 28 me. (lambda (
4c20: 70 29 0a 20 20 20 20 20 20 28 6c 65 74 20 6c 6f p). (let lo
4c30: 6f 70 20 28 28 6c 69 6e 65 20 28 72 65 61 64 2d op ((line (read-
4c40: 6c 69 6e 65 20 70 29 29 0a 20 20 20 20 20 20 20 line p)).
4c50: 20 20 20 20 20 20 20 20 20 20 28 72 65 73 75 6c (resul
4c60: 74 20 27 28 29 29 29 0a 20 20 20 20 20 20 20 20 t '())).
4c70: 28 69 66 20 28 65 6f 66 2d 6f 62 6a 65 63 74 3f (if (eof-object?
4c80: 20 6c 69 6e 65 29 0a 20 20 20 20 20 20 20 20 20 line).
4c90: 20 20 20 28 72 65 76 65 72 73 65 20 72 65 73 75 (reverse resu
4ca0: 6c 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 lt).
4cb0: 28 6c 6f 6f 70 20 28 72 65 61 64 2d 6c 69 6e 65 (loop (read-line
4cc0: 20 70 29 20 28 63 6f 6e 73 20 6c 69 6e 65 20 72 p) (cons line r
4cd0: 65 73 75 6c 74 29 29 29 29 29 29 29 0a 0a 28 64 esult)))))))..(d
4ce0: 65 66 69 6e 65 20 28 74 65 73 74 73 3a 67 65 74 efine (tests:get
4cf0: 2d 74 65 73 74 2d 6c 6f 67 20 72 75 6e 2d 69 64 -test-log run-id
4d00: 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d test-name item-
4d10: 6e 61 6d 65 29 0a 20 20 28 6c 65 74 2a 20 28 28 name). (let* ((
4d20: 74 65 73 74 2d 64 61 74 61 20 20 20 20 28 72 6d test-data (rm
4d30: 74 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d t:get-tests-for-
4d40: 72 75 6e 0a 09 09 09 09 20 20 20 28 73 74 72 69 run..... (stri
4d50: 6e 67 2d 3e 6e 75 6d 62 65 72 20 72 75 6e 2d 69 ng->number run-i
4d60: 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 d).
4d70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4d80: 20 20 20 20 20 20 20 74 65 73 74 2d 6e 61 6d 65 test-name
4d90: 20 20 20 20 20 20 3b 3b 20 74 65 73 74 6e 61 6d ;; testnam
4da0: 65 70 61 74 74 0a 09 09 09 09 20 20 20 27 28 29 epatt..... '()
4db0: 20 20 20 20 20 20 20 20 3b 3b 20 73 74 61 74 65 ;; state
4dc0: 73 0a 09 09 09 09 20 20 20 27 28 29 20 20 20 20 s..... '()
4dd0: 20 20 20 20 3b 3b 20 73 74 61 74 75 73 65 73 0a ;; statuses.
4de0: 09 09 09 09 20 20 20 23 66 20 20 20 20 20 20 20 .... #f
4df0: 20 20 3b 3b 20 6f 66 66 73 65 74 0a 09 09 09 09 ;; offset.....
4e00: 20 20 20 23 66 20 20 20 20 20 20 20 20 20 3b 3b #f ;;
4e10: 20 6e 75 6d 2d 74 6f 2d 67 65 74 0a 09 09 09 09 num-to-get.....
4e20: 20 20 20 23 66 20 20 20 20 20 20 20 20 20 3b 3b #f ;;
4e30: 20 68 69 64 65 2f 6e 6f 74 2d 68 69 64 65 0a 09 hide/not-hide..
4e40: 09 09 09 20 20 20 23 66 20 20 20 20 20 20 20 20 ... #f
4e50: 20 3b 3b 20 73 6f 72 74 2d 62 79 0a 09 09 09 09 ;; sort-by.....
4e60: 20 20 20 23 66 20 20 20 20 20 20 20 20 20 3b 3b #f ;;
4e70: 20 73 6f 72 74 2d 6f 72 64 65 72 0a 09 09 09 09 sort-order.....
4e80: 20 20 20 23 66 20 20 20 20 20 20 20 20 20 3b 3b #f ;;
4e90: 20 27 73 68 6f 72 74 6c 69 73 74 20 20 20 20 20 'shortlist
4ea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4eb0: 20 20 20 20 20 20 3b 3b 20 71 72 79 74 79 70 65 ;; qrytype
4ec0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4ed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4ee0: 20 20 20 20 30 20 20 20 20 20 20 20 20 20 3b 3b 0 ;;
4ef0: 20 6c 61 73 74 20 75 70 64 61 74 65 0a 09 09 09 last update....
4f00: 09 20 20 20 23 66 29 29 0a 20 20 20 20 20 20 20 . #f)).
4f10: 20 20 28 70 61 74 68 20 22 22 29 0a 20 20 20 20 (path "").
4f20: 20 20 20 20 20 28 66 6f 75 6e 64 20 30 29 29 0a (found 0)).
4f30: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
4f40: 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 -info 0 *default
4f50: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 66 6f 75 6e -log-port* "foun
4f60: 64 3a 20 22 20 66 6f 75 6e 64 20 29 0a 0a 20 20 d: " found )..
4f70: 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 (let loop ((hed
4f80: 20 28 63 61 72 20 74 65 73 74 2d 64 61 74 61 29 (car test-data)
4f90: 29 0a 09 09 20 28 74 61 6c 20 28 63 64 72 20 74 )... (tal (cdr t
4fa0: 65 73 74 2d 64 61 74 61 29 29 29 0a 20 20 20 20 est-data))).
4fb0: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
4fc0: 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 nt-info 0 *defau
4fd0: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 69 74 lt-log-port* "it
4fe0: 65 6d 3a 20 22 20 28 76 65 63 74 6f 72 2d 72 65 em: " (vector-re
4ff0: 66 20 68 65 64 20 31 31 29 20 28 76 65 63 74 6f f hed 11) (vecto
5000: 72 2d 72 65 66 20 68 65 64 20 31 30 29 20 22 2f r-ref hed 10) "/
5010: 22 20 28 76 65 63 74 6f 72 2d 72 65 66 20 68 65 " (vector-ref he
5020: 64 20 31 33 29 29 0a 0a 09 28 69 66 20 28 65 71 d 13))...(if (eq
5030: 75 61 6c 3f 20 28 76 65 63 74 6f 72 2d 72 65 66 ual? (vector-ref
5040: 20 68 65 64 20 31 31 29 20 69 74 65 6d 2d 6e 61 hed 11) item-na
5050: 6d 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 me).
5060: 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 (begin.
5070: 20 20 20 20 20 28 73 65 74 21 20 66 6f 75 6e 64 (set! found
5080: 20 31 29 20 0a 09 20 20 20 20 20 20 28 73 65 74 1) .. (set
5090: 21 20 70 61 74 68 20 28 63 6f 6e 63 20 28 76 65 ! path (conc (ve
50a0: 63 74 6f 72 2d 72 65 66 20 68 65 64 20 31 30 29 ctor-ref hed 10)
50b0: 20 22 2f 22 20 28 76 65 63 74 6f 72 2d 72 65 66 "/" (vector-ref
50c0: 20 68 65 64 20 31 33 29 29 29 29 29 0a 09 20 20 hed 13)))))..
50d0: 20 20 28 69 66 20 28 61 6e 64 20 28 6e 6f 74 20 (if (and (not
50e0: 28 6e 75 6c 6c 3f 20 74 61 6c 29 29 20 28 65 71 (null? tal)) (eq
50f0: 75 61 6c 3f 20 66 6f 75 6e 64 20 30 29 29 0a 09 ual? found 0))..
5100: 09 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 .(loop (car tal)
5110: 28 63 64 72 20 74 61 6c 29 29 29 29 0a 20 20 20 (cdr tal)))).
5120: 28 69 66 20 28 65 71 75 61 6c 3f 20 70 61 74 68 (if (equal? path
5130: 20 22 22 29 0a 20 20 20 20 20 22 3c 48 32 3e 44 ""). "<H2>D
5140: 61 74 61 20 6e 6f 74 20 66 6f 75 6e 64 3c 2f 48 ata not found</H
5150: 32 3e 22 0a 20 20 20 20 20 28 73 74 72 69 6e 67 2>". (string
5160: 2d 6a 6f 69 6e 20 28 74 65 73 74 73 3a 72 65 61 -join (tests:rea
5170: 64 6c 69 6e 65 73 20 70 61 74 68 29 20 22 5c 6e dlines path) "\n
5180: 22 29 29 29 29 0a 0a 0a 28 64 65 66 69 6e 65 20 "))))...(define
5190: 28 74 65 73 74 73 3a 64 79 6e 61 6d 69 63 2d 64 (tests:dynamic-d
51a0: 62 6f 61 72 64 20 70 61 67 65 29 0a 3b 28 64 65 board page).;(de
51b0: 66 69 6e 65 20 28 74 65 73 74 73 3a 63 72 65 61 fine (tests:crea
51c0: 74 65 2d 68 74 6d 6c 2d 74 72 65 65 20 6f 29 0a te-html-tree o).
51d0: 20 28 6c 65 74 2a 20 28 0a 3b 28 70 61 67 65 20 (let* (.;(page
51e0: 22 31 22 29 0a 20 20 20 20 20 20 20 20 20 20 28 "1"). (
51f0: 6c 69 6e 6b 74 72 65 65 20 20 28 63 6f 6d 6d 6f linktree (commo
5200: 6e 3a 67 65 74 2d 6c 69 6e 6b 74 72 65 65 29 29 n:get-linktree))
5210: 0a 20 20 20 20 20 20 20 20 20 28 61 72 65 61 2d . (area-
5220: 6e 61 6d 65 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 name (common:get
5230: 2d 74 65 73 74 73 75 69 74 65 2d 6e 61 6d 65 29 -testsuite-name)
5240: 29 0a 09 20 20 20 20 20 20 20 28 6b 65 79 73 20 ).. (keys
5250: 20 20 20 20 20 28 72 6d 74 3a 67 65 74 2d 6b 65 (rmt:get-ke
5260: 79 73 29 29 0a 09 20 20 20 20 20 20 20 28 6e 75 ys)).. (nu
5270: 6d 6b 65 79 73 20 20 20 28 6c 65 6e 67 74 68 20 mkeys (length
5280: 6b 65 79 73 29 29 0a 20 20 20 20 20 20 20 20 20 keys)).
5290: 28 74 61 72 67 74 77 65 61 6b 65 64 20 28 6d 61 (targtweaked (ma
52a0: 6b 65 2d 6c 69 73 74 20 6e 75 6d 6b 65 79 73 20 ke-list numkeys
52b0: 22 25 22 29 29 0a 20 20 20 20 20 20 20 20 20 28 "%")). (
52c0: 74 61 72 67 65 74 2d 70 61 74 74 20 28 73 74 72 target-patt (str
52d0: 69 6e 67 2d 6a 6f 69 6e 20 74 61 72 67 74 77 65 ing-join targtwe
52e0: 61 6b 65 64 20 22 2f 22 29 29 0a 20 20 20 20 20 aked "/")).
52f0: 20 20 20 20 28 74 6f 74 61 6c 2d 72 75 6e 73 20 (total-runs
5300: 20 28 72 6d 74 3a 67 65 74 2d 6e 75 6d 2d 72 75 (rmt:get-num-ru
5310: 6e 73 20 22 25 22 29 29 0a 20 20 20 20 20 20 20 ns "%")).
5320: 20 20 28 70 67 2d 73 69 7a 65 20 31 30 29 0a 20 (pg-size 10).
5330: 20 20 20 20 20 20 20 20 28 70 67 20 28 69 66 20 (pg (if
5340: 28 65 71 75 61 6c 3f 20 70 61 67 65 20 23 66 29 (equal? page #f)
5350: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5360: 20 20 30 0a 20 20 20 20 20 20 20 20 20 20 20 20 0.
5370: 20 20 20 20 20 28 2d 20 28 73 74 72 69 6e 67 2d (- (string-
5380: 3e 6e 75 6d 62 65 72 20 70 61 67 65 29 20 31 29 >number page) 1)
5390: 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 67 65 )). (ge
53a0: 74 2d 70 72 65 76 2d 6c 69 6e 6b 73 20 20 28 6c t-prev-links (l
53b0: 61 6d 62 64 61 20 28 70 67 20 6c 69 6e 6b 74 72 ambda (pg linktr
53c0: 65 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ee).
53d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
53e0: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
53f0: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
5400: 70 6f 72 74 2a 20 22 76 61 6c 3a 20 22 20 28 2d port* "val: " (-
5410: 20 31 20 70 67 29 29 0a 20 20 20 20 20 20 20 20 1 pg)).
5420: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5430: 20 20 28 6c 65 74 2a 20 28 28 6c 69 6e 6b 20 20 (let* ((link
5440: 28 69 66 20 28 6e 6f 74 20 28 65 71 3f 20 70 67 (if (not (eq? pg
5450: 20 30 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 0)).
5460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5470: 20 20 20 20 28 73 3a 61 20 20 22 26 6c 74 3b 26 (s:a "<&
5480: 6c 74 3b 70 72 65 76 20 22 20 27 68 72 65 66 20 lt;prev " 'href
5490: 28 63 6f 6e 63 20 20 22 64 61 73 68 62 6f 61 72 (conc "dashboar
54a0: 64 3f 70 61 67 65 3d 22 20 20 70 67 20 20 29 29 d?page=" pg ))
54b0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
54c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
54d0: 28 73 3a 61 20 22 22 20 27 68 72 65 66 20 28 63 (s:a "" 'href (c
54e0: 6f 6e 63 20 20 22 64 61 73 68 62 6f 61 72 64 3f onc "dashboard?
54f0: 70 61 67 65 3d 22 20 70 67 29 29 29 29 29 0a 20 page=" pg))))).
5500: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5510: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6c 69 li
5520: 6e 6b 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 nk))).
5530: 28 67 65 74 2d 6e 65 78 74 2d 6c 69 6e 6b 73 20 (get-next-links
5540: 20 20 28 6c 61 6d 62 64 61 20 28 70 67 20 6c 69 (lambda (pg li
5550: 6e 6b 74 72 65 65 20 74 6f 74 61 6c 2d 72 75 6e nktree total-run
5560: 73 29 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 s) .
5570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5580: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
5590: 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f fo 0 *default-lo
55a0: 67 2d 70 6f 72 74 2a 20 22 76 61 6c 3a 20 22 20 g-port* "val: "
55b0: 70 67 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 pg).
55c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
55d0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
55e0: 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f fo 0 *default-lo
55f0: 67 2d 70 6f 72 74 2a 20 22 76 61 6c 3a 20 22 20 g-port* "val: "
5600: 74 6f 74 61 6c 2d 72 75 6e 73 20 22 20 73 69 7a total-runs " siz
5610: 65 22 20 70 67 2d 73 69 7a 65 29 0a 20 0a 20 20 e" pg-size). .
5620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5630: 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 2a 20 (let*
5640: 28 28 6c 69 6e 6b 20 20 28 69 66 20 28 3e 20 74 ((link (if (> t
5650: 6f 74 61 6c 2d 72 75 6e 73 20 28 2b 20 31 30 20 otal-runs (+ 10
5660: 28 2a 20 70 67 20 70 67 2d 73 69 7a 65 29 29 29 (* pg pg-size)))
5670: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5680: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
5690: 73 3a 61 20 20 22 6e 65 78 74 26 67 74 3b 26 67 s:a "next>&g
56a0: 74 3b 20 22 20 20 27 68 72 65 66 20 28 63 6f 6e t; " 'href (con
56b0: 63 20 20 22 64 61 73 68 62 6f 61 72 64 3f 70 61 c "dashboard?pa
56c0: 67 65 3d 22 20 20 28 2b 20 70 67 20 32 29 20 20 ge=" (+ pg 2)
56d0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
56e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
56f0: 28 73 3a 61 20 22 22 20 27 68 72 65 66 20 28 63 (s:a "" 'href (c
5700: 6f 6e 63 20 20 22 64 61 73 68 62 6f 61 72 64 3f onc "dashboard?
5710: 70 61 67 65 3d 22 20 70 67 20 20 29 29 29 29 29 page=" pg )))))
5720: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5730: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6c 69 li
5740: 6e 6b 29 29 29 0a 20 20 20 20 20 20 20 20 20 28 nk))). (
5750: 68 74 6d 6c 2d 62 6f 64 79 20 28 74 65 73 74 73 html-body (tests
5760: 3a 64 61 73 68 62 6f 61 72 64 2d 62 6f 64 79 20 :dashboard-body
5770: 70 67 20 70 67 2d 73 69 7a 65 20 6b 65 79 73 20 pg pg-size keys
5780: 6e 75 6d 6b 65 79 73 20 74 6f 74 61 6c 2d 72 75 numkeys total-ru
5790: 6e 73 20 6c 69 6e 6b 74 72 65 65 20 61 72 65 61 ns linktree area
57a0: 2d 6e 61 6d 65 20 67 65 74 2d 70 72 65 76 2d 6c -name get-prev-l
57b0: 69 6e 6b 73 20 67 65 74 2d 6e 65 78 74 2d 6c 69 inks get-next-li
57c0: 6e 6b 73 20 23 74 20 22 25 22 20 74 61 72 67 65 nks #t "%" targe
57d0: 74 2d 70 61 74 74 29 29 29 20 3b 3b 20 75 70 64 t-patt))) ;; upd
57e0: 61 74 65 20 74 69 73 20 66 75 6e 63 74 69 6f 6e ate tis function
57f0: 0a 20 20 20 20 20 20 20 20 68 74 6d 6c 2d 62 6f . html-bo
5800: 64 79 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 dy))..(define (t
5810: 65 73 74 73 3a 63 72 65 61 74 65 2d 68 74 6d 6c ests:create-html
5820: 2d 73 75 6d 6d 61 72 79 20 6f 75 74 66 29 0a 20 -summary outf).
5830: 28 6c 65 74 2a 20 28 28 6c 6f 63 6b 66 69 6c 65 (let* ((lockfile
5840: 20 20 28 63 6f 6e 63 20 6f 75 74 66 20 22 2e 6c (conc outf ".l
5850: 6f 63 6b 22 29 29 0a 20 20 20 20 20 20 20 20 28 ock")). (
5860: 6c 69 6e 6b 74 72 65 65 20 20 28 63 6f 6d 6d 6f linktree (commo
5870: 6e 3a 67 65 74 2d 6c 69 6e 6b 74 72 65 65 29 29 n:get-linktree))
5880: 0a 09 09 09 09 28 6b 65 79 73 20 20 20 20 20 20 .....(keys
5890: 28 72 6d 74 3a 67 65 74 2d 6b 65 79 73 29 29 0a (rmt:get-keys)).
58a0: 20 20 20 20 20 20 20 20 28 61 72 65 61 2d 6e 61 (area-na
58b0: 6d 65 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 74 me (common:get-t
58c0: 65 73 74 73 75 69 74 65 2d 6e 61 6d 65 29 29 0a estsuite-name)).
58d0: 20 20 20 20 20 20 20 20 28 72 75 6e 2d 70 61 74 (run-pat
58e0: 74 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d t (or (args:get-
58f0: 61 72 67 20 22 2d 72 75 6e 2d 70 61 74 74 22 29 arg "-run-patt")
5900: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5910: 20 20 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 (args:g
5920: 65 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 6d 65 et-arg "-runname
5930: 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ").
5940: 20 20 20 20 20 20 20 20 20 20 20 22 25 22 29 29 "%"))
5950: 0a 20 20 20 20 20 20 20 20 28 74 61 72 67 65 74 . (target
5960: 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 (or (args:get-a
5970: 72 67 20 22 2d 74 61 72 67 65 74 2d 70 61 74 74 rg "-target-patt
5980: 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ").
5990: 20 20 20 20 20 20 20 20 20 20 20 28 61 72 67 73 (args
59a0: 3a 67 65 74 2d 61 72 67 20 22 2d 74 61 72 67 65 :get-arg "-targe
59b0: 74 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 t").
59c0: 20 20 20 20 20 20 20 20 20 20 20 20 22 25 22 29 "%")
59d0: 29 0a 20 20 20 20 20 20 20 20 20 28 74 61 72 67 ). (targ
59e0: 6c 69 73 74 20 28 73 74 72 69 6e 67 2d 73 70 6c list (string-spl
59f0: 69 74 20 74 61 72 67 65 74 20 22 2f 22 29 29 0a it target "/")).
5a00: 20 20 20 20 20 20 20 20 20 28 6e 75 6d 6b 65 79 (numkey
5a10: 73 20 20 28 6c 65 6e 67 74 68 20 6b 65 79 73 29 s (length keys)
5a20: 29 0a 09 20 20 20 20 20 20 20 28 6e 75 6d 74 61 ).. (numta
5a30: 72 67 20 20 28 6c 65 6e 67 74 68 20 74 61 72 67 rg (length targ
5a40: 6c 69 73 74 29 29 20 20 0a 20 20 20 20 20 20 20 list)) .
5a50: 20 20 28 74 61 72 67 74 77 65 61 6b 65 64 20 28 (targtweaked (
5a60: 69 66 20 28 3e 20 6e 75 6d 6b 65 79 73 20 6e 75 if (> numkeys nu
5a70: 6d 74 61 72 67 29 0a 09 09 09 20 20 20 09 09 09 mtarg).... ...
5a80: 09 09 09 09 09 28 61 70 70 65 6e 64 20 74 61 72 .....(append tar
5a90: 67 6c 69 73 74 20 28 6d 61 6b 65 2d 6c 69 73 74 glist (make-list
5aa0: 20 28 2d 20 6e 75 6d 6b 65 79 73 20 6e 75 6d 74 (- numkeys numt
5ab0: 61 72 67 29 20 22 25 22 29 29 0a 09 09 09 20 20 arg) "%"))....
5ac0: 09 09 09 09 09 09 09 09 74 61 72 67 6c 69 73 74 ........targlist
5ad0: 29 29 0a 20 20 20 20 20 20 20 20 28 74 61 72 67 )). (targ
5ae0: 65 74 2d 70 61 74 74 20 28 73 74 72 69 6e 67 2d et-patt (string-
5af0: 6a 6f 69 6e 20 74 61 72 67 74 77 65 61 6b 65 64 join targtweaked
5b00: 20 22 2f 22 29 29 29 0a 20 20 20 20 28 69 66 20 "/"))). (if
5b10: 28 63 6f 6d 6d 6f 6e 3a 73 69 6d 70 6c 65 2d 66 (common:simple-f
5b20: 69 6c 65 2d 6c 6f 63 6b 20 6c 6f 63 6b 66 69 6c ile-lock lockfil
5b30: 65 29 0a 20 20 20 20 20 20 20 20 28 62 65 67 69 e). (begi
5b40: 6e 0a 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 n. (let
5b50: 2a 20 28 3b 28 72 75 6e 73 64 61 74 31 20 20 20 * (;(runsdat1
5b60: 28 72 6d 74 3a 67 65 74 2d 72 75 6e 73 20 72 75 (rmt:get-runs ru
5b70: 6e 2d 70 61 74 74 20 23 66 20 23 66 20 28 6d 61 n-patt #f #f (ma
5b80: 70 20 28 6c 61 6d 62 64 61 20 28 78 29 28 6c 69 p (lambda (x)(li
5b90: 73 74 20 78 20 22 25 22 29 29 20 6b 65 79 73 29 st x "%")) keys)
5ba0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
5bb0: 20 20 20 20 28 72 75 6e 73 64 61 74 20 20 20 28 (runsdat (
5bc0: 72 6d 74 3a 67 65 74 2d 72 75 6e 73 2d 62 79 2d rmt:get-runs-by-
5bd0: 70 61 74 74 20 20 6b 65 79 73 20 72 75 6e 2d 70 patt keys run-p
5be0: 61 74 74 20 74 61 72 67 65 74 2d 70 61 74 74 20 att target-patt
5bf0: 23 66 20 23 66 20 23 66 20 30 29 29 0a 09 09 09 #f #f #f 0))....
5c00: 09 09 20 20 20 20 20 20 20 28 72 75 6e 73 20 20 .. (runs
5c10: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (vector-ref
5c20: 72 75 6e 73 64 61 74 20 31 29 29 0a 20 20 20 20 runsdat 1)).
5c30: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 68 65 (he
5c40: 61 64 65 72 20 20 20 20 20 20 28 76 65 63 74 6f ader (vecto
5c50: 72 2d 72 65 66 20 72 75 6e 73 64 61 74 20 30 29 r-ref runsdat 0)
5c60: 29 0a 20 20 20 20 20 20 20 20 09 20 20 20 20 20 ). .
5c70: 20 20 28 6f 75 70 20 20 20 20 20 20 20 28 6f 70 (oup (op
5c80: 65 6e 2d 6f 75 74 70 75 74 2d 66 69 6c 65 20 28 en-output-file (
5c90: 6f 72 20 6f 75 74 66 20 28 63 6f 6e 63 20 6c 69 or outf (conc li
5ca0: 6e 6b 74 72 65 65 20 22 2f 74 61 72 67 65 74 73 nktree "/targets
5cb0: 2e 68 74 6d 6c 22 29 29 29 29 0a 20 20 20 20 20 .html")))).
5cc0: 20 20 20 20 20 20 20 20 20 20 20 20 28 74 61 72 (tar
5cd0: 67 65 74 2d 68 61 73 68 20 28 74 65 73 74 3a 63 get-hash (test:c
5ce0: 72 65 61 74 65 2d 74 61 72 67 65 74 2d 68 61 73 reate-target-has
5cf0: 68 20 72 75 6e 73 20 68 65 61 64 65 72 20 28 6c h runs header (l
5d00: 65 6e 67 74 68 20 6b 65 79 73 29 29 29 29 0a 20 ength keys)))).
5d10: 20 20 20 20 20 20 20 20 20 20 28 74 65 73 74 3a (test:
5d20: 63 72 65 61 74 65 2d 74 61 72 67 65 74 2d 68 74 create-target-ht
5d30: 6d 6c 20 74 61 72 67 65 74 2d 68 61 73 68 20 6f ml target-hash o
5d40: 75 70 20 61 72 65 61 2d 6e 61 6d 65 20 6c 69 6e up area-name lin
5d50: 6b 74 72 65 65 29 0a 20 20 20 20 20 20 20 20 20 ktree).
5d60: 20 28 74 65 73 74 3a 63 72 65 61 74 65 2d 72 75 (test:create-ru
5d70: 6e 2d 68 74 6d 6c 20 20 72 75 6e 73 20 61 72 65 n-html runs are
5d80: 61 2d 6e 61 6d 65 20 6c 69 6e 6b 74 72 65 65 20 a-name linktree
5d90: 28 6c 65 6e 67 74 68 20 6b 65 79 73 29 20 68 65 (length keys) he
5da0: 61 64 65 72 29 29 0a 09 20 20 28 63 6f 6d 6d 6f ader)).. (commo
5db0: 6e 3a 73 69 6d 70 6c 65 2d 66 69 6c 65 2d 72 65 n:simple-file-re
5dc0: 6c 65 61 73 65 2d 6c 6f 63 6b 20 6c 6f 63 6b 66 lease-lock lockf
5dd0: 69 6c 65 29 29 0a 09 23 66 29 29 29 0a 0a 28 64 ile))..#f)))..(d
5de0: 65 66 69 6e 65 20 28 74 65 73 74 3a 67 65 74 2d efine (test:get-
5df0: 74 65 73 74 2d 68 61 73 68 20 74 65 73 74 2d 64 test-hash test-d
5e00: 61 74 61 29 0a 09 28 6c 65 74 20 28 28 72 65 73 ata)..(let ((res
5e10: 68 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 h (make-hash-tab
5e20: 6c 65 29 29 29 0a 20 20 20 20 09 28 6d 61 70 20 le))). .(map
5e30: 28 6c 61 6d 62 64 61 20 28 74 65 73 74 29 0a 20 (lambda (test).
5e40: 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 74 (let* ((t
5e50: 65 73 74 2d 6e 61 6d 65 20 28 76 65 63 74 6f 72 est-name (vector
5e60: 2d 72 65 66 20 74 65 73 74 20 32 29 29 0a 20 20 -ref test 2)).
5e70: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 74 65 (te
5e80: 73 74 2d 68 74 6d 6c 2d 70 61 74 68 20 28 69 66 st-html-path (if
5e90: 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 28 (file-exists? (
5ea0: 63 6f 6e 63 20 28 76 65 63 74 6f 72 2d 72 65 66 conc (vector-ref
5eb0: 20 74 65 73 74 20 31 30 29 20 22 2f 74 65 73 74 test 10) "/test
5ec0: 2d 73 75 6d 6d 61 72 79 2e 68 74 6d 6c 22 29 29 -summary.html"))
5ed0: 0a 09 09 09 09 09 09 09 09 09 09 09 09 09 09 09 ................
5ee0: 09 20 28 63 6f 6e 63 20 28 76 65 63 74 6f 72 2d . (conc (vector-
5ef0: 72 65 66 20 74 65 73 74 20 31 30 29 20 22 2f 74 ref test 10) "/t
5f00: 65 73 74 2d 73 75 6d 6d 61 72 79 2e 68 74 6d 6c est-summary.html
5f10: 22 20 29 0a 09 09 09 09 09 09 09 20 09 09 09 09 " )........ ....
5f20: 09 09 09 09 09 20 28 63 6f 6e 63 20 28 76 65 63 ..... (conc (vec
5f30: 74 6f 72 2d 72 65 66 20 74 65 73 74 20 31 30 29 tor-ref test 10)
5f40: 20 22 2f 22 20 28 76 65 63 74 6f 72 2d 72 65 66 "/" (vector-ref
5f50: 20 74 65 73 74 20 31 33 29 29 29 29 0a 20 20 20 test 13)))).
5f60: 20 20 20 20 20 20 20 20 20 20 20 20 28 74 65 73 (tes
5f70: 74 2d 69 74 65 6d 20 20 28 76 65 63 74 6f 72 2d t-item (vector-
5f80: 72 65 66 20 74 65 73 74 20 31 31 29 29 0a 20 20 ref test 11)).
5f90: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 74 65 (te
5fa0: 73 74 2d 73 74 61 74 75 73 20 28 76 65 63 74 6f st-status (vecto
5fb0: 72 2d 72 65 66 20 74 65 73 74 20 34 29 29 29 0a r-ref test 4))).
5fc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
5fd0: 69 66 20 28 6e 6f 74 20 28 68 61 73 68 2d 74 61 if (not (hash-ta
5fe0: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
5ff0: 72 65 73 68 20 74 65 73 74 2d 69 74 65 6d 20 20 resh test-item
6000: 23 66 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 #f)).
6010: 20 20 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 (hash-ta
6020: 62 6c 65 2d 73 65 74 21 20 72 65 73 68 20 74 65 ble-set! resh te
6030: 73 74 2d 69 74 65 6d 20 20 20 28 6d 61 6b 65 2d st-item (make-
6040: 68 61 73 68 2d 74 61 62 6c 65 29 29 29 0a 20 20 hash-table))).
6050: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 68 61 (ha
6060: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 28 68 sh-table-set! (h
6070: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
6080: 66 61 75 6c 74 20 72 65 73 68 20 74 65 73 74 2d fault resh test-
6090: 69 74 65 6d 20 20 23 66 29 20 74 65 73 74 2d 6e item #f) test-n
60a0: 61 6d 65 20 28 6c 69 73 74 20 74 65 73 74 2d 73 ame (list test-s
60b0: 74 61 74 75 73 20 74 65 73 74 2d 68 74 6d 6c 2d tatus test-html-
60c0: 70 61 74 68 29 29 29 29 20 0a 20 20 20 20 20 20 path)))) .
60d0: 20 20 74 65 73 74 2d 64 61 74 61 29 0a 72 65 73 test-data).res
60e0: 68 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 65 h))..(define (te
60f0: 73 74 3a 67 65 74 2d 64 61 74 61 2d 3e 62 2d 6b st:get-data->b-k
6100: 65 79 73 20 6f 72 64 65 72 65 64 2d 64 61 74 61 eys ordered-data
6110: 20 61 2d 6b 65 79 73 29 0a 20 20 28 64 65 6c 65 a-keys). (dele
6120: 74 65 2d 64 75 70 6c 69 63 61 74 65 73 0a 20 20 te-duplicates.
6130: 20 28 73 6f 72 74 20 28 61 70 70 6c 79 0a 09 20 (sort (apply..
6140: 20 61 70 70 65 6e 64 0a 09 20 20 28 6d 61 70 20 append.. (map
6150: 28 6c 61 6d 62 64 61 20 28 73 75 62 2d 6b 65 79 (lambda (sub-key
6160: 29 0a 09 09 20 28 6c 65 74 20 28 28 73 75 62 64 )... (let ((subd
6170: 61 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 at (hash-table-r
6180: 65 66 20 6f 72 64 65 72 65 64 2d 64 61 74 61 20 ef ordered-data
6190: 73 75 62 2d 6b 65 79 29 29 29 0a 09 09 20 20 20 sub-key)))...
61a0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 (hash-table-keys
61b0: 20 73 75 62 64 61 74 29 29 29 0a 09 20 20 20 20 subdat)))..
61c0: 20 20 20 61 2d 6b 65 79 73 29 29 0a 09 20 73 74 a-keys)).. st
61d0: 72 69 6e 67 3e 3d 3f 29 29 29 0a 0a 0a 28 64 65 ring>=?)))...(de
61e0: 66 69 6e 65 20 28 74 65 73 74 3a 63 72 65 61 74 fine (test:creat
61f0: 65 2d 72 75 6e 2d 68 74 6d 6c 20 72 75 6e 73 20 e-run-html runs
6200: 61 72 65 61 2d 6e 61 6d 65 20 6c 69 6e 6b 74 72 area-name linktr
6210: 65 65 20 6e 75 6d 6b 65 79 73 20 68 65 61 64 65 ee numkeys heade
6220: 72 29 0a 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 r). (map (lambd
6230: 61 20 28 72 75 6e 29 0a 09 09 20 28 6c 65 74 2a a (run)... (let*
6240: 20 28 28 74 61 72 67 65 74 20 28 73 74 72 69 6e ((target (strin
6250: 67 2d 6a 6f 69 6e 20 28 74 61 6b 65 20 28 76 65 g-join (take (ve
6260: 63 74 6f 72 2d 3e 6c 69 73 74 20 72 75 6e 29 20 ctor->list run)
6270: 6e 75 6d 6b 65 79 73 29 20 22 2f 22 29 29 0a 09 numkeys) "/"))..
6280: 09 09 09 09 09 28 72 75 6e 2d 6e 61 6d 65 20 28 .....(run-name (
6290: 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d db:get-value-by-
62a0: 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 header run heade
62b0: 72 20 22 72 75 6e 6e 61 6d 65 22 29 29 0a 20 20 r "runname")).
62c0: 20 20 20 20 20 20 20 20 20 20 28 72 75 6e 2d 74 (run-t
62d0: 69 6d 65 20 28 73 65 63 6f 6e 64 73 2d 3e 77 6f ime (seconds->wo
62e0: 72 6b 2d 77 65 65 6b 2f 64 61 79 2d 74 69 6d 65 rk-week/day-time
62f0: 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 (db:get-value-b
6300: 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 y-header run hea
6310: 64 65 72 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 der "event_time"
6320: 29 29 29 0a 09 09 09 09 09 09 28 6f 75 70 20 28 ))).......(oup (
6330: 69 66 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f if (file-exists?
6340: 20 28 63 6f 6e 63 20 6c 69 6e 6b 74 72 65 65 20 (conc linktree
6350: 22 2f 22 20 74 61 72 67 65 74 20 22 2f 22 20 72 "/" target "/" r
6360: 75 6e 2d 6e 61 6d 65 29 29 0a 20 20 20 20 20 20 un-name)).
6370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6380: 20 20 28 6f 70 65 6e 2d 6f 75 74 70 75 74 2d 66 (open-output-f
6390: 69 6c 65 20 28 63 6f 6e 63 20 6c 69 6e 6b 74 72 ile (conc linktr
63a0: 65 65 20 22 2f 22 20 74 61 72 67 65 74 20 22 2f ee "/" target "/
63b0: 22 20 72 75 6e 2d 6e 61 6d 65 20 22 2f 72 75 6e " run-name "/run
63c0: 2e 68 74 6d 6c 22 29 29 0a 20 20 20 20 20 20 20 .html")).
63d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
63e0: 20 20 23 66 29 29 0a 20 20 20 20 20 20 20 20 20 #f)).
63f0: 20 20 20 28 72 75 6e 2d 69 64 20 28 64 62 3a 67 (run-id (db:g
6400: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 et-value-by-head
6410: 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 22 69 er run header "i
6420: 64 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 d")).
6430: 20 28 74 65 73 74 2d 64 61 74 61 20 20 20 20 28 (test-data (
6440: 72 6d 74 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f rmt:get-tests-fo
6450: 72 2d 72 75 6e 0a 09 09 09 09 20 20 09 09 09 09 r-run..... ....
6460: 09 09 09 09 20 72 75 6e 2d 69 64 0a 20 20 20 20 .... run-id.
6470: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6480: 20 20 20 20 20 20 20 22 25 22 20 20 20 20 20 20 "%"
6490: 20 3b 3b 20 74 65 73 74 6e 61 6d 65 70 61 74 74 ;; testnamepatt
64a0: 0a 09 09 09 09 20 20 09 09 09 09 09 09 09 09 20 ..... ........
64b0: 27 28 29 20 20 20 20 20 20 20 20 3b 3b 20 73 74 '() ;; st
64c0: 61 74 65 73 0a 09 09 09 09 20 20 20 09 09 09 09 ates..... ....
64d0: 09 09 09 09 20 27 28 29 20 20 20 20 20 20 20 20 .... '()
64e0: 3b 3b 20 73 74 61 74 75 73 65 73 0a 09 09 09 09 ;; statuses.....
64f0: 20 20 09 09 09 09 09 09 09 09 20 09 23 66 20 20 ........ .#f
6500: 20 20 20 20 20 20 20 3b 3b 20 6f 66 66 73 65 74 ;; offset
6510: 0a 09 09 09 09 20 20 09 09 09 09 09 09 20 09 09 ..... ...... ..
6520: 09 23 66 20 20 20 20 20 20 20 20 20 3b 3b 20 6e .#f ;; n
6530: 75 6d 2d 74 6f 2d 67 65 74 0a 09 09 09 09 20 20 um-to-get.....
6540: 20 09 09 09 09 09 09 09 09 09 23 66 20 20 20 20 .........#f
6550: 20 20 20 20 20 3b 3b 20 68 69 64 65 2f 6e 6f 74 ;; hide/not
6560: 2d 68 69 64 65 0a 09 09 09 09 20 20 09 09 09 09 -hide..... ....
6570: 09 09 09 09 20 20 23 66 20 20 20 20 20 20 20 20 .... #f
6580: 20 3b 3b 20 73 6f 72 74 2d 62 79 0a 09 09 09 09 ;; sort-by.....
6590: 20 20 20 09 09 09 09 09 09 09 09 09 23 66 20 20 .........#f
65a0: 20 20 20 20 20 20 20 3b 3b 20 73 6f 72 74 2d 6f ;; sort-o
65b0: 72 64 65 72 0a 09 09 09 09 20 20 20 09 09 09 09 rder..... ....
65c0: 09 09 09 09 09 23 66 20 20 20 20 20 20 20 20 20 .....#f
65d0: 3b 3b 20 27 73 68 6f 72 74 6c 69 73 74 20 20 20 ;; 'shortlist
65e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
65f0: 20 20 20 20 20 20 20 20 3b 3b 20 71 72 79 74 79 ;; qryty
6600: 70 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 pe.
6610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 30 0
6620: 20 20 20 20 20 20 20 20 20 3b 3b 20 6c 61 73 74 ;; last
6630: 20 75 70 64 61 74 65 0a 09 09 09 09 20 20 09 09 update..... ..
6640: 09 09 09 09 09 09 09 23 66 29 29 0a 20 20 20 20 .......#f)).
6650: 20 20 20 20 20 20 20 20 28 69 74 65 6d 2d 74 65 (item-te
6660: 73 74 2d 68 61 73 68 20 28 74 65 73 74 3a 67 65 st-hash (test:ge
6670: 74 2d 74 65 73 74 2d 68 61 73 68 20 74 65 73 74 t-test-hash test
6680: 2d 64 61 74 61 29 29 0a 20 20 20 20 20 20 20 20 -data)).
6690: 20 20 20 20 28 69 74 65 6d 73 20 20 28 68 61 73 (items (has
66a0: 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 69 74 65 h-table-keys ite
66b0: 6d 2d 74 65 73 74 2d 68 61 73 68 29 29 0a 20 09 m-test-hash)). .
66c0: 09 09 09 09 09 28 74 65 73 74 2d 6e 61 6d 65 73 .....(test-names
66d0: 20 28 74 65 73 74 3a 67 65 74 2d 64 61 74 61 2d (test:get-data-
66e0: 3e 62 2d 6b 65 79 73 20 69 74 65 6d 2d 74 65 73 >b-keys item-tes
66f0: 74 2d 68 61 73 68 20 69 74 65 6d 73 29 29 29 0a t-hash items))).
6700: 20 20 20 20 28 69 66 20 6f 75 70 0a 20 20 20 20 (if oup.
6710: 20 20 28 62 65 67 69 6e 20 0a 20 20 20 20 20 28 (begin . (
6720: 73 3a 6f 75 74 70 75 74 2d 6e 65 77 0a 09 20 20 s:output-new..
6730: 20 6f 75 70 0a 09 20 20 20 28 73 3a 68 74 6d 6c oup.. (s:html
6740: 20 74 65 73 74 73 3a 63 73 73 2d 6a 73 63 72 69 tests:css-jscri
6750: 70 74 2d 62 6c 6f 63 6b 20 28 74 65 73 74 73 3a pt-block (tests:
6760: 63 73 73 2d 6a 73 63 72 69 70 74 2d 62 6c 6f 63 css-jscript-bloc
6770: 6b 2d 63 6f 6e 64 20 23 66 29 0a 09 09 20 20 20 k-cond #f)...
6780: 28 73 3a 74 69 74 6c 65 20 22 52 75 6e 73 20 56 (s:title "Runs V
6790: 69 65 77 20 22 20 72 75 6e 2d 6e 61 6d 65 29 0a iew " run-name).
67a0: 09 09 20 20 20 28 73 3a 62 6f 64 79 0a 09 09 20 .. (s:body...
67b0: 20 20 20 20 28 73 3a 68 31 20 22 52 75 6e 73 20 (s:h1 "Runs
67c0: 56 69 65 77 20 22 20 29 0a 20 20 20 20 20 20 20 View " ).
67d0: 20 20 28 73 3a 68 33 20 22 54 61 72 67 65 74 22 (s:h3 "Target"
67e0: 20 74 61 72 67 65 74 29 0a 09 09 09 09 20 28 73 target)..... (s
67f0: 3a 70 20 0a 09 09 09 09 09 28 73 3a 62 20 22 52 :p ......(s:b "R
6800: 75 6e 20 6e 61 6d 65 22 20 29 20 72 75 6e 2d 6e un name" ) run-n
6810: 61 6d 65 29 0a 20 20 20 20 20 20 20 20 20 28 73 ame). (s
6820: 3a 70 20 0a 09 09 09 09 09 28 73 3a 62 20 22 52 :p ......(s:b "R
6830: 75 6e 20 44 61 74 65 22 20 29 20 72 75 6e 2d 74 un Date" ) run-t
6840: 69 6d 65 29 0a 20 20 20 20 20 20 20 20 20 28 73 ime). (s
6850: 3a 74 61 62 6c 65 20 27 62 6f 72 64 65 72 20 31 :table 'border 1
6860: 20 27 63 65 6c 6c 73 70 61 63 69 6e 67 20 30 0a 'cellspacing 0.
6870: 20 20 20 20 20 20 20 20 20 20 20 28 73 3a 74 72 (s:tr
6880: 0a 20 20 20 20 20 20 20 20 20 20 20 28 73 3a 74 . (s:t
6890: 68 20 22 49 74 65 6d 73 22 29 0a 20 20 20 20 20 h "Items").
68a0: 20 20 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 (map (lamb
68b0: 64 61 20 28 74 65 73 74 29 0a 20 20 20 20 20 20 da (test).
68c0: 20 20 20 20 20 20 28 73 3a 74 68 20 74 65 73 74 (s:th test
68d0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 74 65 )). te
68e0: 73 74 2d 6e 61 6d 65 73 29 29 20 20 0a 20 20 20 st-names)) .
68f0: 20 20 20 20 20 20 20 20 28 6d 61 70 20 28 6c 61 (map (la
6900: 6d 62 64 61 20 28 69 74 65 6d 29 20 0a 09 09 09 mbda (item) ....
6910: 09 09 20 20 28 6c 65 74 2a 20 28 28 74 65 73 74 .. (let* ((test
6920: 2d 68 61 73 68 20 28 68 61 73 68 2d 74 61 62 6c -hash (hash-tabl
6930: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 69 74 e-ref/default it
6940: 65 6d 2d 74 65 73 74 2d 68 61 73 68 20 69 74 65 em-test-hash ite
6950: 6d 20 20 23 66 29 29 29 0a 09 09 09 09 09 09 09 m #f)))........
6960: 09 20 28 69 66 20 74 65 73 74 2d 68 61 73 68 0a . (if test-hash.
6970: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6980: 20 20 28 62 65 67 69 6e 0a 09 09 09 09 09 09 09 (begin........
6990: 09 09 28 73 3a 74 72 0a 09 09 09 09 09 20 20 09 ..(s:tr...... .
69a0: 09 09 28 73 3a 74 64 20 27 63 6c 61 73 73 20 22 ..(s:td 'class "
69b0: 74 65 73 74 22 20 69 74 65 6d 29 0a 20 20 20 20 test" item).
69c0: 20 20 20 20 20 20 20 20 09 09 09 28 6d 61 70 20 ...(map
69d0: 28 6c 61 6d 62 64 61 20 28 74 65 73 74 29 0a 09 (lambda (test)..
69e0: 09 09 09 09 09 20 20 09 09 28 6c 65 74 2a 20 28 ..... ..(let* (
69f0: 28 74 65 73 74 2d 64 65 74 61 69 6c 73 20 28 68 (test-details (h
6a00: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
6a10: 66 61 75 6c 74 20 74 65 73 74 2d 68 61 73 68 20 fault test-hash
6a20: 74 65 73 74 20 20 23 66 29 29 0a 09 09 09 09 09 test #f))......
6a30: 09 09 09 09 09 09 09 28 73 74 61 74 75 73 20 28 .......(status (
6a40: 69 66 20 74 65 73 74 2d 64 65 74 61 69 6c 73 0a if test-details.
6a50: 09 09 09 09 09 09 09 09 09 09 09 09 09 09 09 09 ................
6a60: 28 63 61 72 20 74 65 73 74 2d 64 65 74 61 69 6c (car test-detail
6a70: 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 s))).
6a80: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 69 (li
6a90: 6e 6b 20 28 69 66 20 74 65 73 74 2d 64 65 74 61 nk (if test-deta
6aa0: 69 6c 73 20 0a 09 09 09 09 09 09 09 09 09 09 09 ils ............
6ab0: 09 09 09 28 73 74 72 69 6e 67 2d 73 75 62 73 74 ...(string-subst
6ac0: 69 74 75 74 65 20 20 28 63 6f 6e 63 20 6c 69 6e itute (conc lin
6ad0: 6b 74 72 65 65 20 22 2f 22 20 74 61 72 67 65 74 ktree "/" target
6ae0: 20 22 2f 22 20 72 75 6e 2d 6e 61 6d 65 20 22 2f "/" run-name "/
6af0: 22 29 20 20 22 22 20 28 63 61 64 72 20 74 65 73 ") "" (cadr tes
6b00: 74 2d 64 65 74 61 69 6c 73 29 20 22 2d 22 29 29 t-details) "-"))
6b10: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
6b20: 20 20 20 20 20 20 28 69 66 20 74 65 73 74 2d 64 (if test-d
6b30: 65 74 61 69 6c 73 0a 09 09 09 09 09 09 09 09 09 etails..........
6b40: 09 09 28 73 3a 74 64 20 27 63 6c 61 73 73 20 73 ..(s:td 'class s
6b50: 74 61 74 75 73 0a 09 09 09 09 09 09 09 09 09 09 tatus...........
6b60: 09 09 28 73 3a 61 20 27 63 6c 61 73 73 20 22 6c ..(s:a 'class "l
6b70: 69 6e 6b 22 20 27 68 72 65 66 20 6c 69 6e 6b 20 ink" 'href link
6b80: 73 74 61 74 75 73 20 29 29 0a 20 20 20 20 20 20 status )).
6b90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6ba0: 28 73 3a 74 64 20 22 22 29 29 29 29 20 09 09 09 (s:td "")))) ...
6bb0: 0a 09 09 09 09 09 09 09 09 09 74 65 73 74 2d 6e ..........test-n
6bc0: 61 6d 65 73 29 29 29 29 29 29 0a 09 09 09 09 20 ames)))))).....
6bd0: 20 28 73 6f 72 74 20 69 74 65 6d 73 20 73 74 72 (sort items str
6be0: 69 6e 67 3c 3d 3f 29 29 29 29 29 29 0a 09 09 28 ing<=?))))))...(
6bf0: 63 6c 6f 73 65 2d 6f 75 74 70 75 74 2d 70 6f 72 close-output-por
6c00: 74 20 6f 75 70 29 29 0a 20 20 20 20 28 64 65 62 t oup)). (deb
6c10: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 ug:print-info 0
6c20: 22 53 6b 69 70 3a 20 44 69 72 63 74 6f 72 79 20 "Skip: Dirctory
6c30: 73 74 72 75 63 74 75 72 65 20 22 20 6c 69 6e 6b structure " link
6c40: 74 72 65 65 20 22 2f 22 20 74 61 72 67 65 74 20 tree "/" target
6c50: 22 2f 22 20 72 75 6e 2d 6e 61 6d 65 20 22 20 64 "/" run-name " d
6c60: 6f 65 73 20 6e 6f 74 20 65 78 69 73 74 2e 20 4d oes not exist. M
6c70: 65 67 61 74 65 73 74 20 77 69 6c 6c 20 6e 6f 74 egatest will not
6c80: 20 63 72 65 61 74 65 20 72 75 6e 2e 68 74 6d 6c create run.html
6c90: 22 29 29 29 29 0a 72 75 6e 73 29 29 0a 0a 28 64 ")))).runs))..(d
6ca0: 65 66 69 6e 65 20 28 74 65 73 74 3a 63 72 65 61 efine (test:crea
6cb0: 74 65 2d 74 61 72 67 65 74 2d 68 61 73 68 20 72 te-target-hash r
6cc0: 75 6e 73 20 68 65 61 64 65 72 20 6e 75 6d 6b 65 uns header numke
6cd0: 79 73 29 0a 20 20 28 6c 65 74 20 28 28 72 65 73 ys). (let ((res
6ce0: 68 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 h (make-hash-tab
6cf0: 6c 65 29 29 29 0a 20 20 20 28 66 6f 72 2d 65 61 le))). (for-ea
6d00: 63 68 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 ch. (lambda
6d10: 28 72 75 6e 29 0a 20 20 20 20 20 20 20 20 28 6c (run). (l
6d20: 65 74 2a 20 28 28 72 75 6e 2d 6e 61 6d 65 20 28 et* ((run-name (
6d30: 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d db:get-value-by-
6d40: 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 header run heade
6d50: 72 20 22 72 75 6e 6e 61 6d 65 22 29 29 0a 20 20 r "runname")).
6d60: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 74 61 (ta
6d70: 72 67 65 74 20 20 20 28 73 74 72 69 6e 67 2d 6a rget (string-j
6d80: 6f 69 6e 20 28 74 61 6b 65 20 28 76 65 63 74 6f oin (take (vecto
6d90: 72 2d 3e 6c 69 73 74 20 72 75 6e 29 20 6e 75 6d r->list run) num
6da0: 6b 65 79 73 29 20 22 2f 22 29 29 0a 20 20 20 20 keys) "/")).
6db0: 20 20 20 20 20 20 20 20 20 20 20 28 72 75 6e 2d (run-
6dc0: 6c 69 73 74 20 28 68 61 73 68 2d 74 61 62 6c 65 list (hash-table
6dd0: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 72 65 73 -ref/default res
6de0: 68 20 74 61 72 67 65 74 20 20 23 66 29 29 29 0a h target #f))).
6df0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0a .
6e00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
6e10: 69 66 20 28 6e 6f 74 20 72 75 6e 2d 6c 69 73 74 if (not run-list
6e20: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
6e30: 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 (hash-table
6e40: 2d 73 65 74 21 20 72 65 73 68 20 74 61 72 67 65 -set! resh targe
6e50: 74 20 20 20 28 6c 69 73 74 20 72 75 6e 2d 6e 61 t (list run-na
6e60: 6d 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 me)).
6e70: 20 20 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 (hash-ta
6e80: 62 6c 65 2d 73 65 74 21 20 72 65 73 68 20 74 61 ble-set! resh ta
6e90: 72 67 65 74 20 20 20 28 63 6f 6e 73 20 72 75 6e rget (cons run
6ea0: 2d 6e 61 6d 65 20 72 75 6e 2d 6c 69 73 74 29 29 -name run-list))
6eb0: 29 29 29 0a 20 20 20 20 20 20 72 75 6e 73 29 0a ))). runs).
6ec0: 20 20 20 72 65 73 68 29 29 0a 0a 28 64 65 66 69 resh))..(defi
6ed0: 6e 65 20 28 74 65 73 74 3a 67 65 74 2d 6d 61 78 ne (test:get-max
6ee0: 2d 72 75 6e 2d 63 6e 74 20 74 61 72 67 65 74 2d -run-cnt target-
6ef0: 68 61 73 68 20 74 61 72 67 65 74 73 29 0a 20 20 hash targets).
6f00: 20 28 6c 65 74 2a 20 28 28 63 6e 74 20 30 20 29 (let* ((cnt 0 )
6f10: 29 0a 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 ). (map (lambd
6f20: 61 20 28 74 61 72 67 65 74 29 0a 20 20 20 20 20 a (target).
6f30: 20 20 20 28 6c 65 74 2a 20 28 28 72 75 6e 73 20 (let* ((runs
6f40: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
6f50: 2f 64 65 66 61 75 6c 74 20 74 61 72 67 65 74 2d /default target-
6f60: 68 61 73 68 20 74 61 72 67 65 74 20 20 23 66 29 hash target #f)
6f70: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
6f80: 20 28 72 75 6e 2d 6c 65 6e 67 74 68 20 28 69 66 (run-length (if
6f90: 20 72 75 6e 73 0a 09 09 09 09 09 09 09 09 09 09 runs...........
6fa0: 09 09 09 09 09 09 28 6c 65 6e 67 74 68 20 72 75 ......(length ru
6fb0: 6e 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ns).
6fc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6fd0: 20 20 20 20 20 30 29 29 29 0a 20 20 0a 20 20 20 0))). .
6fe0: 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 (if (
6ff0: 3c 20 63 6e 74 20 72 75 6e 2d 6c 65 6e 67 74 68 < cnt run-length
7000: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
7010: 20 28 73 65 74 21 20 63 6e 74 20 20 72 75 6e 2d (set! cnt run-
7020: 6c 65 6e 67 74 68 29 29 29 29 20 0a 09 09 74 61 length)))) ...ta
7030: 72 67 65 74 73 29 20 0a 63 6e 74 29 29 0a 20 0a rgets) .cnt)). .
7040: 28 64 65 66 69 6e 65 20 28 74 65 73 74 3a 70 61 (define (test:pa
7050: 64 2d 72 75 6e 73 20 74 61 72 67 65 74 2d 68 61 d-runs target-ha
7060: 73 68 20 74 61 72 67 65 74 73 20 6d 61 78 2d 72 sh targets max-r
7070: 6f 77 2d 6c 65 6e 67 74 68 29 0a 20 28 6d 61 70 ow-length). (map
7080: 20 28 6c 61 6d 62 64 61 20 28 74 61 72 67 65 74 (lambda (target
7090: 29 0a 20 20 20 20 20 20 20 20 28 6c 65 74 20 6c ). (let l
70a0: 6f 6f 70 20 28 28 72 75 6e 2d 6c 69 73 74 20 20 oop ((run-list
70b0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
70c0: 64 65 66 61 75 6c 74 20 74 61 72 67 65 74 2d 68 default target-h
70d0: 61 73 68 20 74 61 72 67 65 74 20 20 23 66 29 29 ash target #f))
70e0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
70f0: 20 28 69 66 20 28 3c 20 28 6c 65 6e 67 74 68 20 (if (< (length
7100: 72 75 6e 2d 6c 69 73 74 29 20 6d 61 78 2d 72 6f run-list) max-ro
7110: 77 2d 6c 65 6e 67 74 68 29 0a 20 20 20 20 20 20 w-length).
7120: 20 20 20 20 20 20 20 20 20 20 20 28 62 65 67 69 (begi
7130: 6e 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 n .
7140: 20 20 20 09 09 20 28 68 61 73 68 2d 74 61 62 6c .. (hash-tabl
7150: 65 2d 73 65 74 21 20 74 61 72 67 65 74 2d 68 61 e-set! target-ha
7160: 73 68 20 74 61 72 67 65 74 20 20 20 28 63 6f 6e sh target (con
7170: 73 20 22 22 20 72 75 6e 2d 6c 69 73 74 29 29 0a s "" run-list)).
7180: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 09 .
7190: 09 20 28 6c 6f 6f 70 20 28 68 61 73 68 2d 74 61 . (loop (hash-ta
71a0: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
71b0: 74 61 72 67 65 74 2d 68 61 73 68 20 74 61 72 67 target-hash targ
71c0: 65 74 20 20 23 66 29 20 29 29 29 29 29 20 0a 09 et #f) ))))) ..
71d0: 09 74 61 72 67 65 74 73 29 0a 20 20 20 74 61 72 .targets). tar
71e0: 67 65 74 2d 68 61 73 68 29 0a 0a 28 64 65 66 69 get-hash)..(defi
71f0: 6e 65 20 28 74 65 73 74 3a 63 72 65 61 74 65 2d ne (test:create-
7200: 74 61 72 67 65 74 2d 68 74 6d 6c 20 74 61 72 67 target-html targ
7210: 65 74 2d 68 61 73 68 20 6f 75 70 20 61 72 65 61 et-hash oup area
7220: 2d 6e 61 6d 65 20 6c 69 6e 6b 74 72 65 65 29 0a -name linktree).
7230: 20 20 28 6c 65 74 2a 20 28 28 74 61 72 67 65 74 (let* ((target
7240: 73 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 s (hash-table-ke
7250: 79 73 20 74 61 72 67 65 74 2d 68 61 73 68 29 29 ys target-hash))
7260: 0a 20 20 20 20 20 20 20 20 20 28 6d 61 78 2d 72 . (max-r
7270: 6f 77 2d 6c 65 6e 67 74 68 20 28 74 65 73 74 3a ow-length (test:
7280: 67 65 74 2d 6d 61 78 2d 72 75 6e 2d 63 6e 74 20 get-max-run-cnt
7290: 74 61 72 67 65 74 2d 68 61 73 68 20 74 61 72 67 target-hash targ
72a0: 65 74 73 29 29 0a 20 20 20 20 20 20 20 20 20 28 ets)). (
72b0: 70 61 64 2d 72 75 6e 73 2d 68 61 73 68 20 28 74 pad-runs-hash (t
72c0: 65 73 74 3a 70 61 64 2d 72 75 6e 73 20 74 61 72 est:pad-runs tar
72d0: 67 65 74 2d 68 61 73 68 20 74 61 72 67 65 74 73 get-hash targets
72e0: 20 6d 61 78 2d 72 6f 77 2d 6c 65 6e 67 74 68 29 max-row-length)
72f0: 29 29 0a 20 20 20 28 73 3a 6f 75 74 70 75 74 2d )). (s:output-
7300: 6e 65 77 0a 09 20 20 20 6f 75 70 0a 09 20 20 20 new.. oup..
7310: 28 73 3a 68 74 6d 6c 20 74 65 73 74 73 3a 63 73 (s:html tests:cs
7320: 73 2d 6a 73 63 72 69 70 74 2d 62 6c 6f 63 6b 20 s-jscript-block
7330: 28 74 65 73 74 73 3a 63 73 73 2d 6a 73 63 72 69 (tests:css-jscri
7340: 70 74 2d 62 6c 6f 63 6b 2d 63 6f 6e 64 20 23 66 pt-block-cond #f
7350: 29 0a 0a 09 09 20 20 20 28 73 3a 74 69 74 6c 65 ).... (s:title
7360: 20 22 54 61 72 67 65 74 20 56 69 65 77 20 22 20 "Target View "
7370: 61 72 65 61 2d 6e 61 6d 65 29 0a 09 09 20 20 20 area-name)...
7380: 28 73 3a 62 6f 64 79 0a 09 09 20 20 20 28 73 3a (s:body... (s:
7390: 68 31 20 22 54 61 72 67 65 74 20 56 69 65 77 20 h1 "Target View
73a0: 22 20 61 72 65 61 2d 6e 61 6d 65 29 0a 09 09 09 " area-name)....
73b0: 09 09 28 73 3a 74 61 62 6c 65 20 27 69 64 20 22 ..(s:table 'id "
73c0: 4c 69 6e 6b 65 64 4c 69 73 74 31 22 20 27 62 6f LinkedList1" 'bo
73d0: 72 64 65 72 20 22 31 22 20 27 63 65 6c 6c 73 70 rder "1" 'cellsp
73e0: 61 63 69 6e 67 20 30 0a 20 20 20 20 20 20 20 20 acing 0.
73f0: 20 20 20 20 20 28 73 3a 74 72 20 27 63 6c 61 73 (s:tr 'clas
7400: 73 20 22 73 6f 6d 65 74 68 69 6e 67 22 20 0a 20 s "something" .
7410: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 (s
7420: 3a 74 68 20 22 54 61 72 67 65 74 22 29 0a 09 09 :th "Target")...
7430: 09 09 09 09 09 09 28 73 3a 74 68 20 27 63 6f 6c ......(s:th 'col
7440: 73 70 61 6e 20 6d 61 78 2d 72 6f 77 2d 6c 65 6e span max-row-len
7450: 67 74 68 20 22 52 75 6e 73 22 29 29 20 20 20 20 gth "Runs"))
7460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7470: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7480: 20 20 20 20 20 20 20 20 20 20 0a 20 20 20 20 20 .
7490: 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 2a (let*
74a0: 20 28 28 74 62 6c 20 28 6d 61 70 20 28 6c 61 6d ((tbl (map (lam
74b0: 62 64 61 20 28 74 61 72 67 65 74 29 0a 20 20 20 bda (target).
74c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
74d0: 20 20 20 28 73 3a 74 72 0a 20 20 20 20 20 20 20 (s:tr.
74e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
74f0: 73 3a 74 64 20 27 63 6c 61 73 73 20 22 74 65 73 s:td 'class "tes
7500: 74 22 20 74 61 72 67 65 74 29 0a 09 09 09 09 09 t" target)......
7510: 09 09 09 09 09 20 20 28 6c 65 74 2a 20 28 28 72 ..... (let* ((r
7520: 75 6e 73 20 20 28 68 61 73 68 2d 74 61 62 6c 65 uns (hash-table
7530: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 74 61 72 -ref/default tar
7540: 67 65 74 2d 68 61 73 68 20 74 61 72 67 65 74 20 get-hash target
7550: 20 23 66 29 29 0a 09 09 09 09 09 09 09 09 09 09 #f))...........
7560: 09 09 09 09 20 28 72 65 73 74 2d 72 6f 77 20 28 .... (rest-row (
7570: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 72 75 6e map (lambda (run
7580: 29 0a 09 09 09 09 09 09 09 09 09 09 09 09 09 09 )...............
7590: 09 09 09 09 09 09 28 69 66 20 28 65 71 75 61 6c ......(if (equal
75a0: 3f 20 72 75 6e 20 22 22 29 0a 09 09 09 09 09 09 ? run "").......
75b0: 09 09 09 09 09 09 09 09 09 09 09 09 09 09 09 09 ................
75c0: 28 73 3a 74 64 20 72 75 6e 29 0a 20 20 20 20 20 (s:td run).
75d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
75e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
75f0: 20 20 20 20 20 20 20 28 69 66 20 28 66 69 6c 65 (if (file
7600: 2d 65 78 69 73 74 73 3f 28 63 6f 6e 63 20 6c 69 -exists?(conc li
7610: 6e 6b 74 72 65 65 20 22 2f 22 20 74 61 72 67 65 nktree "/" targe
7620: 74 20 22 2f 22 20 72 75 6e 20 29 29 0a 09 09 09 t "/" run ))....
7630: 09 09 09 09 09 09 09 09 09 09 09 09 09 09 09 09 ................
7640: 09 09 09 28 62 65 67 69 6e 20 0a 09 09 09 09 09 ...(begin ......
7650: 09 09 09 09 09 09 09 09 09 09 09 09 09 09 09 09 ................
7660: 09 09 28 73 3a 74 64 20 0a 09 09 09 09 09 09 09 ..(s:td ........
7670: 09 09 09 09 09 09 09 09 09 09 09 09 09 09 09 09 ................
7680: 28 73 3a 61 20 27 68 72 65 66 20 28 63 6f 6e 63 (s:a 'href (conc
7690: 20 20 74 61 72 67 65 74 20 22 2f 22 20 72 75 6e target "/" run
76a0: 20 22 2f 72 75 6e 2e 68 74 6d 6c 22 29 20 72 75 "/run.html") ru
76b0: 6e 29 29 29 29 29 29 0a 09 09 09 09 09 09 09 09 n)))))).........
76c0: 09 09 09 09 09 09 09 09 09 09 09 09 28 72 65 76 ............(rev
76d0: 65 72 73 65 20 72 75 6e 73 29 29 29 29 0a 20 20 erse runs)))).
76e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
76f0: 20 20 20 20 20 20 20 20 20 20 20 20 72 65 73 74 rest
7700: 2d 72 6f 77 29 29 29 0a 20 20 20 20 20 20 20 20 -row))).
7710: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7720: 20 20 20 20 20 20 20 20 20 20 20 74 61 72 67 65 targe
7730: 74 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ts))).
7740: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7750: 20 74 62 6c 29 29 29 29 29 0a 20 20 20 20 20 20 tbl))))).
7760: 20 20 20 20 28 63 6c 6f 73 65 2d 6f 75 74 70 75 (close-outpu
7770: 74 2d 70 6f 72 74 20 6f 75 70 29 29 29 0a 0a 0a t-port oup)))...
7780: 28 64 65 66 69 6e 65 20 28 74 65 73 74 73 3a 63 (define (tests:c
7790: 72 65 61 74 65 2d 68 74 6d 6c 2d 74 72 65 65 2d reate-html-tree-
77a0: 6f 6c 64 20 6f 75 74 66 29 0a 20 20 20 28 6c 65 old outf). (le
77b0: 74 2a 20 28 28 6c 6f 63 6b 66 69 6c 65 20 20 28 t* ((lockfile (
77c0: 63 6f 6e 63 20 6f 75 74 66 20 22 2e 6c 6f 63 6b conc outf ".lock
77d0: 22 29 29 0a 09 20 28 72 75 6e 73 2d 74 6f 2d 70 ")).. (runs-to-p
77e0: 72 6f 63 65 73 73 20 27 28 29 29 29 0a 20 20 20 rocess '())).
77f0: 20 28 69 66 20 28 63 6f 6d 6d 6f 6e 3a 73 69 6d (if (common:sim
7800: 70 6c 65 2d 66 69 6c 65 2d 6c 6f 63 6b 20 6c 6f ple-file-lock lo
7810: 63 6b 66 69 6c 65 29 0a 09 28 6c 65 74 2a 20 28 ckfile)..(let* (
7820: 28 6c 69 6e 6b 74 72 65 65 20 20 28 63 6f 6d 6d (linktree (comm
7830: 6f 6e 3a 67 65 74 2d 6c 69 6e 6b 74 72 65 65 29 on:get-linktree)
7840: 29 0a 09 20 20 20 20 20 20 20 28 6f 75 70 20 20 ).. (oup
7850: 20 20 20 20 20 28 6f 70 65 6e 2d 6f 75 74 70 75 (open-outpu
7860: 74 2d 66 69 6c 65 20 28 6f 72 20 6f 75 74 66 20 t-file (or outf
7870: 28 63 6f 6e 63 20 6c 69 6e 6b 74 72 65 65 20 22 (conc linktree "
7880: 2f 72 75 6e 73 2d 69 6e 64 65 78 2e 68 74 6d 6c /runs-index.html
7890: 22 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 61 ")))).. (a
78a0: 72 65 61 2d 6e 61 6d 65 20 28 63 6f 6d 6d 6f 6e rea-name (common
78b0: 3a 67 65 74 2d 74 65 73 74 73 75 69 74 65 2d 6e :get-testsuite-n
78c0: 61 6d 65 29 29 0a 09 20 20 20 20 20 20 20 28 6b ame)).. (k
78d0: 65 79 73 20 20 20 20 20 20 28 72 6d 74 3a 67 65 eys (rmt:ge
78e0: 74 2d 6b 65 79 73 29 29 0a 09 20 20 20 20 20 20 t-keys))..
78f0: 20 28 6e 75 6d 6b 65 79 73 20 20 20 28 6c 65 6e (numkeys (len
7900: 67 74 68 20 6b 65 79 73 29 29 0a 09 20 20 20 20 gth keys))..
7910: 20 20 20 28 72 75 6e 73 64 61 74 20 20 20 28 72 (runsdat (r
7920: 6d 74 3a 67 65 74 2d 72 75 6e 73 20 22 25 22 20 mt:get-runs "%"
7930: 23 66 20 23 66 20 28 6d 61 70 20 28 6c 61 6d 62 #f #f (map (lamb
7940: 64 61 20 28 78 29 28 6c 69 73 74 20 78 20 22 25 da (x)(list x "%
7950: 22 29 29 20 6b 65 79 73 29 29 29 0a 09 20 20 20 ")) keys)))..
7960: 20 20 20 20 28 68 65 61 64 65 72 20 20 20 20 28 (header (
7970: 76 65 63 74 6f 72 2d 72 65 66 20 72 75 6e 73 64 vector-ref runsd
7980: 61 74 20 30 29 29 0a 09 20 20 20 20 20 20 20 28 at 0)).. (
7990: 72 75 6e 73 20 20 20 20 20 20 28 76 65 63 74 6f runs (vecto
79a0: 72 2d 72 65 66 20 72 75 6e 73 64 61 74 20 31 29 r-ref runsdat 1)
79b0: 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 74 72 ).. (runtr
79c0: 65 65 64 61 74 20 28 6d 61 70 20 28 6c 61 6d 62 eedat (map (lamb
79d0: 64 61 20 28 78 29 0a 09 09 09 09 20 20 28 74 65 da (x)..... (te
79e0: 73 74 73 3a 72 75 6e 2d 72 65 63 6f 72 64 2d 3e sts:run-record->
79f0: 74 65 73 74 2d 70 61 74 68 20 78 20 6e 75 6d 6b test-path x numk
7a00: 65 79 73 29 29 0a 09 09 09 09 72 75 6e 73 29 29 eys)).....runs))
7a10: 0a 09 20 20 20 20 20 20 20 28 72 75 6e 73 2d 68 .. (runs-h
7a20: 74 72 65 65 20 28 63 6f 6d 6d 6f 6e 3a 6c 69 73 tree (common:lis
7a30: 74 2d 3e 68 74 72 65 65 20 72 75 6e 74 72 65 65 t->htree runtree
7a40: 64 61 74 29 29 29 0a 09 20 20 28 73 65 74 21 20 dat))).. (set!
7a50: 72 75 6e 73 2d 74 6f 2d 70 72 6f 63 65 73 73 20 runs-to-process
7a60: 72 75 6e 73 29 0a 09 20 20 28 73 3a 6f 75 74 70 runs).. (s:outp
7a70: 75 74 2d 6e 65 77 0a 09 20 20 20 6f 75 70 0a 09 ut-new.. oup..
7a80: 20 20 20 28 73 3a 68 74 6d 6c 20 74 65 73 74 73 (s:html tests
7a90: 3a 63 73 73 2d 6a 73 63 72 69 70 74 2d 62 6c 6f :css-jscript-blo
7aa0: 63 6b 0a 09 09 20 20 20 28 73 3a 74 69 74 6c 65 ck... (s:title
7ab0: 20 22 53 75 6d 6d 61 72 79 20 66 6f 72 20 22 20 "Summary for "
7ac0: 61 72 65 61 2d 6e 61 6d 65 29 0a 09 09 20 20 20 area-name)...
7ad0: 28 73 3a 62 6f 64 79 20 27 6f 6e 6c 6f 61 64 20 (s:body 'onload
7ae0: 22 61 64 64 45 76 65 6e 74 73 28 29 3b 22 0a 09 "addEvents();"..
7af0: 09 09 20 20 20 28 73 3a 68 31 20 22 53 75 6d 6d .. (s:h1 "Summ
7b00: 61 72 79 20 66 6f 72 20 22 20 61 72 65 61 2d 6e ary for " area-n
7b10: 61 6d 65 29 0a 09 09 09 20 20 20 3b 3b 20 74 6f ame).... ;; to
7b20: 70 20 6c 69 73 74 0a 09 09 09 20 20 20 28 73 3a p list.... (s:
7b30: 75 6c 20 27 69 64 20 22 4c 69 6e 6b 65 64 4c 69 ul 'id "LinkedLi
7b40: 73 74 31 22 20 27 63 6c 61 73 73 20 22 4c 69 6e st1" 'class "Lin
7b50: 6b 65 64 4c 69 73 74 22 0a 09 09 09 09 20 28 73 kedList"..... (s
7b60: 3a 6c 69 0a 09 09 09 09 20 20 22 52 75 6e 73 22 :li..... "Runs"
7b70: 0a 09 09 09 09 20 20 28 63 6f 6d 6d 6f 6e 3a 68 ..... (common:h
7b80: 74 72 65 65 2d 3e 68 74 6d 6c 20 72 75 6e 73 2d tree->html runs-
7b90: 68 74 72 65 65 0a 09 09 09 09 09 09 20 20 20 20 htree.......
7ba0: 20 20 27 28 29 0a 09 09 09 09 09 09 20 20 20 20 '().......
7bb0: 20 20 28 6c 61 6d 62 64 61 20 28 78 20 70 29 0a (lambda (x p).
7bc0: 09 09 09 09 09 09 09 28 6c 65 74 2a 20 28 28 74 .......(let* ((t
7bd0: 61 72 67 2d 70 61 74 68 20 28 73 74 72 69 6e 67 arg-path (string
7be0: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 70 20 22 -intersperse p "
7bf0: 2f 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 /")).
7c00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7c10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7c20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7c30: 20 20 20 20 28 66 75 6c 6c 2d 70 61 74 68 20 28 (full-path (
7c40: 63 6f 6e 63 20 6c 69 6e 6b 74 72 65 65 20 22 2f conc linktree "/
7c50: 22 20 74 61 72 67 2d 70 61 74 68 29 29 0a 20 20 " targ-path)).
7c60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7c70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7c80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7c90: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 75 (ru
7ca0: 6e 2d 6e 61 6d 65 20 20 28 63 61 72 20 28 72 65 n-name (car (re
7cb0: 76 65 72 73 65 20 70 29 29 29 29 0a 20 20 20 20 verse p)))).
7cc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7cd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7ce0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7cf0: 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 (if (and (
7d00: 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 common:file-exis
7d10: 74 73 3f 20 66 75 6c 6c 2d 70 61 74 68 29 0a 20 ts? full-path).
7d20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7d30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7d40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7d50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7d60: 20 20 28 64 69 72 65 63 74 6f 72 79 3f 20 20 20 (directory?
7d70: 66 75 6c 6c 2d 70 61 74 68 29 0a 20 20 20 20 20 full-path).
7d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7d90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7da0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7db0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 66 (f
7dc0: 69 6c 65 2d 77 72 69 74 65 2d 61 63 63 65 73 73 ile-write-access
7dd0: 3f 20 66 75 6c 6c 2d 70 61 74 68 29 29 0a 20 20 ? full-path)).
7de0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7df0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7e00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7e10: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 3a 61 (s:a
7e20: 20 72 75 6e 2d 6e 61 6d 65 20 27 68 72 65 66 20 run-name 'href
7e30: 28 63 6f 6e 63 20 74 61 72 67 2d 70 61 74 68 20 (conc targ-path
7e40: 22 2f 72 75 6e 2d 73 75 6d 6d 61 72 79 2e 68 74 "/run-summary.ht
7e50: 6d 6c 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 ml")).
7e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7e70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7e80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7e90: 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 (begin.
7ea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7eb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7ec0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7ed0: 20 20 20 20 20 20 20 20 20 20 20 28 64 65 62 75 (debu
7ee0: 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 g:print 0 *defau
7ef0: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 49 4e lt-log-port* "IN
7f00: 46 4f 3a 20 43 61 6e 27 74 20 63 72 65 61 74 65 FO: Can't create
7f10: 20 22 20 74 61 72 67 2d 70 61 74 68 20 22 2f 72 " targ-path "/r
7f20: 75 6e 2d 73 75 6d 6d 61 72 79 2e 68 74 6d 6c 22 un-summary.html"
7f30: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
7f40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7f50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7f60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7f70: 20 20 28 63 6f 6e 63 20 72 75 6e 2d 6e 61 6d 65 (conc run-name
7f80: 20 22 20 28 4e 6f 74 20 61 62 6c 65 20 74 6f 20 " (Not able to
7f90: 63 72 65 61 74 65 20 73 75 6d 6d 61 72 79 20 61 create summary a
7fa0: 74 20 22 20 74 61 72 67 2d 70 61 74 68 20 22 29 t " targ-path ")
7fb0: 22 29 29 29 29 29 29 29 29 29 29 29 0a 20 20 20 "))))))))))).
7fc0: 20 20 20 20 20 20 20 28 63 6c 6f 73 65 2d 6f 75 (close-ou
7fd0: 74 70 75 74 2d 70 6f 72 74 20 6f 75 70 29 0a 09 tput-port oup)..
7fe0: 20 20 28 63 6f 6d 6d 6f 6e 3a 73 69 6d 70 6c 65 (common:simple
7ff0: 2d 66 69 6c 65 2d 72 65 6c 65 61 73 65 2d 6c 6f -file-release-lo
8000: 63 6b 20 6c 6f 63 6b 66 69 6c 65 29 0a 20 20 20 ck lockfile).
8010: 20 20 20 20 20 20 20 20 20 20 20 20 0a 09 20 20 ..
8020: 28 66 6f 72 2d 65 61 63 68 0a 09 20 20 20 28 6c (for-each.. (l
8030: 61 6d 62 64 61 20 28 72 75 6e 29 0a 09 20 20 20 ambda (run)..
8040: 20 20 28 6c 65 74 2a 20 28 28 74 65 73 74 2d 73 (let* ((test-s
8050: 75 62 70 61 74 68 20 28 74 65 73 74 73 3a 72 75 ubpath (tests:ru
8060: 6e 2d 72 65 63 6f 72 64 2d 3e 74 65 73 74 2d 70 n-record->test-p
8070: 61 74 68 20 72 75 6e 20 6e 75 6d 6b 65 79 73 29 ath run numkeys)
8080: 29 0a 09 09 20 20 20 20 28 72 75 6e 2d 69 64 20 )... (run-id
8090: 20 20 20 20 20 20 28 64 62 3a 67 65 74 2d 76 61 (db:get-va
80a0: 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 lue-by-header ru
80b0: 6e 20 68 65 61 64 65 72 20 22 69 64 22 29 29 0a n header "id")).
80c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
80d0: 20 20 20 20 28 72 75 6e 2d 64 69 72 20 20 20 20 (run-dir
80e0: 20 20 28 74 65 73 74 73 3a 72 75 6e 2d 72 65 63 (tests:run-rec
80f0: 6f 72 64 2d 3e 74 65 73 74 2d 70 61 74 68 20 72 ord->test-path r
8100: 75 6e 20 6e 75 6d 6b 65 79 73 29 29 0a 09 09 20 un numkeys))...
8110: 20 20 20 28 74 65 73 74 2d 64 61 74 73 20 20 20 (test-dats
8120: 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 73 2d (rmt:get-tests-
8130: 66 6f 72 2d 72 75 6e 0a 09 09 09 09 20 20 20 72 for-run..... r
8140: 75 6e 2d 69 64 0a 20 20 20 20 20 20 20 20 20 20 un-id.
8150: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8160: 20 20 20 20 20 20 20 20 20 22 25 2f 22 20 20 20 "%/"
8170: 20 20 20 20 3b 3b 20 74 65 73 74 6e 61 6d 65 70 ;; testnamep
8180: 61 74 74 0a 09 09 09 09 20 20 20 27 28 29 20 20 att..... '()
8190: 20 20 20 20 20 20 3b 3b 20 73 74 61 74 65 73 0a ;; states.
81a0: 09 09 09 09 20 20 20 27 28 29 20 20 20 20 20 20 .... '()
81b0: 20 20 3b 3b 20 73 74 61 74 75 73 65 73 0a 09 09 ;; statuses...
81c0: 09 09 20 20 20 23 66 20 20 20 20 20 20 20 20 20 .. #f
81d0: 3b 3b 20 6f 66 66 73 65 74 0a 09 09 09 09 20 20 ;; offset.....
81e0: 20 23 66 20 20 20 20 20 20 20 20 20 3b 3b 20 6e #f ;; n
81f0: 75 6d 2d 74 6f 2d 67 65 74 0a 09 09 09 09 20 20 um-to-get.....
8200: 20 23 66 20 20 20 20 20 20 20 20 20 3b 3b 20 68 #f ;; h
8210: 69 64 65 2f 6e 6f 74 2d 68 69 64 65 0a 09 09 09 ide/not-hide....
8220: 09 20 20 20 23 66 20 20 20 20 20 20 20 20 20 3b . #f ;
8230: 3b 20 73 6f 72 74 2d 62 79 0a 09 09 09 09 20 20 ; sort-by.....
8240: 20 23 66 20 20 20 20 20 20 20 20 20 3b 3b 20 73 #f ;; s
8250: 6f 72 74 2d 6f 72 64 65 72 0a 09 09 09 09 20 20 ort-order.....
8260: 20 23 66 20 20 20 20 20 20 20 20 20 3b 3b 20 27 #f ;; '
8270: 73 68 6f 72 74 6c 69 73 74 20 20 20 20 20 20 20 shortlist
8280: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8290: 20 20 20 20 3b 3b 20 71 72 79 74 79 70 65 0a 20 ;; qrytype.
82a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
82b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
82c0: 20 20 30 20 20 20 20 20 20 20 20 20 3b 3b 20 6c 0 ;; l
82d0: 61 73 74 20 75 70 64 61 74 65 0a 09 09 09 09 20 ast update.....
82e0: 20 20 23 66 29 29 0a 20 20 20 20 20 20 20 20 20 #f)).
82f0: 20 20 20 20 20 20 20 20 20 20 20 28 74 65 73 74 (test
8300: 73 2d 74 72 65 65 2d 64 61 74 20 28 6d 61 70 20 s-tree-dat (map
8310: 28 6c 61 6d 62 64 61 20 28 74 65 73 74 2d 64 61 (lambda (test-da
8320: 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 t).
8330: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8340: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 28 ;; (
8350: 74 65 73 74 73 3a 72 75 6e 2d 72 65 63 6f 72 64 tests:run-record
8360: 2d 3e 74 65 73 74 2d 70 61 74 68 20 78 20 6e 75 ->test-path x nu
8370: 6d 6b 65 79 73 29 29 0a 20 20 20 20 20 20 20 20 mkeys)).
8380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
83a0: 20 28 6c 65 74 2a 20 28 28 74 65 73 74 2d 6e 61 (let* ((test-na
83b0: 6d 65 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 me (db:test-get
83c0: 2d 74 65 73 74 6e 61 6d 65 20 74 65 73 74 2d 64 -testname test-d
83d0: 61 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 at)).
83e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
83f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8400: 20 20 20 20 20 28 69 74 65 6d 2d 70 61 74 68 20 (item-path
8410: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 74 (db:test-get-it
8420: 65 6d 2d 70 61 74 68 20 74 65 73 74 2d 64 61 74 em-path test-dat
8430: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
8440: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8450: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8460: 20 20 20 28 66 75 6c 6c 2d 6e 61 6d 65 20 20 28 (full-name (
8470: 64 62 3a 74 65 73 74 2d 6d 61 6b 65 2d 66 75 6c db:test-make-ful
8480: 6c 2d 6e 61 6d 65 20 74 65 73 74 2d 6e 61 6d 65 l-name test-name
8490: 20 69 74 65 6d 2d 70 61 74 68 29 29 0a 20 20 20 item-path)).
84a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
84b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
84c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 70 61 (pa
84d0: 74 68 2d 70 61 72 74 73 20 28 73 74 72 69 6e 67 th-parts (string
84e0: 2d 73 70 6c 69 74 20 66 75 6c 6c 2d 6e 61 6d 65 -split full-name
84f0: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
8500: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8510: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 70 p
8520: 61 74 68 2d 70 61 72 74 73 29 29 0a 20 20 20 20 ath-parts)).
8530: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8540: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8550: 20 20 20 74 65 73 74 2d 64 61 74 73 29 29 0a 20 test-dats)).
8560: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8570: 20 20 20 28 74 65 73 74 73 2d 68 74 72 65 65 20 (tests-htree
8580: 28 63 6f 6d 6d 6f 6e 3a 6c 69 73 74 2d 3e 68 74 (common:list->ht
8590: 72 65 65 20 74 65 73 74 73 2d 74 72 65 65 2d 64 ree tests-tree-d
85a0: 61 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 at)).
85b0: 20 20 20 20 20 20 20 20 20 28 68 74 6d 6c 2d 64 (html-d
85c0: 69 72 20 20 20 20 28 63 6f 6e 63 20 6c 69 6e 6b ir (conc link
85d0: 74 72 65 65 20 22 2f 22 20 28 73 74 72 69 6e 67 tree "/" (string
85e0: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 72 75 6e -intersperse run
85f0: 2d 64 69 72 20 22 2f 22 29 29 29 0a 20 20 20 20 -dir "/"))).
8600: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8610: 28 68 74 6d 6c 2d 70 61 74 68 20 20 20 28 63 6f (html-path (co
8620: 6e 63 20 68 74 6d 6c 2d 64 69 72 20 22 2f 72 75 nc html-dir "/ru
8630: 6e 2d 73 75 6d 6d 61 72 79 2e 68 74 6d 6c 22 29 n-summary.html")
8640: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
8650: 20 20 20 20 20 20 28 6f 75 70 20 20 20 20 20 20 (oup
8660: 20 20 20 28 69 66 20 28 61 6e 64 20 28 63 6f 6d (if (and (com
8670: 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 3f mon:file-exists?
8680: 20 68 74 6d 6c 2d 64 69 72 29 0a 20 20 20 20 20 html-dir).
8690: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
86a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
86b0: 20 20 20 20 20 28 64 69 72 65 63 74 6f 72 79 3f (directory?
86c0: 20 20 20 68 74 6d 6c 2d 64 69 72 29 0a 20 20 20 html-dir).
86d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
86e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
86f0: 20 20 20 20 20 20 20 28 66 69 6c 65 2d 77 72 69 (file-wri
8700: 74 65 2d 61 63 63 65 73 73 3f 20 68 74 6d 6c 2d te-access? html-
8710: 64 69 72 29 29 0a 20 20 20 20 20 20 20 20 20 20 dir)).
8720: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8730: 20 20 20 20 20 20 20 20 20 20 20 28 6f 70 65 6e (open
8740: 2d 6f 75 74 70 75 74 2d 66 69 6c 65 20 20 68 74 -output-file ht
8750: 6d 6c 2d 70 61 74 68 29 0a 20 20 20 20 20 20 20 ml-path).
8760: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8770: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 23 66 #f
8780: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
8790: 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 72 75 ;; (print "ru
87a0: 6e 2d 64 69 72 3a 20 22 20 72 75 6e 2d 64 69 72 n-dir: " run-dir
87b0: 20 22 2c 20 74 65 73 74 73 2d 74 72 65 65 2d 64 ", tests-tree-d
87c0: 61 74 3a 20 22 20 74 65 73 74 73 2d 74 72 65 65 at: " tests-tree
87d0: 2d 64 61 74 29 0a 20 20 20 20 20 20 20 20 20 20 -dat).
87e0: 20 20 20 20 20 28 69 66 20 6f 75 70 0a 20 20 20 (if oup.
87f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8800: 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 (begin.
8810: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 3a 6f (s:o
8820: 75 74 70 75 74 2d 6e 65 77 0a 20 20 20 20 20 20 utput-new.
8830: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8840: 6f 75 70 0a 20 20 20 20 20 20 20 20 20 20 20 20 oup.
8850: 20 20 20 20 20 20 20 20 20 20 28 73 3a 68 74 6d (s:htm
8860: 6c 20 74 65 73 74 73 3a 63 73 73 2d 6a 73 63 72 l tests:css-jscr
8870: 69 70 74 2d 62 6c 6f 63 6b 0a 20 20 20 20 20 20 ipt-block.
8880: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8890: 20 20 20 20 20 20 20 20 28 73 3a 74 69 74 6c 65 (s:title
88a0: 20 22 53 75 6d 6d 61 72 79 20 66 6f 72 20 22 20 "Summary for "
88b0: 61 72 65 61 2d 6e 61 6d 65 29 0a 20 20 20 20 20 area-name).
88c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
88d0: 20 20 20 20 20 20 20 20 20 28 73 3a 62 6f 64 79 (s:body
88e0: 20 27 6f 6e 6c 6f 61 64 20 22 61 64 64 45 76 65 'onload "addEve
88f0: 6e 74 73 28 29 3b 22 0a 20 20 20 20 20 20 20 20 nts();".
8900: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8910: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 (s
8920: 3a 68 31 20 22 53 75 6d 6d 61 72 79 20 66 6f 72 :h1 "Summary for
8930: 20 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 " (string-inter
8940: 73 70 65 72 73 65 20 72 75 6e 2d 64 69 72 20 22 sperse run-dir "
8950: 2f 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 /")).
8960: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8970: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 74 6f ;; to
8980: 70 20 6c 69 73 74 0a 20 20 20 20 20 20 20 20 20 p list.
8990: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
89a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 3a (s:
89b0: 75 6c 20 27 69 64 20 22 4c 69 6e 6b 65 64 4c 69 ul 'id "LinkedLi
89c0: 73 74 31 22 20 27 63 6c 61 73 73 20 22 4c 69 6e st1" 'class "Lin
89d0: 6b 65 64 4c 69 73 74 22 0a 20 20 20 20 20 20 20 kedList".
89e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
89f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8a00: 20 20 20 20 20 28 73 3a 6c 69 0a 20 20 20 20 20 (s:li.
8a10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8a20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8a30: 20 20 20 20 20 20 20 20 22 54 65 73 74 73 22 0a "Tests".
8a40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8a50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8a60: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
8a70: 6d 6d 6f 6e 3a 68 74 72 65 65 2d 3e 68 74 6d 6c mmon:htree->html
8a80: 20 74 65 73 74 73 2d 68 74 72 65 65 0a 20 20 20 tests-htree.
8a90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8aa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8ab0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8ac0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 27 28 '(
8ad0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
8ae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8af0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8b00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8b10: 20 20 20 28 6c 61 6d 62 64 61 20 28 78 20 70 29 (lambda (x p)
8b20: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
8b30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8b40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8b50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8b60: 20 20 20 20 28 6c 65 74 2a 20 28 28 74 61 72 67 (let* ((targ
8b70: 2d 70 61 74 68 20 28 73 74 72 69 6e 67 2d 69 6e -path (string-in
8b80: 74 65 72 73 70 65 72 73 65 20 70 20 22 2f 22 29 tersperse p "/")
8b90: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
8ba0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8bb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8bc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8bd0: 20 20 20 20 20 20 20 20 20 20 20 20 28 74 65 73 (tes
8be0: 74 2d 6e 61 6d 65 20 28 63 61 72 20 70 29 29 0a t-name (car p)).
8bf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8c00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8c10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8c20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8c30: 20 20 20 20 20 20 20 20 20 20 28 69 74 65 6d 2d (item-
8c40: 70 61 74 68 20 3b 3b 20 28 69 66 20 28 3e 20 28 path ;; (if (> (
8c50: 6c 65 6e 67 74 68 20 70 29 20 32 29 20 3b 3b 20 length p) 2) ;;
8c60: 74 65 73 74 2d 6e 61 6d 65 20 2b 20 72 75 6e 2d test-name + run-
8c70: 6e 61 6d 65 0a 20 20 20 20 20 20 20 20 20 20 20 name.
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 20 20 20 20 20 20
8ca0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8cb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8cc0: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
8cd0: 72 73 65 20 70 20 22 2f 22 29 29 0a 20 20 20 20 rse p "/")).
8ce0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8cf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8d00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8d10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8d20: 20 20 20 20 20 20 28 66 75 6c 6c 2d 74 61 72 67 (full-targ
8d30: 20 28 63 6f 6e 63 20 68 74 6d 6c 2d 64 69 72 20 (conc html-dir
8d40: 22 2f 22 20 74 61 72 67 2d 70 61 74 68 29 29 0a "/" targ-path)).
8d50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8d60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8d70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8d90: 20 20 20 20 20 20 20 20 20 20 28 73 74 64 2d 66 (std-f
8da0: 69 6c 65 20 20 28 63 6f 6e 63 20 66 75 6c 6c 2d ile (conc full-
8db0: 74 61 72 67 20 22 2f 74 65 73 74 2d 73 75 6d 6d targ "/test-summ
8dc0: 61 72 79 2e 68 74 6d 6c 22 29 29 0a 20 20 20 20 ary.html")).
8dd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8de0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8df0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8e00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8e10: 20 20 20 20 20 20 28 61 6c 74 2d 66 69 6c 65 20 (alt-file
8e20: 20 28 63 6f 6e 63 20 66 75 6c 6c 2d 74 61 72 67 (conc full-targ
8e30: 20 22 2f 6d 65 67 61 74 65 73 74 2d 72 6f 6c 6c "/megatest-roll
8e40: 75 70 2d 22 20 74 65 73 74 2d 6e 61 6d 65 20 22 up-" test-name "
8e50: 2e 68 74 6d 6c 22 29 29 0a 20 20 20 20 20 20 20 .html")).
8e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8e70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8e80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8e90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8ea0: 20 20 20 28 68 74 6d 6c 2d 66 69 6c 65 20 28 69 (html-file (i
8eb0: 66 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 f (common:file-e
8ec0: 78 69 73 74 73 3f 20 61 6c 74 2d 66 69 6c 65 29 xists? alt-file)
8ed0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
8ee0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8ef0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8f00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8f10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8f20: 20 20 20 20 20 20 20 20 20 20 61 6c 74 2d 66 69 alt-fi
8f30: 6c 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 le.
8f40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8f50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8f60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8f70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8f80: 20 20 20 20 20 20 20 20 20 20 20 20 73 74 64 2d std-
8f90: 66 69 6c 65 29 29 0a 20 20 20 20 20 20 20 20 20 file)).
8fa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8fb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8fc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8fd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8fe0: 20 28 72 75 6e 2d 6e 61 6d 65 20 20 28 63 61 72 (run-name (car
8ff0: 20 28 72 65 76 65 72 73 65 20 70 29 29 29 29 0a (reverse p)))).
9000: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9010: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9020: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9030: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9040: 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 6e (if (and (n
9050: 6f 74 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d ot (common:file-
9060: 65 78 69 73 74 73 3f 20 66 75 6c 6c 2d 74 61 72 exists? full-tar
9070: 67 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 g)).
9080: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9090: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
90a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
90b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
90c0: 20 20 28 64 69 72 65 63 74 6f 72 79 3f 20 66 75 (directory? fu
90d0: 6c 6c 2d 74 61 72 67 29 0a 20 20 20 20 20 20 20 ll-targ).
90e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
90f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9100: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9110: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9120: 20 20 20 20 20 20 20 28 66 69 6c 65 2d 77 72 69 (file-wri
9130: 74 65 2d 61 63 63 65 73 73 3f 20 66 75 6c 6c 2d te-access? full-
9140: 74 61 72 67 29 29 0a 20 20 20 20 20 20 20 20 20 targ)).
9150: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9160: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9170: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9180: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9190: 28 74 65 73 74 73 3a 73 75 6d 6d 61 72 69 7a 65 (tests:summarize
91a0: 2d 74 65 73 74 20 0a 20 20 20 20 20 20 20 20 20 -test .
91b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
91c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
91d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
91e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
91f0: 20 72 75 6e 2d 69 64 20 0a 20 20 20 20 20 20 20 run-id .
9200: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9210: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9230: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9240: 20 20 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 (rmt:get-test
9250: 2d 69 64 20 72 75 6e 2d 69 64 20 74 65 73 74 2d -id run-id test-
9260: 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 29 name item-path))
9270: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
9280: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
92a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
92b0: 20 20 20 20 20 20 20 28 69 66 20 28 63 6f 6d 6d (if (comm
92c0: 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 on:file-exists?
92d0: 66 75 6c 6c 2d 74 61 72 67 29 0a 20 20 20 20 20 full-targ).
92e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
92f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9300: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9320: 20 20 20 20 28 73 3a 61 20 72 75 6e 2d 6e 61 6d (s:a run-nam
9330: 65 20 27 68 72 65 66 20 68 74 6d 6c 2d 66 69 6c e 'href html-fil
9340: 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 e).
9350: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9360: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9380: 20 20 20 20 20 20 20 20 20 20 20 20 28 62 65 67 (beg
9390: 69 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 in.
93a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
93b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
93c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
93d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 64 (d
93e0: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 ebug:print 0 *de
93f0: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
9400: 22 45 52 52 4f 52 3a 20 63 61 6e 27 74 20 61 63 "ERROR: can't ac
9410: 63 65 73 73 20 22 20 66 75 6c 6c 2d 74 61 72 67 cess " full-targ
9420: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
9430: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9440: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9450: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9460: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
9470: 6e 63 20 22 4e 6f 20 73 75 6d 6d 61 72 79 20 66 nc "No summary f
9480: 6f 72 20 22 20 72 75 6e 2d 6e 61 6d 65 29 29 29 or " run-name)))
9490: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
94a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
94b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
94c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
94d0: 20 20 20 20 29 29 29 29 29 29 0a 20 20 20 20 20 )))))).
94e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
94f0: 28 63 6c 6f 73 65 2d 6f 75 74 70 75 74 2d 70 6f (close-output-po
9500: 72 74 20 6f 75 70 29 29 29 29 29 0a 20 20 20 20 rt oup))))).
9510: 20 20 20 20 20 20 20 72 75 6e 73 29 0a 20 20 20 runs).
9520: 20 20 20 20 20 20 20 23 74 29 0a 09 23 66 29 29 #t)..#f))
9530: 29 0a 0a 0a 0a 0a 0a 0a 0a 3b 3b 20 43 48 45 43 )........;; CHEC
9540: 4b 20 2d 20 57 41 53 20 54 48 49 53 20 41 44 44 K - WAS THIS ADD
9550: 45 44 20 4f 52 20 52 45 4d 4f 56 45 44 3f 20 4d ED OR REMOVED? M
9560: 41 4e 55 41 4c 20 4d 45 52 47 45 20 57 49 54 48 ANUAL MERGE WITH
9570: 20 41 50 49 20 53 54 55 46 46 21 21 21 0a 3b 3b API STUFF!!!.;;
9580: 0a 3b 3b 20 67 65 74 20 61 20 70 72 65 74 74 79 .;; get a pretty
9590: 20 74 61 62 6c 65 20 74 6f 20 73 75 6d 6d 61 72 table to summar
95a0: 69 7a 65 20 73 74 65 70 73 0a 3b 3b 0a 3b 3b 20 ize steps.;;.;;
95b0: 28 64 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e (define (dcommon
95c0: 3a 70 72 6f 63 65 73 73 2d 73 74 65 70 73 2d 74 :process-steps-t
95d0: 61 62 6c 65 20 73 74 65 70 73 29 3b 3b 20 64 62 able steps);; db
95e0: 20 74 65 73 74 2d 69 64 20 23 21 6b 65 79 20 28 test-id #!key (
95f0: 77 6f 72 6b 2d 61 72 65 61 20 23 66 29 29 0a 28 work-area #f)).(
9600: 64 65 66 69 6e 65 20 28 74 65 73 74 73 3a 70 72 define (tests:pr
9610: 6f 63 65 73 73 2d 73 74 65 70 73 2d 74 61 62 6c ocess-steps-tabl
9620: 65 20 73 74 65 70 73 29 3b 3b 20 64 62 20 74 65 e steps);; db te
9630: 73 74 2d 69 64 20 23 21 6b 65 79 20 28 77 6f 72 st-id #!key (wor
9640: 6b 2d 61 72 65 61 20 23 66 29 29 0a 3b 3b 20 20 k-area #f)).;;
9650: 28 6c 65 74 20 28 28 73 74 65 70 73 20 20 20 28 (let ((steps (
9660: 64 62 3a 67 65 74 2d 73 74 65 70 73 2d 66 6f 72 db:get-steps-for
9670: 2d 74 65 73 74 20 64 62 20 74 65 73 74 2d 69 64 -test db test-id
9680: 20 77 6f 72 6b 2d 61 72 65 61 3a 20 77 6f 72 6b work-area: work
9690: 2d 61 72 65 61 29 29 29 0a 20 20 20 20 3b 3b 20 -area))). ;;
96a0: 6f 72 67 61 6e 69 73 65 20 74 68 65 20 73 74 65 organise the ste
96b0: 70 73 20 66 6f 72 20 62 65 74 74 65 72 20 72 65 ps for better re
96c0: 61 64 61 62 69 6c 69 74 79 0a 20 20 20 20 28 6c adability. (l
96d0: 65 74 20 28 28 72 65 73 20 28 6d 61 6b 65 2d 68 et ((res (make-h
96e0: 61 73 68 2d 74 61 62 6c 65 29 29 29 0a 20 20 20 ash-table))).
96f0: 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 20 20 (for-each .
9700: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 73 74 (lambda (st
9710: 65 70 29 0a 09 20 28 64 65 62 75 67 3a 70 72 69 ep).. (debug:pri
9720: 6e 74 20 36 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 6 *default-lo
9730: 67 2d 70 6f 72 74 2a 20 22 73 74 65 70 3d 22 20 g-port* "step="
9740: 73 74 65 70 29 0a 09 20 28 6c 65 74 20 28 28 72 step).. (let ((r
9750: 65 63 6f 72 64 20 28 68 61 73 68 2d 74 61 62 6c ecord (hash-tabl
9760: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 0a 09 e-ref/default ..
9770: 09 09 72 65 73 20 0a 09 09 09 28 74 64 62 3a 73 ..res ....(tdb:s
9780: 74 65 70 2d 67 65 74 2d 73 74 65 70 6e 61 6d 65 tep-get-stepname
9790: 20 73 74 65 70 29 0a 09 09 09 3b 3b 20 20 20 20 step)....;;
97a0: 20 20 20 20 20 20 20 30 20 20 20 20 20 20 20 20 0
97b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 31 20 1
97c0: 20 20 20 32 20 20 20 20 33 20 20 20 20 20 20 20 2 3
97d0: 34 20 20 20 20 20 20 20 20 20 35 20 20 20 20 20 4 5
97e0: 20 20 36 20 20 20 20 20 20 20 37 0a 09 09 09 3b 6 7....;
97f0: 3b 20 20 20 20 20 20 20 20 73 74 65 70 6e 61 6d ; stepnam
9800: 65 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 e
9810: 20 73 74 61 72 74 20 65 6e 64 20 73 74 61 74 75 start end statu
9820: 73 20 44 75 72 61 74 69 6f 6e 20 20 4c 6f 67 66 s Duration Logf
9830: 69 6c 65 20 43 6f 6d 6d 65 6e 74 20 20 66 69 72 ile Comment fir
9840: 73 74 2d 69 64 0a 09 09 09 28 76 65 63 74 6f 72 st-id....(vector
9850: 20 28 74 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 (tdb:step-get-s
9860: 74 65 70 6e 61 6d 65 20 73 74 65 70 29 20 22 22 tepname step) ""
9870: 20 20 20 22 22 20 22 22 20 20 20 20 20 22 22 20 "" "" ""
9880: 20 20 20 20 20 20 20 22 22 20 20 20 20 20 22 22 "" ""
9890: 20 20 20 20 20 20 20 23 66 29 29 29 29 0a 09 20 #f))))..
98a0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 36 (debug:print 6
98b0: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
98c0: 72 74 2a 20 22 72 65 63 6f 72 64 28 62 65 66 6f rt* "record(befo
98d0: 72 65 29 20 3d 20 22 20 72 65 63 6f 72 64 20 0a re) = " record .
98e0: 09 09 09 22 5c 6e 69 64 3a 20 20 20 20 20 20 20 ..."\nid:
98f0: 22 20 28 74 64 62 3a 73 74 65 70 2d 67 65 74 2d " (tdb:step-get-
9900: 69 64 20 73 74 65 70 29 0a 09 09 09 22 5c 6e 73 id step)...."\ns
9910: 74 65 70 6e 61 6d 65 3a 20 22 20 28 74 64 62 3a tepname: " (tdb:
9920: 73 74 65 70 2d 67 65 74 2d 73 74 65 70 6e 61 6d step-get-stepnam
9930: 65 20 73 74 65 70 29 0a 09 09 09 22 5c 6e 73 74 e step)...."\nst
9940: 61 74 65 3a 20 20 20 20 22 20 28 74 64 62 3a 73 ate: " (tdb:s
9950: 74 65 70 2d 67 65 74 2d 73 74 61 74 65 20 73 74 tep-get-state st
9960: 65 70 29 0a 09 09 09 22 5c 6e 73 74 61 74 75 73 ep)...."\nstatus
9970: 3a 20 20 20 22 20 28 74 64 62 3a 73 74 65 70 2d : " (tdb:step-
9980: 67 65 74 2d 73 74 61 74 75 73 20 73 74 65 70 29 get-status step)
9990: 0a 09 09 09 22 5c 6e 74 69 6d 65 3a 20 20 20 20 ...."\ntime:
99a0: 20 22 20 28 74 64 62 3a 73 74 65 70 2d 67 65 74 " (tdb:step-get
99b0: 2d 65 76 65 6e 74 5f 74 69 6d 65 20 73 74 65 70 -event_time step
99c0: 29 29 0a 09 20 20 20 28 69 66 20 28 6e 6f 74 20 )).. (if (not
99d0: 28 76 65 63 74 6f 72 2d 72 65 66 20 72 65 63 6f (vector-ref reco
99e0: 72 64 20 37 29 29 28 76 65 63 74 6f 72 2d 73 65 rd 7))(vector-se
99f0: 74 21 20 72 65 63 6f 72 64 20 37 20 28 74 64 62 t! record 7 (tdb
9a00: 3a 73 74 65 70 2d 67 65 74 2d 69 64 20 73 74 65 :step-get-id ste
9a10: 70 29 29 29 20 3b 3b 20 64 6f 20 6e 6f 74 20 63 p))) ;; do not c
9a20: 6c 6f 62 62 65 72 20 74 68 65 20 69 64 20 69 66 lobber the id if
9a30: 20 70 72 65 76 69 6f 75 73 6c 79 20 73 65 74 0a previously set.
9a40: 09 20 20 20 28 63 61 73 65 20 28 73 74 72 69 6e . (case (strin
9a50: 67 2d 3e 73 79 6d 62 6f 6c 20 28 74 64 62 3a 73 g->symbol (tdb:s
9a60: 74 65 70 2d 67 65 74 2d 73 74 61 74 65 20 73 74 tep-get-state st
9a70: 65 70 29 29 0a 09 20 20 20 20 20 28 28 73 74 61 ep)).. ((sta
9a80: 72 74 29 28 76 65 63 74 6f 72 2d 73 65 74 21 20 rt)(vector-set!
9a90: 72 65 63 6f 72 64 20 31 20 28 74 64 62 3a 73 74 record 1 (tdb:st
9aa0: 65 70 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d ep-get-event_tim
9ab0: 65 20 73 74 65 70 29 29 0a 09 20 20 20 20 20 20 e step))..
9ac0: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 72 65 63 (vector-set! rec
9ad0: 6f 72 64 20 33 20 28 69 66 20 28 65 71 75 61 6c ord 3 (if (equal
9ae0: 3f 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 65 ? (vector-ref re
9af0: 63 6f 72 64 20 33 29 20 22 22 29 0a 09 09 09 09 cord 3) "").....
9b00: 09 28 74 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 .(tdb:step-get-s
9b10: 74 61 74 75 73 20 73 74 65 70 29 29 29 0a 09 20 tatus step)))..
9b20: 20 20 20 20 20 28 69 66 20 28 3e 20 28 73 74 72 (if (> (str
9b30: 69 6e 67 2d 6c 65 6e 67 74 68 20 28 74 64 62 3a ing-length (tdb:
9b40: 73 74 65 70 2d 67 65 74 2d 6c 6f 67 66 69 6c 65 step-get-logfile
9b50: 20 73 74 65 70 29 29 0a 09 09 20 20 20 20 20 30 step))... 0
9b60: 29 0a 09 09 20 20 28 76 65 63 74 6f 72 2d 73 65 )... (vector-se
9b70: 74 21 20 72 65 63 6f 72 64 20 35 20 28 74 64 62 t! record 5 (tdb
9b80: 3a 73 74 65 70 2d 67 65 74 2d 6c 6f 67 66 69 6c :step-get-logfil
9b90: 65 20 73 74 65 70 29 29 29 29 0a 09 20 20 20 20 e step))))..
9ba0: 20 28 28 65 6e 64 29 20 20 0a 09 20 20 20 20 20 ((end) ..
9bb0: 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 72 65 (vector-set! re
9bc0: 63 6f 72 64 20 32 20 28 61 6e 79 2d 3e 6e 75 6d cord 2 (any->num
9bd0: 62 65 72 20 28 74 64 62 3a 73 74 65 70 2d 67 65 ber (tdb:step-ge
9be0: 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 73 74 65 t-event_time ste
9bf0: 70 29 29 29 0a 09 20 20 20 20 20 20 28 76 65 63 p))).. (vec
9c00: 74 6f 72 2d 73 65 74 21 20 72 65 63 6f 72 64 20 tor-set! record
9c10: 33 20 28 74 64 62 3a 73 74 65 70 2d 67 65 74 2d 3 (tdb:step-get-
9c20: 73 74 61 74 75 73 20 73 74 65 70 29 29 0a 09 20 status step))..
9c30: 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 (vector-set
9c40: 21 20 72 65 63 6f 72 64 20 34 20 28 6c 65 74 20 ! record 4 (let
9c50: 28 28 73 74 61 72 74 74 20 28 61 6e 79 2d 3e 6e ((startt (any->n
9c60: 75 6d 62 65 72 20 28 76 65 63 74 6f 72 2d 72 65 umber (vector-re
9c70: 66 20 72 65 63 6f 72 64 20 31 29 29 29 0a 09 09 f record 1)))...
9c80: 09 09 09 20 20 28 65 6e 64 74 20 20 20 28 61 6e ... (endt (an
9c90: 79 2d 3e 6e 75 6d 62 65 72 20 28 76 65 63 74 6f y->number (vecto
9ca0: 72 2d 72 65 66 20 72 65 63 6f 72 64 20 32 29 29 r-ref record 2))
9cb0: 29 29 0a 09 09 09 09 20 20 20 20 20 20 28 64 65 ))..... (de
9cc0: 62 75 67 3a 70 72 69 6e 74 20 34 20 2a 64 65 66 bug:print 4 *def
9cd0: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
9ce0: 72 65 63 6f 72 64 5b 31 5d 3d 22 20 28 76 65 63 record[1]=" (vec
9cf0: 74 6f 72 2d 72 65 66 20 72 65 63 6f 72 64 20 31 tor-ref record 1
9d00: 29 20 0a 09 09 09 09 09 09 20 20 20 22 2c 20 73 ) ....... ", s
9d10: 74 61 72 74 74 3d 22 20 73 74 61 72 74 74 20 22 tartt=" startt "
9d20: 2c 20 65 6e 64 74 3d 22 20 65 6e 64 74 0a 09 09 , endt=" endt...
9d30: 09 09 09 09 20 20 20 22 2c 20 67 65 74 2d 73 74 .... ", get-st
9d40: 61 74 75 73 3a 20 22 20 28 74 64 62 3a 73 74 65 atus: " (tdb:ste
9d50: 70 2d 67 65 74 2d 73 74 61 74 75 73 20 73 74 65 p-get-status ste
9d60: 70 29 29 0a 09 09 09 09 20 20 20 20 20 20 28 69 p))..... (i
9d70: 66 20 28 61 6e 64 20 28 6e 75 6d 62 65 72 3f 20 f (and (number?
9d80: 73 74 61 72 74 74 29 28 6e 75 6d 62 65 72 3f 20 startt)(number?
9d90: 65 6e 64 74 29 29 0a 09 09 09 09 09 20 20 28 73 endt))...... (s
9da0: 65 63 6f 6e 64 73 2d 3e 68 72 2d 6d 69 6e 2d 73 econds->hr-min-s
9db0: 65 63 20 28 2d 20 65 6e 64 74 20 73 74 61 72 74 ec (- endt start
9dc0: 74 29 29 20 22 2d 31 22 29 29 29 0a 09 20 20 20 t)) "-1")))..
9dd0: 20 20 20 28 69 66 20 28 3e 20 28 73 74 72 69 6e (if (> (strin
9de0: 67 2d 6c 65 6e 67 74 68 20 28 74 64 62 3a 73 74 g-length (tdb:st
9df0: 65 70 2d 67 65 74 2d 6c 6f 67 66 69 6c 65 20 73 ep-get-logfile s
9e00: 74 65 70 29 29 0a 09 09 20 20 20 20 20 30 29 0a tep))... 0).
9e10: 09 09 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 .. (vector-set!
9e20: 20 72 65 63 6f 72 64 20 35 20 28 74 64 62 3a 73 record 5 (tdb:s
9e30: 74 65 70 2d 67 65 74 2d 6c 6f 67 66 69 6c 65 20 tep-get-logfile
9e40: 73 74 65 70 29 29 29 0a 09 20 20 20 20 20 20 28 step))).. (
9e50: 69 66 20 28 3e 20 28 73 74 72 69 6e 67 2d 6c 65 if (> (string-le
9e60: 6e 67 74 68 20 28 74 64 62 3a 73 74 65 70 2d 67 ngth (tdb:step-g
9e70: 65 74 2d 63 6f 6d 6d 65 6e 74 20 73 74 65 70 29 et-comment step)
9e80: 29 0a 09 09 20 20 20 20 20 30 29 0a 09 09 20 20 )... 0)...
9e90: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 72 65 63 (vector-set! rec
9ea0: 6f 72 64 20 36 20 28 74 64 62 3a 73 74 65 70 2d ord 6 (tdb:step-
9eb0: 67 65 74 2d 63 6f 6d 6d 65 6e 74 20 73 74 65 70 get-comment step
9ec0: 29 29 29 29 0a 09 20 20 20 20 20 28 65 6c 73 65 )))).. (else
9ed0: 0a 09 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d .. (vector-
9ee0: 73 65 74 21 20 72 65 63 6f 72 64 20 32 20 28 74 set! record 2 (t
9ef0: 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 61 74 db:step-get-stat
9f00: 65 20 73 74 65 70 29 29 0a 09 20 20 20 20 20 20 e step))..
9f10: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 72 65 63 (vector-set! rec
9f20: 6f 72 64 20 33 20 28 74 64 62 3a 73 74 65 70 2d ord 3 (tdb:step-
9f30: 67 65 74 2d 73 74 61 74 75 73 20 73 74 65 70 29 get-status step)
9f40: 29 0a 09 20 20 20 20 20 20 28 76 65 63 74 6f 72 ).. (vector
9f50: 2d 73 65 74 21 20 72 65 63 6f 72 64 20 34 20 28 -set! record 4 (
9f60: 74 64 62 3a 73 74 65 70 2d 67 65 74 2d 65 76 65 tdb:step-get-eve
9f70: 6e 74 5f 74 69 6d 65 20 73 74 65 70 29 29 0a 09 nt_time step))..
9f80: 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 (vector-se
9f90: 74 21 20 72 65 63 6f 72 64 20 36 20 28 74 64 62 t! record 6 (tdb
9fa0: 3a 73 74 65 70 2d 67 65 74 2d 63 6f 6d 6d 65 6e :step-get-commen
9fb0: 74 20 73 74 65 70 29 29 29 29 0a 09 20 20 20 28 t step)))).. (
9fc0: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set!
9fd0: 72 65 73 20 28 74 64 62 3a 73 74 65 70 2d 67 65 res (tdb:step-ge
9fe0: 74 2d 73 74 65 70 6e 61 6d 65 20 73 74 65 70 29 t-stepname step)
9ff0: 20 72 65 63 6f 72 64 29 0a 09 20 20 20 28 64 65 record).. (de
a000: 62 75 67 3a 70 72 69 6e 74 20 36 20 2a 64 65 66 bug:print 6 *def
a010: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
a020: 72 65 63 6f 72 64 28 61 66 74 65 72 29 20 20 3d record(after) =
a030: 20 22 20 72 65 63 6f 72 64 20 0a 09 09 09 22 5c " record ...."\
a040: 6e 69 64 3a 20 20 20 20 20 20 20 22 20 28 74 64 nid: " (td
a050: 62 3a 73 74 65 70 2d 67 65 74 2d 69 64 20 73 74 b:step-get-id st
a060: 65 70 29 0a 09 09 09 22 5c 6e 73 74 65 70 6e 61 ep)...."\nstepna
a070: 6d 65 3a 20 22 20 28 74 64 62 3a 73 74 65 70 2d me: " (tdb:step-
a080: 67 65 74 2d 73 74 65 70 6e 61 6d 65 20 73 74 65 get-stepname ste
a090: 70 29 0a 09 09 09 22 5c 6e 73 74 61 74 65 3a 20 p)...."\nstate:
a0a0: 20 20 20 22 20 28 74 64 62 3a 73 74 65 70 2d 67 " (tdb:step-g
a0b0: 65 74 2d 73 74 61 74 65 20 73 74 65 70 29 0a 09 et-state step)..
a0c0: 09 09 22 5c 6e 73 74 61 74 75 73 3a 20 20 20 22 .."\nstatus: "
a0d0: 20 28 74 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 (tdb:step-get-s
a0e0: 74 61 74 75 73 20 73 74 65 70 29 0a 09 09 09 22 tatus step)...."
a0f0: 5c 6e 74 69 6d 65 3a 20 20 20 20 20 22 20 28 74 \ntime: " (t
a100: 64 62 3a 73 74 65 70 2d 67 65 74 2d 65 76 65 6e db:step-get-even
a110: 74 5f 74 69 6d 65 20 73 74 65 70 29 29 29 29 0a t_time step)))).
a120: 20 20 20 20 20 20 20 3b 3b 20 28 65 6c 73 65 20 ;; (else
a130: 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 72 (vector-set! r
a140: 65 63 6f 72 64 20 31 20 28 74 64 62 3a 73 74 65 ecord 1 (tdb:ste
a150: 70 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 p-get-event_time
a160: 20 73 74 65 70 29 29 29 0a 20 20 20 20 20 20 20 step))).
a170: 28 73 6f 72 74 20 73 74 65 70 73 20 28 6c 61 6d (sort steps (lam
a180: 62 64 61 20 28 61 20 62 29 0a 09 09 20 20 20 20 bda (a b)...
a190: 20 28 63 6f 6e 64 0a 09 09 20 20 20 20 20 20 28 (cond... (
a1a0: 28 3c 20 20 20 28 74 64 62 3a 73 74 65 70 2d 67 (< (tdb:step-g
a1b0: 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 61 29 et-event_time a)
a1c0: 28 74 64 62 3a 73 74 65 70 2d 67 65 74 2d 65 76 (tdb:step-get-ev
a1d0: 65 6e 74 5f 74 69 6d 65 20 62 29 29 20 23 74 29 ent_time b)) #t)
a1e0: 0a 09 09 20 20 20 20 20 20 28 28 65 71 3f 20 28 ... ((eq? (
a1f0: 74 64 62 3a 73 74 65 70 2d 67 65 74 2d 65 76 65 tdb:step-get-eve
a200: 6e 74 5f 74 69 6d 65 20 61 29 28 74 64 62 3a 73 nt_time a)(tdb:s
a210: 74 65 70 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 tep-get-event_ti
a220: 6d 65 20 62 29 29 20 0a 09 09 20 20 20 20 20 20 me b)) ...
a230: 20 28 3c 20 20 20 28 74 64 62 3a 73 74 65 70 2d (< (tdb:step-
a240: 67 65 74 2d 69 64 20 61 29 20 20 20 20 20 20 20 get-id a)
a250: 20 28 74 64 62 3a 73 74 65 70 2d 67 65 74 2d 69 (tdb:step-get-i
a260: 64 20 62 29 29 29 0a 09 09 20 20 20 20 20 20 28 d b)))... (
a270: 65 6c 73 65 20 23 66 29 29 29 29 29 0a 20 20 20 else #f))))).
a280: 20 20 20 72 65 73 29 29 0a 0a 3b 3b 20 0a 3b 3b res))..;; .;;
a290: 0a 28 64 65 66 69 6e 65 20 28 74 65 73 74 73 3a .(define (tests:
a2a0: 67 65 74 2d 63 6f 6d 70 72 65 73 73 65 64 2d 73 get-compressed-s
a2b0: 74 65 70 73 20 72 75 6e 2d 69 64 20 74 65 73 74 teps run-id test
a2c0: 2d 69 64 29 0a 20 20 28 6c 65 74 2a 20 28 28 73 -id). (let* ((s
a2d0: 74 65 70 73 2d 64 61 74 61 20 20 28 72 6d 74 3a teps-data (rmt:
a2e0: 67 65 74 2d 73 74 65 70 73 2d 66 6f 72 2d 74 65 get-steps-for-te
a2f0: 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 st run-id test-i
a300: 64 29 29 20 3b 3b 20 20 20 20 20 20 30 20 20 20 d)) ;; 0
a310: 20 20 20 20 31 20 20 20 20 32 20 20 20 20 33 20 1 2 3
a320: 20 20 20 20 20 20 34 20 20 20 20 20 20 20 35 20 4 5
a330: 20 20 20 20 20 20 36 20 20 20 20 20 20 37 20 20 6 7
a340: 20 20 20 20 20 0a 09 20 28 63 6f 6d 70 72 73 74 .. (comprst
a350: 65 70 73 20 20 28 74 65 73 74 73 3a 70 72 6f 63 eps (tests:proc
a360: 65 73 73 2d 73 74 65 70 73 2d 74 61 62 6c 65 20 ess-steps-table
a370: 73 74 65 70 73 2d 64 61 74 61 29 29 29 20 3b 3b steps-data))) ;;
a380: 20 23 3c 73 74 65 70 6e 61 6d 65 20 73 74 61 72 #<stepname star
a390: 74 20 65 6e 64 20 73 74 61 74 75 73 20 44 75 72 t end status Dur
a3a0: 61 74 69 6f 6e 20 4c 6f 67 66 69 6c 65 20 43 6f ation Logfile Co
a3b0: 6d 6d 65 6e 74 20 69 64 3e 0a 20 20 20 20 28 6d mment id>. (m
a3c0: 61 70 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 ap (lambda (x)..
a3d0: 20 20 20 3b 3b 20 74 61 6b 65 20 61 64 76 61 6e ;; take advan
a3e0: 74 61 67 65 20 6f 66 20 74 68 65 20 5c 6e 20 6f tage of the \n o
a3f0: 6e 20 74 69 6d 65 2d 3e 73 74 72 69 6e 67 0a 09 n time->string..
a400: 20 20 20 28 76 65 63 74 6f 72 20 20 20 20 3b 3b (vector ;;
a410: 20 77 65 20 61 72 65 20 63 6f 6e 73 74 72 75 63 we are construc
a420: 74 69 6e 67 20 62 61 73 69 63 61 6c 6c 79 20 74 ting basically t
a430: 68 65 20 6f 72 69 67 69 6e 61 6c 20 76 65 63 74 he original vect
a440: 6f 72 20 62 75 74 20 63 6f 6c 6c 61 70 73 69 6e or but collapsin
a450: 67 20 73 74 61 72 74 20 65 6e 64 20 72 65 63 6f g start end reco
a460: 72 64 73 0a 09 20 20 20 20 28 76 65 63 74 6f 72 rds.. (vector
a470: 2d 72 65 66 20 78 20 30 29 20 20 20 20 20 20 20 -ref x 0)
a480: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a490: 20 20 20 20 20 20 20 3b 3b 20 69 64 20 20 20 20 ;; id
a4a0: 20 20 20 20 30 0a 09 20 20 20 20 28 6c 65 74 20 0.. (let
a4b0: 28 28 73 20 28 76 65 63 74 6f 72 2d 72 65 66 20 ((s (vector-ref
a4c0: 78 20 31 29 29 29 0a 09 20 20 20 20 20 20 28 69 x 1))).. (i
a4d0: 66 20 28 6e 75 6d 62 65 72 3f 20 73 29 28 73 65 f (number? s)(se
a4e0: 63 6f 6e 64 73 2d 3e 74 69 6d 65 2d 73 74 72 69 conds->time-stri
a4f0: 6e 67 20 73 29 20 73 29 29 20 3b 3b 20 73 74 61 ng s) s)) ;; sta
a500: 72 74 74 69 6d 65 20 31 0a 09 20 20 20 20 28 6c rttime 1.. (l
a510: 65 74 20 28 28 73 20 28 76 65 63 74 6f 72 2d 72 et ((s (vector-r
a520: 65 66 20 78 20 32 29 29 29 0a 09 20 20 20 20 20 ef x 2)))..
a530: 20 28 69 66 20 28 6e 75 6d 62 65 72 3f 20 73 29 (if (number? s)
a540: 28 73 65 63 6f 6e 64 73 2d 3e 74 69 6d 65 2d 73 (seconds->time-s
a550: 74 72 69 6e 67 20 73 29 20 73 29 29 20 3b 3b 20 tring s) s)) ;;
a560: 65 6e 64 74 69 6d 65 20 20 20 32 0a 09 20 20 20 endtime 2..
a570: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 78 20 33 (vector-ref x 3
a580: 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 )
a590: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
a5a0: 3b 20 73 74 61 74 75 73 20 20 20 20 33 20 20 20 ; status 3
a5b0: 20 0a 09 20 20 20 20 28 76 65 63 74 6f 72 2d 72 .. (vector-r
a5c0: 65 66 20 78 20 34 29 20 20 20 20 20 20 20 20 20 ef x 4)
a5d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a5e0: 20 20 20 20 20 3b 3b 20 64 75 72 61 74 69 6f 6e ;; duration
a5f0: 20 20 34 0a 09 20 20 20 20 28 76 65 63 74 6f 72 4.. (vector
a600: 2d 72 65 66 20 78 20 35 29 20 20 20 20 20 20 20 -ref x 5)
a610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a620: 20 20 20 20 20 20 20 3b 3b 20 6c 6f 67 66 69 6c ;; logfil
a630: 65 20 20 20 35 0a 09 20 20 20 20 28 76 65 63 74 e 5.. (vect
a640: 6f 72 2d 72 65 66 20 78 20 36 29 20 20 20 20 20 or-ref x 6)
a650: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a660: 20 20 20 20 20 20 20 20 20 3b 3b 20 63 6f 6d 6d ;; comm
a670: 65 6e 74 20 20 20 36 0a 09 20 20 20 20 28 76 65 ent 6.. (ve
a680: 63 74 6f 72 2d 72 65 66 20 78 20 37 29 29 29 20 ctor-ref x 7)))
a690: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a6a0: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 69 64 ;; id
a6b0: 20 20 20 20 20 20 20 20 37 0a 09 20 28 73 6f 72 7.. (sor
a6c0: 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 76 61 t (hash-table-va
a6d0: 6c 75 65 73 20 63 6f 6d 70 72 73 74 65 70 73 29 lues comprsteps)
a6e0: 0a 09 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 .. (lambda
a6f0: 20 28 61 20 62 29 0a 09 09 20 28 6c 65 74 20 28 (a b)... (let (
a700: 28 74 69 6d 65 2d 61 20 28 76 65 63 74 6f 72 2d (time-a (vector-
a710: 72 65 66 20 61 20 31 29 29 0a 09 09 20 20 20 20 ref a 1))...
a720: 20 20 20 28 74 69 6d 65 2d 62 20 28 76 65 63 74 (time-b (vect
a730: 6f 72 2d 72 65 66 20 62 20 31 29 29 0a 09 09 20 or-ref b 1))...
a740: 20 20 20 20 20 20 28 69 64 2d 61 20 20 20 28 76 (id-a (v
a750: 65 63 74 6f 72 2d 72 65 66 20 61 20 37 29 29 0a ector-ref a 7)).
a760: 09 09 20 20 20 20 20 20 20 28 69 64 2d 62 20 20 .. (id-b
a770: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 62 20 37 (vector-ref b 7
a780: 29 29 29 0a 09 09 20 20 20 28 69 66 20 28 61 6e )))... (if (an
a790: 64 20 28 6e 75 6d 62 65 72 3f 20 74 69 6d 65 2d d (number? time-
a7a0: 61 29 28 6e 75 6d 62 65 72 3f 20 74 69 6d 65 2d a)(number? time-
a7b0: 62 29 29 0a 09 09 20 20 20 20 20 20 20 28 69 66 b))... (if
a7c0: 20 28 3c 20 74 69 6d 65 2d 61 20 74 69 6d 65 2d (< time-a time-
a7d0: 62 29 0a 09 09 09 20 20 20 23 74 0a 09 09 09 20 b).... #t....
a7e0: 20 20 28 69 66 20 28 65 71 3f 20 74 69 6d 65 2d (if (eq? time-
a7f0: 61 20 74 69 6d 65 2d 62 29 0a 09 09 09 20 20 20 a time-b)....
a800: 20 20 20 20 28 3c 20 69 64 2d 61 20 69 64 2d 62 (< id-a id-b
a810: 29 0a 09 09 09 20 20 20 20 20 20 20 3b 3b 20 28 ).... ;; (
a820: 73 74 72 69 6e 67 3c 3f 20 28 63 6f 6e 63 20 28 string<? (conc (
a830: 76 65 63 74 6f 72 2d 72 65 66 20 61 20 32 29 29 vector-ref a 2))
a840: 0a 09 09 09 20 20 20 20 20 20 20 3b 3b 09 20 20 .... ;;.
a850: 20 20 28 63 6f 6e 63 20 28 76 65 63 74 6f 72 2d (conc (vector-
a860: 72 65 66 20 62 20 32 29 29 29 0a 09 09 09 20 20 ref b 2)))....
a870: 20 20 20 20 20 23 66 29 29 0a 09 09 20 20 20 20 #f))...
a880: 20 20 20 28 73 74 72 69 6e 67 3c 3f 20 28 63 6f (string<? (co
a890: 6e 63 20 74 69 6d 65 2d 61 29 28 63 6f 6e 63 20 nc time-a)(conc
a8a0: 74 69 6d 65 2d 62 29 29 29 29 29 29 29 29 29 0a time-b))))))))).
a8b0: 0a 0a 3b 3b 20 53 61 76 65 20 74 65 73 74 20 73 ..;; Save test s
a8c0: 74 61 74 65 20 61 6e 64 20 73 74 61 74 75 73 20 tate and status
a8d0: 69 6e 20 74 6f 20 61 20 66 69 6c 65 20 2e 66 69 in to a file .fi
a8e0: 6e 61 6c 2d 73 74 61 74 75 73 20 69 6e 20 74 68 nal-status in th
a8f0: 65 20 74 65 73 74 20 64 69 72 65 63 74 6f 72 79 e test directory
a900: 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 74 65 73 .;;.(define (tes
a910: 74 73 3a 73 61 76 65 2d 66 69 6e 61 6c 2d 73 74 ts:save-final-st
a920: 61 74 75 73 20 72 75 6e 2d 69 64 20 74 65 73 74 atus run-id test
a930: 2d 69 64 29 0a 20 20 28 6c 65 74 2a 20 28 28 74 -id). (let* ((t
a940: 65 73 74 2d 64 61 74 20 20 28 72 6d 74 3a 67 65 est-dat (rmt:ge
a950: 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 t-test-info-by-i
a960: 64 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 d run-id test-id
a970: 29 29 0a 09 20 28 6f 75 74 2d 64 69 72 20 20 20 )).. (out-dir
a980: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e (db:test-get-run
a990: 64 69 72 20 74 65 73 74 2d 64 61 74 29 29 0a 09 dir test-dat))..
a9a0: 20 28 73 74 61 74 75 73 2d 66 69 6c 65 20 20 28 (status-file (
a9b0: 63 6f 6e 63 20 6f 75 74 2d 64 69 72 20 22 2f 2e conc out-dir "/.
a9c0: 66 69 6e 61 6c 2d 73 74 61 74 75 73 22 29 29 0a final-status")).
a9d0: 20 20 20 29 0a 20 20 20 20 3b 3b 20 66 69 72 73 ). ;; firs
a9e0: 74 20 76 65 72 69 66 79 20 77 65 20 61 72 65 20 t verify we are
a9f0: 61 62 6c 65 20 74 6f 20 77 72 69 74 65 20 74 68 able to write th
aa00: 65 20 6f 75 74 70 75 74 20 66 69 6c 65 0a 20 20 e output file.
aa10: 20 20 28 69 66 20 28 6e 6f 74 20 28 66 69 6c 65 (if (not (file
aa20: 2d 77 72 69 74 65 2d 61 63 63 65 73 73 3f 20 6f -write-access? o
aa30: 75 74 2d 64 69 72 29 29 0a 09 28 64 65 62 75 67 ut-dir))..(debug
aa40: 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
aa50: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 45 52 52 t-log-port* "ERR
aa60: 4f 52 3a 20 63 61 6e 6e 6f 74 20 77 72 69 74 65 OR: cannot write
aa70: 20 2e 66 69 6e 61 6c 2d 73 74 61 74 75 73 20 74 .final-status t
aa80: 6f 20 22 20 6f 75 74 2d 64 69 72 29 0a 09 28 6c o " out-dir)..(l
aa90: 65 74 2a 20 28 28 6f 75 74 70 20 20 20 20 20 20 et* ((outp
aaa0: 28 6f 70 65 6e 2d 6f 75 74 70 75 74 2d 66 69 6c (open-output-fil
aab0: 65 20 73 74 61 74 75 73 2d 66 69 6c 65 29 29 0a e status-file)).
aac0: 09 20 20 20 20 20 20 20 28 73 74 61 74 75 73 20 . (status
aad0: 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d (db:test-get-
aae0: 73 74 61 74 75 73 20 20 20 74 65 73 74 2d 64 61 status test-da
aaf0: 74 29 29 0a 09 20 20 20 20 20 20 20 28 73 74 61 t)).. (sta
ab00: 74 65 20 20 20 20 20 28 64 62 3a 74 65 73 74 2d te (db:test-
ab10: 67 65 74 2d 73 74 61 74 65 20 20 20 20 74 65 73 get-state tes
ab20: 74 2d 64 61 74 29 29 29 0a 09 20 20 28 77 69 74 t-dat))).. (wit
ab30: 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 70 6f 72 74 h-output-to-port
ab40: 20 6f 75 74 70 0a 09 20 20 20 20 28 6c 61 6d 62 outp.. (lamb
ab50: 64 61 20 28 29 0a 09 20 20 20 20 20 20 28 70 72 da ().. (pr
ab60: 69 6e 74 20 73 74 61 74 65 29 20 3b 3b 20 70 72 int state) ;; pr
ab70: 69 6e 74 66 20 77 61 73 20 70 75 74 74 69 6e 67 intf was putting
ab80: 20 69 6e 20 22 2c 20 6e 6f 74 20 73 75 72 65 20 in ", not sure
ab90: 77 68 79 20 62 75 74 20 74 68 61 74 20 77 61 73 why but that was
aba0: 20 61 20 68 61 73 73 6c 65 20 69 6e 20 6f 74 68 a hassle in oth
abb0: 65 72 20 63 6f 6e 74 65 78 74 73 0a 09 20 20 20 er contexts..
abc0: 20 20 20 28 70 72 69 6e 74 20 73 74 61 74 75 73 (print status
abd0: 29 29 29 0a 09 20 20 28 63 6c 6f 73 65 2d 6f 75 ))).. (close-ou
abe0: 74 70 75 74 2d 70 6f 72 74 20 6f 75 74 70 29 29 tput-port outp))
abf0: 29 29 29 0a 0a 3b 3b 20 73 75 6d 6d 61 72 69 7a )))..;; summariz
ac00: 65 20 74 65 73 74 20 69 6e 20 74 6f 20 61 20 66 e test in to a f
ac10: 69 6c 65 20 74 65 73 74 2d 73 75 6d 6d 61 72 79 ile test-summary
ac20: 2e 68 74 6d 6c 20 69 6e 20 74 68 65 20 74 65 73 .html in the tes
ac30: 74 20 64 69 72 65 63 74 6f 72 79 0a 3b 3b 0a 28 t directory.;;.(
ac40: 64 65 66 69 6e 65 20 28 74 65 73 74 73 3a 73 75 define (tests:su
ac50: 6d 6d 61 72 69 7a 65 2d 74 65 73 74 20 72 75 6e mmarize-test run
ac60: 2d 69 64 20 74 65 73 74 2d 69 64 29 0a 20 20 28 -id test-id). (
ac70: 6c 65 74 2a 20 28 28 74 65 73 74 2d 64 61 74 20 let* ((test-dat
ac80: 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 2d 69 (rmt:get-test-i
ac90: 6e 66 6f 2d 62 79 2d 69 64 20 72 75 6e 2d 69 64 nfo-by-id run-id
aca0: 20 74 65 73 74 2d 69 64 29 29 0a 09 20 28 6f 75 test-id)).. (ou
acb0: 74 2d 64 69 72 20 20 20 28 64 62 3a 74 65 73 74 t-dir (db:test
acc0: 2d 67 65 74 2d 72 75 6e 64 69 72 20 74 65 73 74 -get-rundir test
acd0: 2d 64 61 74 29 29 0a 09 20 28 6f 75 74 2d 66 69 -dat)).. (out-fi
ace0: 6c 65 20 20 28 63 6f 6e 63 20 6f 75 74 2d 64 69 le (conc out-di
acf0: 72 20 22 2f 74 65 73 74 2d 73 75 6d 6d 61 72 79 r "/test-summary
ad00: 2e 68 74 6d 6c 22 29 29 29 0a 20 20 20 20 3b 3b .html"))). ;;
ad10: 20 66 69 72 73 74 20 76 65 72 69 66 79 20 77 65 first verify we
ad20: 20 61 72 65 20 61 62 6c 65 20 74 6f 20 77 72 69 are able to wri
ad30: 74 65 20 74 68 65 20 6f 75 74 70 75 74 20 66 69 te the output fi
ad40: 6c 65 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 le. (if (not
ad50: 28 66 69 6c 65 2d 77 72 69 74 65 2d 61 63 63 65 (file-write-acce
ad60: 73 73 3f 20 6f 75 74 2d 64 69 72 29 29 0a 09 28 ss? out-dir))..(
ad70: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
ad80: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
ad90: 20 22 45 52 52 4f 52 3a 20 63 61 6e 6e 6f 74 20 "ERROR: cannot
ada0: 77 72 69 74 65 20 74 65 73 74 2d 73 75 6d 6d 61 write test-summa
adb0: 72 79 2e 68 74 6d 6c 20 74 6f 20 22 20 6f 75 74 ry.html to " out
adc0: 2d 64 69 72 29 0a 09 28 6c 65 74 2a 20 28 3b 3b -dir)..(let* (;;
add0: 20 28 73 74 65 70 73 2d 64 61 74 20 28 72 6d 74 (steps-dat (rmt
ade0: 3a 67 65 74 2d 73 74 65 70 73 2d 66 6f 72 2d 74 :get-steps-for-t
adf0: 65 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d est run-id test-
ae00: 69 64 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 id)).. (te
ae10: 73 74 2d 6e 61 6d 65 20 28 64 62 3a 74 65 73 74 st-name (db:test
ae20: 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 74 65 -get-testname te
ae30: 73 74 2d 64 61 74 29 29 0a 09 20 20 20 20 20 20 st-dat))..
ae40: 20 28 69 74 65 6d 2d 70 61 74 68 20 28 64 62 3a (item-path (db:
ae50: 74 65 73 74 2d 67 65 74 2d 69 74 65 6d 2d 70 61 test-get-item-pa
ae60: 74 68 20 74 65 73 74 2d 64 61 74 29 29 0a 09 20 th test-dat))..
ae70: 20 20 20 20 20 20 28 66 75 6c 6c 2d 6e 61 6d 65 (full-name
ae80: 20 28 64 62 3a 74 65 73 74 2d 6d 61 6b 65 2d 66 (db:test-make-f
ae90: 75 6c 6c 2d 6e 61 6d 65 20 74 65 73 74 2d 6e 61 ull-name test-na
aea0: 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 29 0a 09 me item-path))..
aeb0: 20 20 20 20 20 20 20 28 6f 75 70 20 20 20 20 20 (oup
aec0: 20 20 28 6f 70 65 6e 2d 6f 75 74 70 75 74 2d 66 (open-output-f
aed0: 69 6c 65 20 6f 75 74 2d 66 69 6c 65 29 29 0a 09 ile out-file))..
aee0: 20 20 20 20 20 20 20 28 73 74 61 74 75 73 20 20 (status
aef0: 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 (db:test-get-s
af00: 74 61 74 75 73 20 20 20 74 65 73 74 2d 64 61 74 tatus test-dat
af10: 29 29 0a 09 20 20 20 20 20 20 20 28 63 6f 6c 6f )).. (colo
af20: 72 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 67 65 r (common:ge
af30: 74 2d 63 6f 6c 6f 72 2d 66 72 6f 6d 2d 73 74 61 t-color-from-sta
af40: 74 75 73 20 73 74 61 74 75 73 29 29 0a 09 20 20 tus status))..
af50: 20 20 20 20 20 28 6c 6f 67 66 20 20 20 20 20 20 (logf
af60: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 66 69 6e (db:test-get-fin
af70: 61 6c 5f 6c 6f 67 66 20 74 65 73 74 2d 64 61 74 al_logf test-dat
af80: 29 29 0a 09 20 20 20 20 20 20 20 28 73 74 65 70 )).. (step
af90: 73 2d 64 61 74 20 28 74 65 73 74 73 3a 67 65 74 s-dat (tests:get
afa0: 2d 63 6f 6d 70 72 65 73 73 65 64 2d 73 74 65 70 -compressed-step
afb0: 73 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 s run-id test-id
afc0: 29 29 29 0a 09 20 20 3b 3b 20 28 64 63 6f 6d 6d ))).. ;; (dcomm
afd0: 6f 6e 3a 67 65 74 2d 63 6f 6d 70 72 65 73 73 65 on:get-compresse
afe0: 64 2d 73 74 65 70 73 20 23 66 20 31 20 33 30 30 d-steps #f 1 300
aff0: 34 35 29 0a 09 20 20 3b 3b 20 28 23 28 22 77 61 45).. ;; (#("wa
b000: 73 74 69 6e 67 5f 74 69 6d 65 22 20 22 32 33 3a sting_time" "23:
b010: 33 36 3a 31 33 22 20 22 32 33 3a 33 36 3a 32 31 36:13" "23:36:21
b020: 22 20 22 30 22 20 22 38 2e 30 73 22 20 22 77 61 " "0" "8.0s" "wa
b030: 73 74 69 6e 67 5f 74 69 6d 65 2e 6c 6f 67 22 29 sting_time.log")
b040: 29 0a 09 0a 09 20 20 28 73 3a 6f 75 74 70 75 74 ).... (s:output
b050: 2d 6e 65 77 0a 09 20 20 20 6f 75 70 0a 09 20 20 -new.. oup..
b060: 20 28 73 3a 68 74 6d 6c 0a 09 20 20 20 20 28 73 (s:html.. (s
b070: 3a 74 69 74 6c 65 20 22 53 75 6d 6d 61 72 79 20 :title "Summary
b080: 66 6f 72 20 22 20 66 75 6c 6c 2d 6e 61 6d 65 29 for " full-name)
b090: 0a 09 20 20 20 20 28 73 3a 62 6f 64 79 20 0a 09 .. (s:body ..
b0a0: 20 20 20 20 20 28 73 3a 68 32 20 22 53 75 6d 6d (s:h2 "Summ
b0b0: 61 72 79 20 66 6f 72 20 22 20 66 75 6c 6c 2d 6e ary for " full-n
b0c0: 61 6d 65 29 0a 09 20 20 20 20 20 28 73 3a 74 61 ame).. (s:ta
b0d0: 62 6c 65 20 27 63 65 6c 6c 73 70 61 63 69 6e 67 ble 'cellspacing
b0e0: 20 22 30 22 20 27 62 6f 72 64 65 72 20 22 31 22 "0" 'border "1"
b0f0: 0a 09 09 20 20 20 20 20 20 28 73 3a 74 72 20 28 ... (s:tr (
b100: 73 3a 74 64 20 22 72 75 6e 20 69 64 22 29 20 20 s:td "run id")
b110: 20 28 73 3a 74 64 20 28 64 62 3a 74 65 73 74 2d (s:td (db:test-
b120: 67 65 74 2d 72 75 6e 5f 69 64 20 20 20 74 65 73 get-run_id tes
b130: 74 2d 64 61 74 29 29 0a 09 09 09 20 20 20 20 28 t-dat)).... (
b140: 73 3a 74 64 20 22 74 65 73 74 20 69 64 22 29 20 s:td "test id")
b150: 20 28 73 3a 74 64 20 28 64 62 3a 74 65 73 74 2d (s:td (db:test-
b160: 67 65 74 2d 69 64 20 20 20 20 20 20 20 74 65 73 get-id tes
b170: 74 2d 64 61 74 29 29 29 0a 09 09 20 20 20 20 20 t-dat)))...
b180: 20 28 73 3a 74 72 20 28 73 3a 74 64 20 22 74 65 (s:tr (s:td "te
b190: 73 74 6e 61 6d 65 22 29 20 28 73 3a 74 64 20 74 stname") (s:td t
b1a0: 65 73 74 2d 6e 61 6d 65 29 0a 09 09 09 20 20 20 est-name)....
b1b0: 20 28 73 3a 74 64 20 22 69 74 65 6d 70 61 74 68 (s:td "itempath
b1c0: 22 29 20 28 73 3a 74 64 20 69 74 65 6d 2d 70 61 ") (s:td item-pa
b1d0: 74 68 29 29 0a 09 09 20 20 20 20 20 20 28 73 3a th))... (s:
b1e0: 74 72 20 28 73 3a 74 64 20 22 73 74 61 74 65 22 tr (s:td "state"
b1f0: 29 20 20 20 20 28 73 3a 74 64 20 28 64 62 3a 74 ) (s:td (db:t
b200: 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 20 20 est-get-state
b210: 20 74 65 73 74 2d 64 61 74 29 29 0a 09 09 09 20 test-dat))....
b220: 20 20 20 28 73 3a 74 64 20 22 73 74 61 74 75 73 (s:td "status
b230: 22 29 20 20 20 28 73 3a 74 64 20 28 73 3a 61 20 ") (s:td (s:a
b240: 27 68 72 65 66 20 6c 6f 67 66 20 28 73 3a 66 6f 'href logf (s:fo
b250: 6e 74 20 27 63 6f 6c 6f 72 20 63 6f 6c 6f 72 20 nt 'color color
b260: 73 74 61 74 75 73 29 29 29 29 0a 09 09 20 20 20 status))))...
b270: 20 20 20 28 73 3a 74 72 20 28 73 3a 74 64 20 22 (s:tr (s:td "
b280: 54 65 73 74 44 61 74 65 22 29 20 28 73 3a 74 64 TestDate") (s:td
b290: 20 28 73 65 63 6f 6e 64 73 2d 3e 77 6f 72 6b 2d (seconds->work-
b2a0: 77 65 65 6b 2f 64 61 79 2d 74 69 6d 65 20 0a 09 week/day-time ..
b2b0: 09 09 09 09 09 20 20 20 20 20 28 64 62 3a 74 65 ..... (db:te
b2c0: 73 74 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d st-get-event_tim
b2d0: 65 20 74 65 73 74 2d 64 61 74 29 29 29 0a 09 09 e test-dat)))...
b2e0: 09 20 20 20 20 28 73 3a 74 64 20 22 44 75 72 61 . (s:td "Dura
b2f0: 74 69 6f 6e 22 29 20 28 73 3a 74 64 20 28 73 65 tion") (s:td (se
b300: 63 6f 6e 64 73 2d 3e 68 72 2d 6d 69 6e 2d 73 65 conds->hr-min-se
b310: 63 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 c (db:test-get-r
b320: 75 6e 5f 64 75 72 61 74 69 6f 6e 20 74 65 73 74 un_duration test
b330: 2d 64 61 74 29 29 29 29 29 0a 09 20 20 20 20 20 -dat)))))..
b340: 28 73 3a 68 33 20 22 4c 6f 67 20 66 69 6c 65 73 (s:h3 "Log files
b350: 22 29 0a 09 20 20 20 20 20 28 73 3a 74 61 62 6c ").. (s:tabl
b360: 65 20 0a 09 20 20 20 20 20 20 27 63 65 6c 6c 73 e .. 'cells
b370: 70 61 63 69 6e 67 20 22 30 22 20 27 62 6f 72 64 pacing "0" 'bord
b380: 65 72 20 22 31 22 0a 09 20 20 20 20 20 20 28 73 er "1".. (s
b390: 3a 74 72 20 28 73 3a 74 64 20 22 46 69 6e 61 6c :tr (s:td "Final
b3a0: 20 6c 6f 67 22 29 28 73 3a 74 64 20 28 73 3a 61 log")(s:td (s:a
b3b0: 20 27 68 72 65 66 20 6c 6f 67 66 20 6c 6f 67 66 'href logf logf
b3c0: 29 29 29 29 0a 09 20 20 20 20 20 28 73 3a 74 61 )))).. (s:ta
b3d0: 62 6c 65 0a 09 20 20 20 20 20 20 27 63 65 6c 6c ble.. 'cell
b3e0: 73 70 61 63 69 6e 67 20 22 30 22 20 27 62 6f 72 spacing "0" 'bor
b3f0: 64 65 72 20 22 31 22 0a 09 20 20 20 20 20 20 28 der "1".. (
b400: 73 3a 74 72 20 28 73 3a 74 64 20 22 53 74 65 70 s:tr (s:td "Step
b410: 20 4e 61 6d 65 22 29 28 73 3a 74 64 20 22 53 74 Name")(s:td "St
b420: 61 72 74 22 29 28 73 3a 74 64 20 22 45 6e 64 22 art")(s:td "End"
b430: 29 28 73 3a 74 64 20 22 53 74 61 74 75 73 22 29 )(s:td "Status")
b440: 28 73 3a 74 64 20 22 44 75 72 61 74 69 6f 6e 22 (s:td "Duration"
b450: 29 28 73 3a 74 64 20 22 4c 6f 67 20 46 69 6c 65 )(s:td "Log File
b460: 22 29 29 0a 09 20 20 20 20 20 20 28 6d 61 70 20 ")).. (map
b470: 28 6c 61 6d 62 64 61 20 28 73 74 65 70 2d 64 61 (lambda (step-da
b480: 74 29 0a 09 09 20 20 20 20 20 28 73 3a 74 72 20 t)... (s:tr
b490: 28 73 3a 74 64 20 28 74 64 62 3a 73 74 65 70 73 (s:td (tdb:steps
b4a0: 2d 74 61 62 6c 65 2d 67 65 74 2d 73 74 65 70 6e -table-get-stepn
b4b0: 61 6d 65 20 73 74 65 70 2d 64 61 74 29 29 0a 09 ame step-dat))..
b4c0: 09 09 20 20 20 28 73 3a 74 64 20 28 74 64 62 3a .. (s:td (tdb:
b4d0: 73 74 65 70 73 2d 74 61 62 6c 65 2d 67 65 74 2d steps-table-get-
b4e0: 73 74 61 72 74 20 20 20 20 73 74 65 70 2d 64 61 start step-da
b4f0: 74 29 29 0a 09 09 09 20 20 20 28 73 3a 74 64 20 t)).... (s:td
b500: 28 74 64 62 3a 73 74 65 70 73 2d 74 61 62 6c 65 (tdb:steps-table
b510: 2d 67 65 74 2d 65 6e 64 20 20 20 20 20 20 73 74 -get-end st
b520: 65 70 2d 64 61 74 29 29 0a 09 09 09 20 20 20 28 ep-dat)).... (
b530: 73 3a 74 64 20 28 74 64 62 3a 73 74 65 70 73 2d s:td (tdb:steps-
b540: 74 61 62 6c 65 2d 67 65 74 2d 73 74 61 74 75 73 table-get-status
b550: 20 20 20 73 74 65 70 2d 64 61 74 29 29 0a 09 09 step-dat))...
b560: 09 20 20 20 28 73 3a 74 64 20 28 74 64 62 3a 73 . (s:td (tdb:s
b570: 74 65 70 73 2d 74 61 62 6c 65 2d 67 65 74 2d 72 teps-table-get-r
b580: 75 6e 74 69 6d 65 20 20 73 74 65 70 2d 64 61 74 untime step-dat
b590: 29 29 0a 09 09 09 20 20 20 28 73 3a 74 64 20 28 )).... (s:td (
b5a0: 6c 65 74 20 28 28 73 74 65 70 2d 6c 6f 67 20 28 let ((step-log (
b5b0: 74 64 62 3a 73 74 65 70 73 2d 74 61 62 6c 65 2d tdb:steps-table-
b5c0: 67 65 74 2d 6c 6f 67 2d 66 69 6c 65 20 73 74 65 get-log-file ste
b5d0: 70 2d 64 61 74 29 29 29 0a 09 09 09 09 20 20 20 p-dat))).....
b5e0: 28 73 3a 61 20 27 68 72 65 66 20 73 74 65 70 2d (s:a 'href step-
b5f0: 6c 6f 67 20 73 74 65 70 2d 6c 6f 67 29 29 29 29 log step-log))))
b600: 29 0a 09 09 20 20 20 73 74 65 70 73 2d 64 61 74 )... steps-dat
b610: 29 29 0a 09 20 20 20 20 20 29 29 29 0a 09 20 20 )).. )))..
b620: 28 63 6c 6f 73 65 2d 6f 75 74 70 75 74 2d 70 6f (close-output-po
b630: 72 74 20 6f 75 70 29 29 29 29 29 0a 09 20 20 0a rt oup))))).. .
b640: 09 20 20 0a 3b 3b 20 4d 55 53 54 20 42 45 20 43 . .;; MUST BE C
b650: 41 4c 4c 45 44 20 6c 6f 63 61 6c 21 0a 3b 3b 0a ALLED local!.;;.
b660: 28 64 65 66 69 6e 65 20 28 74 65 73 74 73 3a 74 (define (tests:t
b670: 65 73 74 2d 67 65 74 2d 70 61 74 68 73 2d 6d 61 est-get-paths-ma
b680: 74 63 68 69 6e 67 20 6b 65 79 6e 61 6d 65 73 20 tching keynames
b690: 74 61 72 67 65 74 20 66 6e 61 6d 65 70 61 74 74 target fnamepatt
b6a0: 20 23 21 6b 65 79 20 28 72 65 73 20 27 28 29 29 #!key (res '())
b6b0: 29 0a 20 20 3b 3b 20 42 55 47 3a 20 4d 6f 76 65 ). ;; BUG: Move
b6c0: 20 74 68 65 20 76 61 6c 75 65 73 20 64 65 72 69 the values deri
b6d0: 76 65 64 20 66 72 6f 6d 20 61 72 67 73 20 74 6f ved from args to
b6e0: 20 70 61 72 61 6d 65 74 65 72 73 20 61 6e 64 20 parameters and
b6f0: 70 75 73 68 20 74 6f 20 6d 65 67 61 74 65 73 74 push to megatest
b700: 2e 73 63 6d 0a 20 20 28 6c 65 74 2a 20 28 28 74 .scm. (let* ((t
b710: 65 73 74 70 61 74 74 20 20 20 28 6f 72 20 28 61 estpatt (or (a
b720: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 rgs:get-arg "-te
b730: 73 74 70 61 74 74 22 29 28 61 72 67 73 3a 67 65 stpatt")(args:ge
b740: 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 t-arg "-testpatt
b750: 22 29 20 22 25 22 29 29 0a 09 20 28 73 74 61 74 ") "%")).. (stat
b760: 65 70 61 74 74 20 20 28 6f 72 20 28 61 72 67 73 epatt (or (args
b770: 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 61 74 65 :get-arg "-state
b780: 22 29 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 ") (args:get-a
b790: 72 67 20 22 3a 73 74 61 74 65 22 29 20 20 20 20 rg ":state")
b7a0: 22 25 22 29 29 0a 09 20 28 73 74 61 74 75 73 70 "%")).. (statusp
b7b0: 61 74 74 20 28 6f 72 20 28 61 72 67 73 3a 67 65 att (or (args:ge
b7c0: 74 2d 61 72 67 20 22 2d 73 74 61 74 75 73 22 29 t-arg "-status")
b7d0: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
b7e0: 22 3a 73 74 61 74 75 73 22 29 20 20 20 22 25 22 ":status") "%"
b7f0: 29 29 0a 09 20 28 72 75 6e 6e 61 6d 65 20 20 20 )).. (runname
b800: 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 (or (args:get-a
b810: 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 20 28 rg "-runname") (
b820: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 args:get-arg ":r
b830: 75 6e 6e 61 6d 65 22 29 20 20 22 25 22 29 29 0a unname") "%")).
b840: 09 20 28 70 61 74 68 73 2d 66 72 6f 6d 2d 64 62 . (paths-from-db
b850: 20 28 72 6d 74 3a 74 65 73 74 2d 67 65 74 2d 70 (rmt:test-get-p
b860: 61 74 68 73 2d 6d 61 74 63 68 69 6e 67 2d 6b 65 aths-matching-ke
b870: 79 6e 61 6d 65 73 2d 74 61 72 67 65 74 2d 6e 65 ynames-target-ne
b880: 77 20 6b 65 79 6e 61 6d 65 73 20 74 61 72 67 65 w keynames targe
b890: 74 20 72 65 73 0a 09 09 09 09 09 74 65 73 74 70 t res......testp
b8a0: 61 74 74 0a 09 09 09 09 09 73 74 61 74 65 70 61 att......statepa
b8b0: 74 74 0a 09 09 09 09 09 73 74 61 74 75 73 70 61 tt......statuspa
b8c0: 74 74 0a 09 09 09 09 09 72 75 6e 6e 61 6d 65 29 tt......runname)
b8d0: 29 29 0a 20 20 20 20 28 69 66 20 66 6e 61 6d 65 )). (if fname
b8e0: 70 61 74 74 0a 09 28 61 70 70 6c 79 20 61 70 70 patt..(apply app
b8f0: 65 6e 64 20 0a 09 20 20 20 20 20 20 20 28 6d 61 end .. (ma
b900: 70 20 28 6c 61 6d 62 64 61 20 28 70 29 0a 09 09 p (lambda (p)...
b910: 20 20 20 20 20 20 28 69 66 20 28 64 69 72 65 63 (if (direc
b920: 74 6f 72 79 2d 65 78 69 73 74 73 3f 20 70 29 0a tory-exists? p).
b930: 09 09 09 20 20 28 6c 65 74 20 28 28 67 6c 6f 62 ... (let ((glob
b940: 2d 71 75 65 72 79 20 28 63 6f 6e 63 20 70 20 22 -query (conc p "
b950: 2f 22 20 66 6e 61 6d 65 70 61 74 74 29 29 29 0a /" fnamepatt))).
b960: 09 09 09 20 20 20 20 28 68 61 6e 64 6c 65 2d 65 ... (handle-e
b970: 78 63 65 70 74 69 6f 6e 73 0a 09 09 09 09 65 78 xceptions.....ex
b980: 6e 0a 09 09 09 20 20 20 20 20 20 28 62 65 67 69 n.... (begi
b990: 6e 0a 09 09 09 09 28 70 72 69 6e 74 20 22 62 75 n.....(print "bu
b9a0: 69 6c 74 2d 69 6e 20 67 6c 6f 62 20 6f 6e 20 22 ilt-in glob on "
b9b0: 20 67 6c 6f 62 2d 71 75 65 72 79 20 22 2c 20 66 glob-query ", f
b9c0: 61 69 6c 65 64 2c 20 74 72 79 20 75 73 69 6e 67 ailed, try using
b9d0: 20 74 68 65 20 73 68 65 6c 6c 2e 20 65 78 6e 3d the shell. exn=
b9e0: 22 20 65 78 6e 29 0a 09 09 09 09 28 77 69 74 68 " exn).....(with
b9f0: 2d 69 6e 70 75 74 2d 66 72 6f 6d 2d 70 69 70 65 -input-from-pipe
ba00: 0a 09 09 09 09 20 28 63 6f 6e 63 20 22 65 63 68 ..... (conc "ech
ba10: 6f 20 22 20 67 6c 6f 62 2d 71 75 65 72 79 29 0a o " glob-query).
ba20: 09 09 09 09 20 72 65 61 64 2d 6c 69 6e 65 73 29 .... read-lines)
ba30: 29 20 20 3b 3b 20 77 65 20 61 72 65 6e 27 74 20 ) ;; we aren't
ba40: 67 6f 69 6e 67 20 74 6f 20 74 72 79 20 74 6f 6f going to try too
ba50: 20 68 61 72 64 2e 20 49 66 20 67 6c 6f 62 20 62 hard. If glob b
ba60: 72 65 61 6b 73 20 69 74 20 69 73 20 6c 69 6b 65 reaks it is like
ba70: 6c 79 20 62 65 63 61 75 73 65 20 73 6f 6d 65 6f ly because someo
ba80: 6e 65 20 74 72 69 65 64 20 74 6f 20 64 6f 20 2a ne tried to do *
ba90: 2f 2a 2f 2a 2e 6c 6f 67 20 6f 72 20 73 69 6d 69 /*/*.log or simi
baa0: 6c 61 72 0a 09 09 09 20 20 20 20 20 20 28 67 6c lar.... (gl
bab0: 6f 62 20 67 6c 6f 62 2d 71 75 65 72 79 29 29 29 ob glob-query)))
bac0: 0a 09 09 09 20 20 27 28 29 29 29 0a 09 09 20 20 .... '()))...
bad0: 20 20 70 61 74 68 73 2d 66 72 6f 6d 2d 64 62 29 paths-from-db)
bae0: 29 0a 09 70 61 74 68 73 2d 66 72 6f 6d 2d 64 62 )..paths-from-db
baf0: 29 29 29 0a 0a 09 09 09 20 20 20 20 20 20 0a 3b )))..... .;
bb00: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
bb10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
bb20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
bb30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
bb40: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 47 61 74 68 65 =======.;; Gathe
bb50: 72 20 64 61 74 61 20 66 72 6f 6d 20 74 65 73 74 r data from test
bb60: 2f 74 61 73 6b 20 73 70 65 63 69 66 69 63 61 74 /task specificat
bb70: 69 6f 6e 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d ions.;;=========
bb80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
bb90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
bba0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
bbb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b =============..;
bbc0: 3b 20 28 64 65 66 69 6e 65 20 28 74 65 73 74 73 ; (define (tests
bbd0: 3a 67 65 74 2d 76 61 6c 69 64 2d 74 65 73 74 73 :get-valid-tests
bbe0: 20 74 65 73 74 73 64 69 72 20 74 65 73 74 2d 70 testsdir test-p
bbf0: 61 74 74 73 29 20 3b 3b 20 20 23 21 6b 65 79 20 atts) ;; #!key
bc00: 28 74 65 73 74 2d 6e 61 6d 65 73 20 27 28 29 29 (test-names '())
bc10: 29 0a 3b 3b 20 20 20 28 6c 65 74 20 28 28 74 65 ).;; (let ((te
bc20: 73 74 73 20 28 67 6c 6f 62 20 28 63 6f 6e 63 20 sts (glob (conc
bc30: 74 65 73 74 73 64 69 72 20 22 2f 74 65 73 74 73 testsdir "/tests
bc40: 2f 2a 22 29 29 29 29 20 3b 3b 20 22 20 28 73 74 /*")))) ;; " (st
bc50: 72 69 6e 67 2d 74 72 61 6e 73 6c 61 74 65 20 70 ring-translate p
bc60: 61 74 74 20 22 25 22 20 22 2a 22 29 29 29 29 29 att "%" "*")))))
bc70: 0a 3b 3b 20 20 20 20 20 28 73 65 74 21 20 74 65 .;; (set! te
bc80: 73 74 73 20 28 66 69 6c 74 65 72 20 28 6c 61 6d sts (filter (lam
bc90: 62 64 61 20 28 74 65 73 74 29 28 63 6f 6d 6d 6f bda (test)(commo
bca0: 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 28 n:file-exists? (
bcb0: 63 6f 6e 63 20 74 65 73 74 20 22 2f 74 65 73 74 conc test "/test
bcc0: 63 6f 6e 66 69 67 22 29 29 29 20 74 65 73 74 73 config"))) tests
bcd0: 29 29 0a 3b 3b 20 20 20 20 20 28 64 65 6c 65 74 )).;; (delet
bce0: 65 2d 64 75 70 6c 69 63 61 74 65 73 0a 3b 3b 20 e-duplicates.;;
bcf0: 20 20 20 20 20 28 66 69 6c 74 65 72 20 28 6c 61 (filter (la
bd00: 6d 62 64 61 20 28 74 65 73 74 6e 61 6d 65 29 0a mbda (testname).
bd10: 3b 3b 20 09 20 20 20 20 20 20 20 28 74 65 73 74 ;; . (test
bd20: 73 3a 6d 61 74 63 68 20 74 65 73 74 2d 70 61 74 s:match test-pat
bd30: 74 73 20 74 65 73 74 6e 61 6d 65 20 23 66 29 29 ts testname #f))
bd40: 0a 3b 3b 20 09 20 20 20 20 20 28 6d 61 70 20 28 .;; . (map (
bd50: 6c 61 6d 62 64 61 20 28 74 65 73 74 70 29 0a 3b lambda (testp).;
bd60: 3b 20 09 09 20 20 20 20 28 6c 61 73 74 20 28 73 ; .. (last (s
bd70: 74 72 69 6e 67 2d 73 70 6c 69 74 20 74 65 73 74 tring-split test
bd80: 70 20 22 2f 22 29 29 29 0a 3b 3b 20 09 09 20 20 p "/"))).;; ..
bd90: 74 65 73 74 73 29 29 29 29 29 0a 3b 3b 20 73 6f tests))))).;; so
bda0: 72 74 20 74 65 73 74 73 20 62 79 20 70 72 69 6f rt tests by prio
bdb0: 72 69 74 79 20 61 6e 64 20 77 61 69 74 6f 6e 0a rity and waiton.
bdc0: 3b 3b 20 4d 6f 76 65 20 74 65 73 74 20 73 70 65 ;; Move test spe
bdd0: 63 69 66 69 63 20 73 74 75 66 66 20 74 6f 20 61 cific stuff to a
bde0: 20 74 65 73 74 20 75 6e 69 74 20 46 49 58 4d 45 test unit FIXME
bdf0: 20 6f 6e 65 20 6f 66 20 74 68 65 73 65 20 64 61 one of these da
be00: 79 73 0a 28 64 65 66 69 6e 65 20 28 74 65 73 74 ys.(define (test
be10: 73 3a 73 6f 72 74 2d 62 79 2d 70 72 69 6f 72 69 s:sort-by-priori
be20: 74 79 2d 61 6e 64 2d 77 61 69 74 6f 6e 20 74 65 ty-and-waiton te
be30: 73 74 2d 72 65 63 6f 72 64 73 29 0a 20 20 28 69 st-records). (i
be40: 66 20 28 65 71 3f 20 28 68 61 73 68 2d 74 61 62 f (eq? (hash-tab
be50: 6c 65 2d 73 69 7a 65 20 74 65 73 74 2d 72 65 63 le-size test-rec
be60: 6f 72 64 73 29 20 30 29 0a 20 20 20 20 20 20 27 ords) 0). '
be70: 28 29 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 28 (). (let* (
be80: 28 6d 75 6e 67 65 70 72 69 6f 72 69 74 79 20 28 (mungepriority (
be90: 6c 61 6d 62 64 61 20 28 70 72 69 6f 72 69 74 79 lambda (priority
bea0: 29 0a 09 09 09 20 20 20 20 20 20 28 69 66 20 70 ).... (if p
beb0: 72 69 6f 72 69 74 79 0a 09 09 09 09 20 20 28 6c riority..... (l
bec0: 65 74 20 28 28 74 6d 70 20 28 61 6e 79 2d 3e 6e et ((tmp (any->n
bed0: 75 6d 62 65 72 20 70 72 69 6f 72 69 74 79 29 29 umber priority))
bee0: 29 0a 09 09 09 09 20 20 20 20 28 69 66 20 74 6d )..... (if tm
bef0: 70 20 74 6d 70 20 28 62 65 67 69 6e 20 28 64 65 p tmp (begin (de
bf00: 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 bug:print-error
bf10: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
bf20: 6f 72 74 2a 20 22 62 61 64 20 70 72 69 6f 72 69 ort* "bad priori
bf30: 74 79 20 76 61 6c 75 65 20 22 20 70 72 69 6f 72 ty value " prior
bf40: 69 74 79 20 22 2c 20 75 73 69 6e 67 20 30 22 29 ity ", using 0")
bf50: 20 30 29 29 29 0a 09 09 09 09 20 20 30 29 29 29 0)))..... 0)))
bf60: 0a 09 20 20 20 20 20 28 61 6c 6c 2d 74 65 73 74 .. (all-test
bf70: 73 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 s (hash-tab
bf80: 6c 65 2d 6b 65 79 73 20 74 65 73 74 2d 72 65 63 le-keys test-rec
bf90: 6f 72 64 73 29 29 0a 09 20 20 20 20 20 28 61 6c ords)).. (al
bfa0: 6c 2d 77 61 69 74 65 64 2d 6f 6e 20 20 28 6c 65 l-waited-on (le
bfb0: 74 20 6c 6f 6f 70 20 28 28 68 65 64 20 28 63 61 t loop ((hed (ca
bfc0: 72 20 61 6c 6c 2d 74 65 73 74 73 29 29 0a 09 09 r all-tests))...
bfd0: 09 09 09 28 74 61 6c 20 28 63 64 72 20 61 6c 6c ...(tal (cdr all
bfe0: 2d 74 65 73 74 73 29 29 0a 09 09 09 09 09 28 72 -tests))......(r
bff0: 65 73 20 27 28 29 29 29 0a 09 09 09 20 20 20 20 es '()))....
c000: 20 20 20 28 6c 65 74 2a 20 28 28 74 72 65 63 20 (let* ((trec
c010: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 (hash-table-r
c020: 65 66 20 74 65 73 74 2d 72 65 63 6f 72 64 73 20 ef test-records
c030: 68 65 64 29 29 0a 09 09 09 09 20 20 20 20 20 20 hed)).....
c040: 28 77 61 69 74 6f 6e 73 20 28 6f 72 20 28 74 65 (waitons (or (te
c050: 73 74 73 3a 74 65 73 74 71 75 65 75 65 2d 67 65 sts:testqueue-ge
c060: 74 2d 77 61 69 74 6f 6e 73 20 74 72 65 63 29 20 t-waitons trec)
c070: 27 28 29 29 29 29 0a 09 09 09 09 20 28 69 66 20 '())))..... (if
c080: 28 6e 75 6c 6c 3f 20 74 61 6c 29 0a 09 09 09 09 (null? tal).....
c090: 20 20 20 20 20 28 61 70 70 65 6e 64 20 72 65 73 (append res
c0a0: 20 77 61 69 74 6f 6e 73 29 0a 09 09 09 09 20 20 waitons).....
c0b0: 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 (loop (car ta
c0c0: 6c 29 28 63 64 72 20 74 61 6c 29 28 61 70 70 65 l)(cdr tal)(appe
c0d0: 6e 64 20 72 65 73 20 77 61 69 74 6f 6e 73 29 29 nd res waitons))
c0e0: 29 29 29 29 0a 09 20 20 20 20 20 28 73 6f 72 74 )))).. (sort
c0f0: 2d 66 6e 31 20 0a 09 20 20 20 20 20 20 28 6c 61 -fn1 .. (la
c100: 6d 62 64 61 20 28 61 20 62 29 0a 09 09 28 6c 65 mbda (a b)...(le
c110: 74 2a 20 28 28 61 2d 72 65 63 6f 72 64 20 20 20 t* ((a-record
c120: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 (hash-table-ref
c130: 74 65 73 74 2d 72 65 63 6f 72 64 73 20 61 29 29 test-records a))
c140: 0a 09 09 20 20 20 20 20 20 20 28 62 2d 72 65 63 ... (b-rec
c150: 6f 72 64 20 20 20 28 68 61 73 68 2d 74 61 62 6c ord (hash-tabl
c160: 65 2d 72 65 66 20 74 65 73 74 2d 72 65 63 6f 72 e-ref test-recor
c170: 64 73 20 62 29 29 0a 09 09 20 20 20 20 20 20 20 ds b))...
c180: 28 61 2d 77 61 69 74 6f 6e 73 20 20 28 6f 72 20 (a-waitons (or
c190: 28 74 65 73 74 73 3a 74 65 73 74 71 75 65 75 65 (tests:testqueue
c1a0: 2d 67 65 74 2d 77 61 69 74 6f 6e 73 20 61 2d 72 -get-waitons a-r
c1b0: 65 63 6f 72 64 29 20 27 28 29 29 29 0a 09 09 20 ecord) '()))...
c1c0: 20 20 20 20 20 20 28 62 2d 77 61 69 74 6f 6e 73 (b-waitons
c1d0: 20 20 28 6f 72 20 28 74 65 73 74 73 3a 74 65 73 (or (tests:tes
c1e0: 74 71 75 65 75 65 2d 67 65 74 2d 77 61 69 74 6f tqueue-get-waito
c1f0: 6e 73 20 62 2d 72 65 63 6f 72 64 29 20 27 28 29 ns b-record) '()
c200: 29 29 0a 09 09 20 20 20 20 20 20 20 28 61 2d 63 ))... (a-c
c210: 6f 6e 66 69 67 20 20 20 28 74 65 73 74 73 3a 74 onfig (tests:t
c220: 65 73 74 71 75 65 75 65 2d 67 65 74 2d 74 65 73 estqueue-get-tes
c230: 74 63 6f 6e 66 69 67 20 20 61 2d 72 65 63 6f 72 tconfig a-recor
c240: 64 29 29 0a 09 09 20 20 20 20 20 20 20 28 62 2d d))... (b-
c250: 63 6f 6e 66 69 67 20 20 20 28 74 65 73 74 73 3a config (tests:
c260: 74 65 73 74 71 75 65 75 65 2d 67 65 74 2d 74 65 testqueue-get-te
c270: 73 74 63 6f 6e 66 69 67 20 20 62 2d 72 65 63 6f stconfig b-reco
c280: 72 64 29 29 0a 09 09 20 20 20 20 20 20 20 28 61 rd))... (a
c290: 2d 72 61 77 2d 70 72 69 20 20 28 63 6f 6e 66 69 -raw-pri (confi
c2a0: 67 66 3a 6c 6f 6f 6b 75 70 20 61 2d 63 6f 6e 66 gf:lookup a-conf
c2b0: 69 67 20 22 72 65 71 75 69 72 65 6d 65 6e 74 73 ig "requirements
c2c0: 22 20 22 70 72 69 6f 72 69 74 79 22 29 29 0a 09 " "priority"))..
c2d0: 09 20 20 20 20 20 20 20 28 62 2d 72 61 77 2d 70 . (b-raw-p
c2e0: 72 69 20 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f ri (configf:loo
c2f0: 6b 75 70 20 62 2d 63 6f 6e 66 69 67 20 22 72 65 kup b-config "re
c300: 71 75 69 72 65 6d 65 6e 74 73 22 20 22 70 72 69 quirements" "pri
c310: 6f 72 69 74 79 22 29 29 0a 09 09 20 20 20 20 20 ority"))...
c320: 20 20 28 61 2d 70 72 69 6f 72 69 74 79 20 28 6d (a-priority (m
c330: 75 6e 67 65 70 72 69 6f 72 69 74 79 20 61 2d 72 ungepriority a-r
c340: 61 77 2d 70 72 69 29 29 0a 09 09 20 20 20 20 20 aw-pri))...
c350: 20 20 28 62 2d 70 72 69 6f 72 69 74 79 20 28 6d (b-priority (m
c360: 75 6e 67 65 70 72 69 6f 72 69 74 79 20 62 2d 72 ungepriority b-r
c370: 61 77 2d 70 72 69 29 29 29 0a 09 09 20 20 28 74 aw-pri)))... (t
c380: 65 73 74 73 3a 74 65 73 74 71 75 65 75 65 2d 73 ests:testqueue-s
c390: 65 74 2d 70 72 69 6f 72 69 74 79 21 20 61 2d 72 et-priority! a-r
c3a0: 65 63 6f 72 64 20 61 2d 70 72 69 6f 72 69 74 79 ecord a-priority
c3b0: 29 0a 09 09 20 20 28 74 65 73 74 73 3a 74 65 73 )... (tests:tes
c3c0: 74 71 75 65 75 65 2d 73 65 74 2d 70 72 69 6f 72 tqueue-set-prior
c3d0: 69 74 79 21 20 62 2d 72 65 63 6f 72 64 20 62 2d ity! b-record b-
c3e0: 70 72 69 6f 72 69 74 79 29 0a 09 09 20 20 3b 3b priority)... ;;
c3f0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
c400: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
c410: 74 2a 20 22 61 3d 22 20 61 20 22 2c 20 62 3d 22 t* "a=" a ", b="
c420: 20 62 20 22 2c 20 61 2d 77 61 69 74 6f 6e 73 3d b ", a-waitons=
c430: 22 20 61 2d 77 61 69 74 6f 6e 73 20 22 2c 20 62 " a-waitons ", b
c440: 2d 77 61 69 74 6f 6e 73 3d 22 20 62 2d 77 61 69 -waitons=" b-wai
c450: 74 6f 6e 73 29 0a 09 09 20 20 28 63 6f 6e 64 0a tons)... (cond.
c460: 09 09 20 20 20 3b 3b 20 69 73 20 0a 09 09 20 20 .. ;; is ...
c470: 20 28 28 6d 65 6d 62 65 72 20 61 20 62 2d 77 61 ((member a b-wa
c480: 69 74 6f 6e 73 29 20 20 20 20 20 20 20 20 20 20 itons)
c490: 3b 3b 20 69 73 20 62 20 77 61 69 74 69 6e 67 20 ;; is b waiting
c4a0: 6f 6e 20 61 3f 0a 09 09 20 20 20 20 3b 3b 20 28 on a?... ;; (
c4b0: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
c4c0: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
c4d0: 20 22 63 61 73 65 31 22 29 0a 09 09 20 20 20 20 "case1")...
c4e0: 23 74 29 0a 09 09 20 20 20 28 28 6d 65 6d 62 65 #t)... ((membe
c4f0: 72 20 62 20 61 2d 77 61 69 74 6f 6e 73 29 20 20 r b a-waitons)
c500: 20 20 20 20 20 20 20 20 3b 3b 20 69 73 20 61 20 ;; is a
c510: 77 61 69 74 69 6e 67 20 6f 6e 20 62 3f 0a 09 09 waiting on b?...
c520: 20 20 20 20 3b 3b 20 28 64 65 62 75 67 3a 70 72 ;; (debug:pr
c530: 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c int 0 *default-l
c540: 6f 67 2d 70 6f 72 74 2a 20 22 63 61 73 65 32 22 og-port* "case2"
c550: 29 0a 09 09 20 20 20 20 23 66 29 0a 09 09 20 20 )... #f)...
c560: 20 28 28 61 6e 64 20 28 6e 6f 74 20 28 6e 75 6c ((and (not (nul
c570: 6c 3f 20 61 2d 77 61 69 74 6f 6e 73 29 29 20 20 l? a-waitons))
c580: 3b 3b 20 62 6f 74 68 20 68 61 76 65 20 77 61 69 ;; both have wai
c590: 74 6f 6e 73 20 2d 20 64 6f 20 6e 6f 74 20 64 69 tons - do not di
c5a0: 73 74 75 72 62 0a 09 09 09 20 28 6e 6f 74 20 28 sturb.... (not (
c5b0: 6e 75 6c 6c 3f 20 62 2d 77 61 69 74 6f 6e 73 29 null? b-waitons)
c5c0: 29 29 0a 09 09 20 20 20 20 3b 3b 20 28 64 65 62 ))... ;; (deb
c5d0: 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 ug:print 0 *defa
c5e0: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 63 ult-log-port* "c
c5f0: 61 73 65 32 2e 31 22 29 0a 09 09 20 20 20 20 23 ase2.1")... #
c600: 74 29 0a 09 09 20 20 20 28 28 61 6e 64 20 28 6e t)... ((and (n
c610: 75 6c 6c 3f 20 61 2d 77 61 69 74 6f 6e 73 29 20 ull? a-waitons)
c620: 20 20 20 20 20 20 20 3b 3b 20 6e 6f 20 77 61 69 ;; no wai
c630: 74 6f 6e 73 20 66 6f 72 20 61 20 62 75 74 20 62 tons for a but b
c640: 20 68 61 73 20 77 61 69 74 6f 6e 73 0a 09 09 09 has waitons....
c650: 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 62 2d 77 (not (null? b-w
c660: 61 69 74 6f 6e 73 29 29 29 0a 09 09 20 20 20 20 aitons)))...
c670: 3b 3b 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 ;; (debug:print
c680: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
c690: 6f 72 74 2a 20 22 63 61 73 65 33 22 29 0a 09 09 ort* "case3")...
c6a0: 20 20 20 20 23 66 29 0a 09 09 20 20 20 28 28 61 #f)... ((a
c6b0: 6e 64 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 61 nd (not (null? a
c6c0: 2d 77 61 69 74 6f 6e 73 29 29 20 20 3b 3b 20 61 -waitons)) ;; a
c6d0: 20 68 61 73 20 77 61 69 74 6f 6e 73 20 62 75 74 has waitons but
c6e0: 20 62 20 64 6f 65 73 20 6e 6f 74 0a 09 09 09 20 b does not....
c6f0: 28 6e 75 6c 6c 3f 20 62 2d 77 61 69 74 6f 6e 73 (null? b-waitons
c700: 29 29 20 0a 09 09 20 20 20 20 3b 3b 20 28 64 65 )) ... ;; (de
c710: 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 bug:print 0 *def
c720: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
c730: 63 61 73 65 34 22 29 0a 09 09 20 20 20 20 23 74 case4")... #t
c740: 29 0a 09 09 20 20 20 28 28 6e 6f 74 20 28 65 71 )... ((not (eq
c750: 3f 20 61 2d 70 72 69 6f 72 69 74 79 20 62 2d 70 ? a-priority b-p
c760: 72 69 6f 72 69 74 79 29 29 20 3b 3b 20 75 73 65 riority)) ;; use
c770: 0a 09 09 20 20 20 20 28 3e 20 61 2d 70 72 69 6f ... (> a-prio
c780: 72 69 74 79 20 62 2d 70 72 69 6f 72 69 74 79 29 rity b-priority)
c790: 29 0a 09 09 20 20 20 28 65 6c 73 65 0a 09 09 20 )... (else...
c7a0: 20 20 20 3b 3b 20 28 64 65 62 75 67 3a 70 72 69 ;; (debug:pri
c7b0: 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
c7c0: 67 2d 70 6f 72 74 2a 20 22 63 61 73 65 35 22 29 g-port* "case5")
c7d0: 0a 09 09 20 20 20 20 28 73 74 72 69 6e 67 3e 3f ... (string>?
c7e0: 20 61 20 62 29 29 29 29 29 29 0a 09 20 20 20 20 a b))))))..
c7f0: 20 0a 09 20 20 20 20 20 28 73 6f 72 74 2d 66 6e .. (sort-fn
c800: 32 0a 09 20 20 20 20 20 20 28 6c 61 6d 62 64 61 2.. (lambda
c810: 20 28 61 20 62 29 0a 09 09 28 3e 20 28 6d 75 6e (a b)...(> (mun
c820: 67 65 70 72 69 6f 72 69 74 79 20 28 74 65 73 74 gepriority (test
c830: 73 3a 74 65 73 74 71 75 65 75 65 2d 67 65 74 2d s:testqueue-get-
c840: 70 72 69 6f 72 69 74 79 20 28 68 61 73 68 2d 74 priority (hash-t
c850: 61 62 6c 65 2d 72 65 66 20 74 65 73 74 2d 72 65 able-ref test-re
c860: 63 6f 72 64 73 20 61 29 29 29 0a 09 09 20 20 20 cords a)))...
c870: 28 6d 75 6e 67 65 70 72 69 6f 72 69 74 79 20 28 (mungepriority (
c880: 74 65 73 74 73 3a 74 65 73 74 71 75 65 75 65 2d tests:testqueue-
c890: 67 65 74 2d 70 72 69 6f 72 69 74 79 20 28 68 61 get-priority (ha
c8a0: 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 74 65 73 sh-table-ref tes
c8b0: 74 2d 72 65 63 6f 72 64 73 20 62 29 29 29 29 29 t-records b)))))
c8c0: 29 29 0a 09 3b 3b 20 28 6c 65 74 20 28 28 64 6f ))..;; (let ((do
c8d0: 74 2d 72 65 73 20 28 74 65 73 74 73 3a 72 75 6e t-res (tests:run
c8e0: 2d 64 6f 74 20 28 74 65 73 74 73 3a 74 65 73 74 -dot (tests:test
c8f0: 73 2d 3e 64 6f 74 20 74 65 73 74 2d 72 65 63 6f s->dot test-reco
c900: 72 64 73 29 20 22 70 6c 61 69 6e 22 29 29 29 0a rds) "plain"))).
c910: 09 3b 3b 20 20 20 28 64 65 62 75 67 3a 70 72 69 .;; (debug:pri
c920: 6e 74 20 22 64 6f 74 2d 72 65 73 3d 22 20 64 6f nt "dot-res=" do
c930: 74 2d 72 65 73 29 29 0a 09 3b 3b 20 28 6c 65 74 t-res))..;; (let
c940: 20 28 28 64 61 74 61 20 28 6d 61 70 20 63 64 72 ((data (map cdr
c950: 20 28 66 69 6c 74 65 72 0a 09 3b 3b 20 20 20 20 (filter..;;
c960: 20 09 09 20 20 28 6c 61 6d 62 64 61 20 28 78 29 .. (lambda (x)
c970: 28 65 71 75 61 6c 3f 20 22 6e 6f 64 65 22 20 28 (equal? "node" (
c980: 63 61 72 20 78 29 29 29 0a 09 3b 3b 20 20 20 20 car x)))..;;
c990: 20 09 09 20 20 28 6d 61 70 20 73 74 72 69 6e 67 .. (map string
c9a0: 2d 73 70 6c 69 74 20 28 74 65 73 74 73 3a 65 61 -split (tests:ea
c9b0: 73 79 2d 64 6f 74 20 74 65 73 74 2d 72 65 63 6f sy-dot test-reco
c9c0: 72 64 73 20 22 70 6c 61 69 6e 22 29 29 29 29 29 rds "plain")))))
c9d0: 29 0a 09 3b 3b 20 20 20 28 6d 61 70 20 63 61 72 )..;; (map car
c9e0: 20 28 73 6f 72 74 20 64 61 74 61 20 28 6c 61 6d (sort data (lam
c9f0: 62 64 61 20 28 61 20 62 29 0a 09 3b 3b 20 20 20 bda (a b)..;;
ca00: 20 20 09 09 20 20 20 20 28 3e 20 28 73 74 72 69 .. (> (stri
ca10: 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 63 61 64 64 ng->number (cadd
ca20: 72 20 61 29 29 28 73 74 72 69 6e 67 2d 3e 6e 75 r a))(string->nu
ca30: 6d 62 65 72 20 28 63 61 64 64 72 20 62 29 29 29 mber (caddr b)))
ca40: 29 29 29 29 0a 09 3b 3b 20 29 29 0a 09 28 73 6f ))))..;; ))..(so
ca50: 72 74 20 61 6c 6c 2d 74 65 73 74 73 20 73 6f 72 rt all-tests sor
ca60: 74 2d 66 6e 31 29 29 29 29 20 3b 3b 20 61 76 6f t-fn1)))) ;; avo
ca70: 69 64 20 64 65 61 6c 69 6e 67 20 77 69 74 68 20 id dealing with
ca80: 64 65 6c 65 74 65 64 20 74 65 73 74 73 2c 20 6c deleted tests, l
ca90: 6f 6f 6b 20 61 74 20 74 68 65 20 68 61 73 68 20 ook at the hash
caa0: 74 61 62 6c 65 0a 0a 28 64 65 66 69 6e 65 20 28 table..(define (
cab0: 74 65 73 74 73 3a 65 61 73 79 2d 64 6f 74 20 74 tests:easy-dot t
cac0: 65 73 74 2d 72 65 63 6f 72 64 73 20 6f 75 74 74 est-records outt
cad0: 79 70 65 29 0a 20 20 28 6c 65 74 2d 76 61 6c 75 ype). (let-valu
cae0: 65 73 20 28 28 28 66 64 20 74 65 6d 70 2d 70 61 es (((fd temp-pa
caf0: 74 68 29 20 28 66 69 6c 65 2d 6d 6b 73 74 65 6d th) (file-mkstem
cb00: 70 20 28 63 6f 6e 63 20 22 2f 74 6d 70 2f 22 20 p (conc "/tmp/"
cb10: 28 63 75 72 72 65 6e 74 2d 75 73 65 72 2d 6e 61 (current-user-na
cb20: 6d 65 29 20 22 2e 58 58 58 58 58 58 22 29 29 29 me) ".XXXXXX")))
cb30: 29 0a 20 20 20 20 28 6c 65 74 20 28 28 61 6c 6c ). (let ((all
cb40: 2d 74 65 73 74 6e 61 6d 65 73 20 28 68 61 73 68 -testnames (hash
cb50: 2d 74 61 62 6c 65 2d 6b 65 79 73 20 74 65 73 74 -table-keys test
cb60: 2d 72 65 63 6f 72 64 73 29 29 0a 09 20 20 28 74 -records)).. (t
cb70: 65 6d 70 2d 70 6f 72 74 20 20 20 20 20 28 6f 70 emp-port (op
cb80: 65 6e 2d 6f 75 74 70 75 74 2d 66 69 6c 65 2a 20 en-output-file*
cb90: 66 64 29 29 29 0a 20 20 20 20 20 20 3b 3b 20 28 fd))). ;; (
cba0: 66 6f 72 6d 61 74 20 74 65 6d 70 2d 70 6f 72 74 format temp-port
cbb0: 20 22 54 68 69 73 20 66 69 6c 65 20 69 73 20 7e "This file is ~
cbc0: 41 2e 7e 25 22 20 74 65 6d 70 2d 70 61 74 68 29 A.~%" temp-path)
cbd0: 0a 20 20 20 20 20 20 28 66 6f 72 6d 61 74 20 74 . (format t
cbe0: 65 6d 70 2d 70 6f 72 74 20 22 64 69 67 72 61 70 emp-port "digrap
cbf0: 68 20 74 65 73 74 73 20 7b 5c 6e 22 29 0a 20 20 h tests {\n").
cc00: 20 20 20 20 28 66 6f 72 6d 61 74 20 74 65 6d 70 (format temp
cc10: 2d 70 6f 72 74 20 22 20 20 73 69 7a 65 3d 34 2c -port " size=4,
cc20: 38 5c 6e 22 29 0a 20 20 20 20 20 20 3b 3b 20 28 8\n"). ;; (
cc30: 66 6f 72 6d 61 74 20 74 65 6d 70 2d 70 6f 72 74 format temp-port
cc40: 20 22 20 20 20 73 70 6c 69 6e 65 73 3d 6e 6f 6e " splines=non
cc50: 65 5c 6e 22 29 0a 20 20 20 20 20 20 28 66 6f 72 e\n"). (for
cc60: 2d 65 61 63 68 0a 20 20 20 20 20 20 20 28 6c 61 -each. (la
cc70: 6d 62 64 61 20 28 74 65 73 74 6e 61 6d 65 29 0a mbda (testname).
cc80: 09 20 28 6c 65 74 2a 20 28 28 74 65 73 74 72 65 . (let* ((testre
cc90: 63 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 c (hash-table-re
cca0: 66 20 74 65 73 74 2d 72 65 63 6f 72 64 73 20 74 f test-records t
ccb0: 65 73 74 6e 61 6d 65 29 29 0a 09 09 28 77 61 69 estname))...(wai
ccc0: 74 6f 6e 73 20 28 6f 72 20 28 74 65 73 74 73 3a tons (or (tests:
ccd0: 74 65 73 74 71 75 65 75 65 2d 67 65 74 2d 77 61 testqueue-get-wa
cce0: 69 74 6f 6e 73 20 74 65 73 74 72 65 63 29 20 27 itons testrec) '
ccf0: 28 29 29 29 29 0a 09 20 20 20 28 66 6f 72 2d 65 ()))).. (for-e
cd00: 61 63 68 0a 09 20 20 20 20 28 6c 61 6d 62 64 61 ach.. (lambda
cd10: 20 28 77 61 69 74 6f 6e 29 0a 09 20 20 20 20 20 (waiton)..
cd20: 20 28 66 6f 72 6d 61 74 20 74 65 6d 70 2d 70 6f (format temp-po
cd30: 72 74 20 28 63 6f 6e 63 20 22 20 20 20 22 20 77 rt (conc " " w
cd40: 61 69 74 6f 6e 20 22 20 2d 3e 20 22 20 74 65 73 aiton " -> " tes
cd50: 74 6e 61 6d 65 20 22 20 5b 73 70 6c 69 6e 65 73 tname " [splines
cd60: 3d 6f 72 74 68 6f 5d 5c 6e 22 29 29 29 0a 09 20 =ortho]\n")))..
cd70: 20 20 20 77 61 69 74 6f 6e 73 29 29 29 0a 20 20 waitons))).
cd80: 20 20 20 20 20 61 6c 6c 2d 74 65 73 74 6e 61 6d all-testnam
cd90: 65 73 29 0a 20 20 20 20 20 20 28 66 6f 72 6d 61 es). (forma
cda0: 74 20 74 65 6d 70 2d 70 6f 72 74 20 22 7d 5c 6e t temp-port "}\n
cdb0: 22 29 0a 20 20 20 20 20 20 28 63 6c 6f 73 65 2d "). (close-
cdc0: 6f 75 74 70 75 74 2d 70 6f 72 74 20 74 65 6d 70 output-port temp
cdd0: 2d 70 6f 72 74 29 0a 20 20 20 20 20 20 28 77 69 -port). (wi
cde0: 74 68 2d 69 6e 70 75 74 2d 66 72 6f 6d 2d 70 69 th-input-from-pi
cdf0: 70 65 0a 20 20 20 20 20 20 20 28 63 6f 6e 63 20 pe. (conc
ce00: 22 65 6e 76 20 2d 69 20 50 41 54 48 3d 24 50 41 "env -i PATH=$PA
ce10: 54 48 20 64 6f 74 20 2d 54 22 20 6f 75 74 74 79 TH dot -T" outty
ce20: 70 65 20 22 20 3c 20 22 20 74 65 6d 70 2d 70 61 pe " < " temp-pa
ce30: 74 68 29 0a 20 20 20 20 20 20 20 28 6c 61 6d 62 th). (lamb
ce40: 64 61 20 28 29 0a 09 20 28 6c 65 74 20 28 28 72 da ().. (let ((r
ce50: 65 73 20 28 72 65 61 64 2d 6c 69 6e 65 73 29 29 es (read-lines))
ce60: 29 0a 09 20 20 20 3b 3b 20 28 64 65 6c 65 74 65 ).. ;; (delete
ce70: 2d 66 69 6c 65 20 74 65 6d 70 2d 70 61 74 68 29 -file temp-path)
ce80: 0a 09 20 20 20 72 65 73 29 29 29 29 29 29 0a 0a .. res))))))..
ce90: 28 64 65 66 69 6e 65 20 28 74 65 73 74 73 3a 77 (define (tests:w
cea0: 72 69 74 65 2d 64 6f 74 2d 66 69 6c 65 20 74 65 rite-dot-file te
ceb0: 73 74 2d 72 65 63 6f 72 64 73 20 66 6e 61 6d 65 st-records fname
cec0: 20 73 69 7a 65 78 20 73 69 7a 65 79 29 0a 20 20 sizex sizey).
ced0: 28 69 66 20 28 66 69 6c 65 2d 77 72 69 74 65 2d (if (file-write-
cee0: 61 63 63 65 73 73 3f 20 28 70 61 74 68 6e 61 6d access? (pathnam
cef0: 65 2d 64 69 72 65 63 74 6f 72 79 20 66 6e 61 6d e-directory fnam
cf00: 65 29 29 0a 20 20 20 20 20 20 28 77 69 74 68 2d e)). (with-
cf10: 6f 75 74 70 75 74 2d 74 6f 2d 66 69 6c 65 20 66 output-to-file f
cf20: 6e 61 6d 65 0a 09 28 6c 61 6d 62 64 61 20 28 29 name..(lambda ()
cf30: 0a 09 20 20 28 6d 61 70 20 70 72 69 6e 74 20 28 .. (map print (
cf40: 74 65 73 74 73 3a 74 65 73 74 73 2d 3e 64 6f 74 tests:tests->dot
cf50: 20 74 65 73 74 2d 72 65 63 6f 72 64 73 20 73 69 test-records si
cf60: 7a 65 78 20 73 69 7a 65 79 29 29 29 29 29 29 0a zex sizey)))))).
cf70: 0a 28 64 65 66 69 6e 65 20 28 74 65 73 74 73 3a .(define (tests:
cf80: 74 65 73 74 73 2d 3e 64 6f 74 20 74 65 73 74 2d tests->dot test-
cf90: 72 65 63 6f 72 64 73 20 73 69 7a 65 78 20 73 69 records sizex si
cfa0: 7a 65 79 29 0a 20 20 28 6c 65 74 20 28 28 61 6c zey). (let ((al
cfb0: 6c 2d 74 65 73 74 6e 61 6d 65 73 20 28 68 61 73 l-testnames (has
cfc0: 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 74 65 73 h-table-keys tes
cfd0: 74 2d 72 65 63 6f 72 64 73 29 29 29 0a 20 20 20 t-records))).
cfe0: 20 28 69 66 20 28 6e 75 6c 6c 3f 20 61 6c 6c 2d (if (null? all-
cff0: 74 65 73 74 6e 61 6d 65 73 29 0a 09 27 28 29 0a testnames)..'().
d000: 09 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 .(let loop ((hed
d010: 20 28 63 61 72 20 61 6c 6c 2d 74 65 73 74 6e 61 (car all-testna
d020: 6d 65 73 29 29 0a 09 09 20 20 20 28 74 61 6c 20 mes))... (tal
d030: 28 63 64 72 20 61 6c 6c 2d 74 65 73 74 6e 61 6d (cdr all-testnam
d040: 65 73 29 29 0a 09 09 20 20 20 28 72 65 73 20 28 es))... (res (
d050: 6c 69 73 74 20 22 64 69 67 72 61 70 68 20 74 65 list "digraph te
d060: 73 74 73 20 7b 22 0a 09 09 09 20 20 20 20 20 20 sts {"....
d070: 28 63 6f 6e 63 20 22 20 73 69 7a 65 3d 5c 22 22 (conc " size=\""
d080: 20 28 6f 72 20 73 69 7a 65 78 20 31 31 29 20 22 (or sizex 11) "
d090: 2c 22 20 28 6f 72 20 73 69 7a 65 79 20 31 31 29 ," (or sizey 11)
d0a0: 20 22 5c 22 3b 22 29 0a 09 09 09 20 20 20 20 20 "\";")....
d0b0: 20 22 20 72 61 74 69 6f 3d 30 2e 39 35 3b 22 0a " ratio=0.95;".
d0c0: 09 09 09 20 20 20 20 20 20 29 29 29 0a 09 20 20 ... )))..
d0d0: 28 6c 65 74 2a 20 28 28 74 65 73 74 72 65 63 20 (let* ((testrec
d0e0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 (hash-table-ref
d0f0: 74 65 73 74 2d 72 65 63 6f 72 64 73 20 68 65 64 test-records hed
d100: 29 29 0a 09 09 20 28 77 61 69 74 6f 6e 73 20 28 ))... (waitons (
d110: 6f 72 20 28 74 65 73 74 73 3a 74 65 73 74 71 75 or (tests:testqu
d120: 65 75 65 2d 67 65 74 2d 77 61 69 74 6f 6e 73 20 eue-get-waitons
d130: 74 65 73 74 72 65 63 29 20 27 28 29 29 29 0a 09 testrec) '()))..
d140: 09 20 28 6e 65 77 72 65 73 20 20 28 61 70 70 65 . (newres (appe
d150: 6e 64 20 72 65 73 0a 09 09 09 09 20 20 28 69 66 nd res..... (if
d160: 20 28 6e 75 6c 6c 3f 20 77 61 69 74 6f 6e 73 29 (null? waitons)
d170: 0a 09 09 09 09 20 20 20 20 20 20 28 6c 69 73 74 ..... (list
d180: 20 28 63 6f 6e 63 20 22 20 20 20 5c 22 22 20 68 (conc " \"" h
d190: 65 64 20 22 5c 22 20 5b 73 68 61 70 65 3d 62 6f ed "\" [shape=bo
d1a0: 78 5d 3b 22 29 29 0a 09 09 09 09 20 20 20 20 20 x];")).....
d1b0: 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 77 (map (lambda (w
d1c0: 61 69 74 6f 6e 29 0a 09 09 09 09 09 20 20 20 20 aiton)......
d1d0: 20 28 63 6f 6e 63 20 22 20 20 20 5c 22 22 20 77 (conc " \"" w
d1e0: 61 69 74 6f 6e 20 22 5c 22 20 2d 3e 20 5c 22 22 aiton "\" -> \""
d1f0: 20 68 65 64 20 22 5c 22 20 5b 73 68 61 70 65 3d hed "\" [shape=
d200: 62 6f 78 5d 3b 22 29 29 0a 09 09 09 09 09 20 20 box];"))......
d210: 20 77 61 69 74 6f 6e 73 29 0a 09 09 09 09 20 20 waitons).....
d220: 20 20 20 20 29 29 29 29 0a 09 20 20 20 20 28 69 )))).. (i
d230: 66 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 0a 09 09 f (null? tal)...
d240: 28 61 70 70 65 6e 64 20 6e 65 77 72 65 73 20 28 (append newres (
d250: 6c 69 73 74 20 22 7d 22 29 29 0a 09 09 28 6c 6f list "}"))...(lo
d260: 6f 70 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 op (car tal)(cdr
d270: 20 74 61 6c 29 20 6e 65 77 72 65 73 29 0a 09 09 tal) newres)...
d280: 29 29 29 29 29 29 0a 0a 3b 3b 20 28 74 65 73 74 ))))))..;; (test
d290: 73 3a 72 75 6e 2d 64 6f 74 20 28 6c 69 73 74 20 s:run-dot (list
d2a0: 22 64 69 67 72 61 70 68 20 74 65 73 74 73 20 7b "digraph tests {
d2b0: 22 20 22 61 20 2d 3e 20 62 22 20 22 7d 22 29 20 " "a -> b" "}")
d2c0: 22 70 6c 61 69 6e 22 29 0a 0a 28 64 65 66 69 6e "plain")..(defin
d2d0: 65 20 28 74 65 73 74 73 3a 72 75 6e 2d 64 6f 74 e (tests:run-dot
d2e0: 20 69 6e 64 61 74 20 6f 75 74 74 79 70 65 29 20 indat outtype)
d2f0: 3b 3b 20 6f 75 74 74 79 70 65 20 69 73 20 70 6c ;; outtype is pl
d300: 61 69 6e 2c 20 66 69 67 2c 20 64 6f 74 2c 20 65 ain, fig, dot, e
d310: 74 63 2e 20 68 74 74 70 3a 2f 2f 77 77 77 2e 67 tc. http://www.g
d320: 72 61 70 68 76 69 7a 2e 6f 72 67 2f 63 6f 6e 74 raphviz.org/cont
d330: 65 6e 74 2f 6f 75 74 70 75 74 2d 66 6f 72 6d 61 ent/output-forma
d340: 74 73 0a 20 20 28 6c 65 74 2d 76 61 6c 75 65 73 ts. (let-values
d350: 20 28 28 28 69 6e 70 20 6f 75 70 20 70 69 64 29 (((inp oup pid)
d360: 28 70 72 6f 63 65 73 73 20 22 65 6e 76 20 2d 69 (process "env -i
d370: 20 50 41 54 48 3d 5c 22 24 50 41 54 48 5c 22 20 PATH=\"$PATH\"
d380: 64 6f 74 22 20 28 6c 69 73 74 20 22 2d 54 22 20 dot" (list "-T"
d390: 6f 75 74 74 79 70 65 29 29 29 29 0a 20 20 20 20 outtype)))).
d3a0: 28 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d (with-output-to-
d3b0: 70 6f 72 74 20 6f 75 70 0a 20 20 20 20 20 20 28 port oup. (
d3c0: 6c 61 6d 62 64 61 20 28 29 0a 09 28 6d 61 70 20 lambda ()..(map
d3d0: 70 72 69 6e 74 20 69 6e 64 61 74 29 29 29 0a 20 print indat))).
d3e0: 20 20 20 28 63 6c 6f 73 65 2d 6f 75 74 70 75 74 (close-output
d3f0: 2d 70 6f 72 74 20 6f 75 70 29 0a 20 20 20 20 28 -port oup). (
d400: 6c 65 74 20 28 28 72 65 73 20 28 77 69 74 68 2d let ((res (with-
d410: 69 6e 70 75 74 2d 66 72 6f 6d 2d 70 6f 72 74 20 input-from-port
d420: 69 6e 70 0a 09 09 20 28 6c 61 6d 62 64 61 20 28 inp... (lambda (
d430: 29 0a 09 09 20 20 20 28 72 65 61 64 2d 6c 69 6e )... (read-lin
d440: 65 73 29 29 29 29 29 0a 20 20 20 20 20 20 28 63 es))))). (c
d450: 6c 6f 73 65 2d 69 6e 70 75 74 2d 70 6f 72 74 20 lose-input-port
d460: 69 6e 70 29 0a 20 20 20 20 20 20 72 65 73 29 29 inp). res))
d470: 29 0a 0a 3b 3b 20 72 65 61 64 20 64 61 74 61 20 )..;; read data
d480: 66 72 6f 6d 20 74 6d 70 20 66 69 6c 65 20 6f 72 from tmp file or
d490: 20 63 72 65 61 74 65 20 69 66 20 6e 6f 74 20 65 create if not e
d4a0: 78 69 73 74 73 0a 3b 3b 20 69 66 20 65 78 69 73 xists.;; if exis
d4b0: 74 73 20 72 65 67 65 6e 20 69 6e 20 62 61 63 6b ts regen in back
d4c0: 67 72 6f 75 6e 64 0a 3b 3b 0a 28 64 65 66 69 6e ground.;;.(defin
d4d0: 65 20 28 74 65 73 74 73 3a 6c 61 7a 79 2d 64 6f e (tests:lazy-do
d4e0: 74 20 74 65 73 74 72 65 63 6f 72 64 73 20 20 6f t testrecords o
d4f0: 75 74 74 79 70 65 20 73 69 7a 65 78 20 73 69 7a uttype sizex siz
d500: 65 79 29 0a 20 20 28 6c 65 74 20 28 28 64 66 69 ey). (let ((dfi
d510: 6c 65 20 28 63 6f 6e 63 20 22 2f 74 6d 70 2f 2e le (conc "/tmp/.
d520: 22 20 28 63 75 72 72 65 6e 74 2d 75 73 65 72 2d " (current-user-
d530: 6e 61 6d 65 29 20 22 2d 22 20 28 73 65 72 76 65 name) "-" (serve
d540: 72 3a 6d 6b 2d 73 69 67 6e 61 74 75 72 65 29 20 r:mk-signature)
d550: 22 2e 64 6f 74 22 29 29 0a 09 28 66 6e 61 6d 65 ".dot"))..(fname
d560: 20 28 63 6f 6e 63 20 22 2f 74 6d 70 2f 2e 22 20 (conc "/tmp/."
d570: 28 63 75 72 72 65 6e 74 2d 75 73 65 72 2d 6e 61 (current-user-na
d580: 6d 65 29 20 22 2d 22 20 28 73 65 72 76 65 72 3a me) "-" (server:
d590: 6d 6b 2d 73 69 67 6e 61 74 75 72 65 29 20 22 2e mk-signature) ".
d5a0: 64 6f 74 64 61 74 22 29 29 29 0a 20 20 20 20 28 dotdat"))). (
d5b0: 74 65 73 74 73 3a 77 72 69 74 65 2d 64 6f 74 2d tests:write-dot-
d5c0: 66 69 6c 65 20 74 65 73 74 72 65 63 6f 72 64 73 file testrecords
d5d0: 20 64 66 69 6c 65 20 73 69 7a 65 78 20 73 69 7a dfile sizex siz
d5e0: 65 79 29 0a 20 20 20 20 28 69 66 20 28 63 6f 6d ey). (if (com
d5f0: 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 3f mon:file-exists?
d600: 20 66 6e 61 6d 65 29 0a 09 28 6c 65 74 20 28 28 fname)..(let ((
d610: 72 65 73 20 28 77 69 74 68 2d 69 6e 70 75 74 2d res (with-input-
d620: 66 72 6f 6d 2d 66 69 6c 65 20 66 6e 61 6d 65 0a from-file fname.
d630: 09 09 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 .. (lambda (
d640: 29 0a 09 09 20 20 20 20 20 20 20 28 72 65 61 64 )... (read
d650: 2d 6c 69 6e 65 73 29 29 29 29 29 0a 09 20 20 28 -lines))))).. (
d660: 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 65 6e system (conc "en
d670: 76 20 2d 69 20 50 41 54 48 3d 5c 22 24 50 41 54 v -i PATH=\"$PAT
d680: 48 5c 22 20 64 6f 74 20 2d 54 20 22 20 6f 75 74 H\" dot -T " out
d690: 74 79 70 65 20 22 20 3c 20 22 20 64 66 69 6c 65 type " < " dfile
d6a0: 20 22 20 3e 20 22 20 66 6e 61 6d 65 20 22 26 22 " > " fname "&"
d6b0: 29 29 0a 09 20 20 72 65 73 29 0a 09 28 62 65 67 )).. res)..(beg
d6c0: 69 6e 0a 09 20 20 28 73 79 73 74 65 6d 20 28 63 in.. (system (c
d6d0: 6f 6e 63 20 22 65 6e 76 20 2d 69 20 50 41 54 48 onc "env -i PATH
d6e0: 3d 5c 22 24 50 41 54 48 5c 22 20 64 6f 74 20 2d =\"$PATH\" dot -
d6f0: 54 20 22 20 6f 75 74 74 79 70 65 20 22 20 3c 20 T " outtype " <
d700: 22 20 64 66 69 6c 65 20 22 20 3e 20 22 20 66 6e " dfile " > " fn
d710: 61 6d 65 29 29 0a 09 20 20 28 77 69 74 68 2d 69 ame)).. (with-i
d720: 6e 70 75 74 2d 66 72 6f 6d 2d 66 69 6c 65 20 66 nput-from-file f
d730: 6e 61 6d 65 0a 09 20 20 20 20 28 6c 61 6d 62 64 name.. (lambd
d740: 61 20 28 29 0a 09 20 20 20 20 20 20 28 72 65 61 a ().. (rea
d750: 64 2d 6c 69 6e 65 73 29 29 29 29 29 29 29 0a 09 d-lines)))))))..
d760: 20 20 0a 0a 3b 3b 20 66 6f 72 20 65 61 63 68 20 ..;; for each
d770: 74 65 73 74 3a 0a 3b 3b 20 20 20 0a 28 64 65 66 test:.;; .(def
d780: 69 6e 65 20 28 74 65 73 74 73 3a 66 69 6c 74 65 ine (tests:filte
d790: 72 2d 6e 6f 6e 2d 72 75 6e 6e 61 62 6c 65 20 72 r-non-runnable r
d7a0: 75 6e 2d 69 64 20 74 65 73 74 6b 65 79 6e 61 6d un-id testkeynam
d7b0: 65 73 20 74 65 73 74 72 65 63 6f 72 64 73 68 61 es testrecordsha
d7c0: 73 68 29 0a 20 20 28 6c 65 74 20 28 28 72 75 6e sh). (let ((run
d7d0: 6e 61 62 6c 65 73 20 27 28 29 29 29 0a 20 20 20 nables '())).
d7e0: 20 28 66 6f 72 2d 65 61 63 68 0a 20 20 20 20 20 (for-each.
d7f0: 28 6c 61 6d 62 64 61 20 28 74 65 73 74 6b 65 79 (lambda (testkey
d800: 6e 61 6d 65 29 0a 20 20 20 20 20 20 20 28 6c 65 name). (le
d810: 74 2a 20 28 28 74 65 73 74 2d 72 65 63 6f 72 64 t* ((test-record
d820: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
d830: 20 74 65 73 74 72 65 63 6f 72 64 73 68 61 73 68 testrecordshash
d840: 20 74 65 73 74 6b 65 79 6e 61 6d 65 29 29 0a 09 testkeyname))..
d850: 20 20 20 20 20 20 28 74 65 73 74 2d 6e 61 6d 65 (test-name
d860: 20 20 20 28 74 65 73 74 73 3a 74 65 73 74 71 75 (tests:testqu
d870: 65 75 65 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 eue-get-testname
d880: 20 20 74 65 73 74 2d 72 65 63 6f 72 64 29 29 0a test-record)).
d890: 09 20 20 20 20 20 20 28 69 74 65 6d 64 61 74 20 . (itemdat
d8a0: 20 20 20 20 28 74 65 73 74 73 3a 74 65 73 74 71 (tests:testq
d8b0: 75 65 75 65 2d 67 65 74 2d 69 74 65 6d 64 61 74 ueue-get-itemdat
d8c0: 20 20 20 74 65 73 74 2d 72 65 63 6f 72 64 29 29 test-record))
d8d0: 0a 09 20 20 20 20 20 20 28 69 74 65 6d 2d 70 61 .. (item-pa
d8e0: 74 68 20 20 20 28 74 65 73 74 73 3a 74 65 73 74 th (tests:test
d8f0: 71 75 65 75 65 2d 67 65 74 2d 69 74 65 6d 5f 70 queue-get-item_p
d900: 61 74 68 20 74 65 73 74 2d 72 65 63 6f 72 64 29 ath test-record)
d910: 29 0a 09 20 20 20 20 20 20 28 77 61 69 74 6f 6e ).. (waiton
d920: 73 20 20 20 20 20 28 74 65 73 74 73 3a 74 65 73 s (tests:tes
d930: 74 71 75 65 75 65 2d 67 65 74 2d 77 61 69 74 6f tqueue-get-waito
d940: 6e 73 20 20 20 74 65 73 74 2d 72 65 63 6f 72 64 ns test-record
d950: 29 29 0a 09 20 20 20 20 20 20 28 6b 65 65 70 2d )).. (keep-
d960: 74 65 73 74 20 20 20 23 74 29 0a 09 20 20 20 20 test #t)..
d970: 20 20 28 74 65 73 74 2d 69 64 20 20 20 20 20 28 (test-id (
d980: 72 6d 74 3a 67 65 74 2d 74 65 73 74 2d 69 64 20 rmt:get-test-id
d990: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
d9a0: 20 69 74 65 6d 2d 70 61 74 68 29 29 0a 09 20 20 item-path))..
d9b0: 20 20 20 20 28 74 64 61 74 20 20 20 20 20 20 20 (tdat
d9c0: 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 69 6e (rmt:get-testin
d9d0: 66 6f 2d 73 74 61 74 65 2d 73 74 61 74 75 73 20 fo-state-status
d9e0: 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 29 run-id test-id))
d9f0: 29 20 3b 3b 20 28 63 64 62 3a 67 65 74 2d 74 65 ) ;; (cdb:get-te
da00: 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 2a 72 st-info-by-id *r
da10: 75 6e 72 65 6d 6f 74 65 2a 20 74 65 73 74 2d 69 unremote* test-i
da20: 64 29 29 29 0a 09 20 28 69 66 20 74 64 61 74 0a d))).. (if tdat.
da30: 09 20 20 20 20 20 28 62 65 67 69 6e 0a 09 20 20 . (begin..
da40: 20 20 20 20 20 3b 3b 20 4c 6f 6f 6b 20 61 74 20 ;; Look at
da50: 74 68 65 20 74 65 73 74 20 73 74 61 74 65 20 61 the test state a
da60: 6e 64 20 73 74 61 74 75 73 0a 09 20 20 20 20 20 nd status..
da70: 20 20 28 69 66 20 28 6f 72 20 28 61 6e 64 20 28 (if (or (and (
da80: 6d 65 6d 62 65 72 20 28 64 62 3a 74 65 73 74 2d member (db:test-
da90: 67 65 74 2d 73 74 61 74 75 73 20 74 64 61 74 29 get-status tdat)
daa0: 20 0a 09 09 09 09 20 20 20 20 27 28 22 50 41 53 ..... '("PAS
dab0: 53 22 20 22 57 41 52 4e 22 20 22 57 41 49 56 45 S" "WARN" "WAIVE
dac0: 44 22 20 22 43 48 45 43 4b 22 20 22 53 4b 49 50 D" "CHECK" "SKIP
dad0: 22 29 29 0a 09 09 09 20 20 20 20 28 65 71 75 61 ")).... (equa
dae0: 6c 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d l? (db:test-get-
daf0: 73 74 61 74 65 20 74 64 61 74 29 20 22 43 4f 4d state tdat) "COM
db00: 50 4c 45 54 45 44 22 29 29 0a 09 09 20 20 20 20 PLETED"))...
db10: 20 20 20 28 6d 65 6d 62 65 72 20 28 64 62 3a 74 (member (db:t
db20: 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 74 64 est-get-state td
db30: 61 74 29 0a 09 09 09 09 20 20 20 20 27 28 22 49 at)..... '("I
db40: 4e 43 4f 4d 50 4c 45 54 45 22 20 22 4b 49 4c 4c NCOMPLETE" "KILL
db50: 45 44 22 29 29 29 0a 09 09 20 20 20 28 73 65 74 ED")))... (set
db60: 21 20 6b 65 65 70 2d 74 65 73 74 20 23 66 29 29 ! keep-test #f))
db70: 0a 0a 09 20 20 20 20 20 20 20 3b 3b 20 65 78 61 ... ;; exa
db80: 6d 69 6e 65 20 77 61 69 74 6f 6e 73 20 66 6f 72 mine waitons for
db90: 20 61 6e 79 20 66 61 69 6c 73 2e 20 49 66 20 69 any fails. If i
dba0: 74 20 69 73 20 46 41 49 4c 20 6f 72 20 49 4e 43 t is FAIL or INC
dbb0: 4f 4d 50 4c 45 54 45 20 74 68 65 6e 20 65 6c 69 OMPLETE then eli
dbc0: 6d 69 6e 61 74 65 20 74 68 69 73 20 74 65 73 74 minate this test
dbd0: 0a 09 20 20 20 20 20 20 20 3b 3b 20 66 72 6f 6d .. ;; from
dbe0: 20 74 68 65 20 72 75 6e 6e 61 62 6c 65 20 6c 69 the runnable li
dbf0: 73 74 0a 09 20 20 20 20 20 20 20 28 69 66 20 6b st.. (if k
dc00: 65 65 70 2d 74 65 73 74 0a 09 09 20 20 20 28 66 eep-test... (f
dc10: 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 or-each (lambda
dc20: 28 77 61 69 74 6f 6e 29 0a 09 09 09 20 20 20 20 (waiton)....
dc30: 20 20 20 3b 3b 20 66 6f 72 20 6e 6f 77 20 77 65 ;; for now we
dc40: 20 61 72 65 20 77 61 69 74 69 6e 67 20 6f 6e 6c are waiting onl
dc50: 79 20 6f 6e 20 74 68 65 20 70 61 72 65 6e 74 20 y on the parent
dc60: 74 65 73 74 0a 09 09 09 20 20 20 20 20 20 20 28 test.... (
dc70: 6c 65 74 2a 20 28 28 70 61 72 65 6e 74 2d 74 65 let* ((parent-te
dc80: 73 74 2d 69 64 20 28 72 6d 74 3a 67 65 74 2d 74 st-id (rmt:get-t
dc90: 65 73 74 2d 69 64 20 72 75 6e 2d 69 64 20 77 61 est-id run-id wa
dca0: 69 74 6f 6e 20 22 22 29 29 0a 09 09 09 09 20 20 iton "")).....
dcb0: 20 20 20 20 28 77 74 64 61 74 20 20 20 20 20 20 (wtdat
dcc0: 20 20 20 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 (rmt:get-tes
dcd0: 74 69 6e 66 6f 2d 73 74 61 74 65 2d 73 74 61 74 tinfo-state-stat
dce0: 75 73 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 us run-id test-i
dcf0: 64 29 29 29 20 3b 3b 20 28 63 64 62 3a 67 65 74 d))) ;; (cdb:get
dd00: 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 -test-info-by-id
dd10: 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 74 65 73 *runremote* tes
dd20: 74 2d 69 64 29 29 29 0a 09 09 09 09 20 28 69 66 t-id)))..... (if
dd30: 20 28 6f 72 20 28 61 6e 64 20 28 65 71 75 61 6c (or (and (equal
dd40: 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 ? (db:test-get-s
dd50: 74 61 74 65 20 77 74 64 61 74 29 20 22 43 4f 4d tate wtdat) "COM
dd60: 50 4c 45 54 45 44 22 29 0a 09 09 09 09 09 20 20 PLETED")......
dd70: 20 20 20 20 28 6d 65 6d 62 65 72 20 28 64 62 3a (member (db:
dd80: 74 65 73 74 2d 67 65 74 2d 73 74 61 74 75 73 20 test-get-status
dd90: 77 74 64 61 74 29 20 27 28 22 46 41 49 4c 22 20 wtdat) '("FAIL"
dda0: 22 41 42 4f 52 54 22 29 29 29 0a 09 09 09 09 09 "ABORT")))......
ddb0: 20 28 6d 65 6d 62 65 72 20 28 64 62 3a 74 65 73 (member (db:tes
ddc0: 74 2d 67 65 74 2d 73 74 61 74 75 73 20 77 74 64 t-get-status wtd
ddd0: 61 74 29 20 20 27 28 22 4b 49 4c 4c 45 44 22 29 at) '("KILLED")
dde0: 29 0a 09 09 09 09 09 20 28 6d 65 6d 62 65 72 20 )...... (member
ddf0: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 (db:test-get-sta
de00: 74 65 20 77 74 64 61 74 29 20 20 20 27 28 22 49 te wtdat) '("I
de10: 4e 43 4f 4d 50 45 54 45 22 29 29 29 0a 09 09 09 NCOMPETE")))....
de20: 09 20 3b 3b 20 28 69 66 20 28 6f 72 20 28 6d 65 . ;; (if (or (me
de30: 6d 62 65 72 20 28 64 62 3a 74 65 73 74 2d 67 65 mber (db:test-ge
de40: 74 2d 73 74 61 74 75 73 20 77 74 64 61 74 29 0a t-status wtdat).
de50: 09 09 09 09 20 3b 3b 20 20 20 20 20 20 20 20 09 .... ;; .
de60: 20 27 28 22 46 41 49 4c 22 20 22 4b 49 4c 4c 45 '("FAIL" "KILLE
de70: 44 22 29 29 0a 09 09 09 09 20 3b 3b 20 20 20 20 D"))..... ;;
de80: 20 20 20 20 20 28 6d 65 6d 62 65 72 20 28 64 62 (member (db
de90: 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 :test-get-state
dea0: 77 74 64 61 74 29 0a 09 09 09 09 20 3b 3b 20 20 wtdat)..... ;;
deb0: 20 20 20 20 20 20 09 20 27 28 22 49 4e 43 4f 4d . '("INCOM
dec0: 50 45 54 45 22 29 29 29 0a 09 09 09 09 20 20 20 PETE"))).....
ded0: 20 20 28 73 65 74 21 20 6b 65 65 70 2d 74 65 73 (set! keep-tes
dee0: 74 20 23 66 29 29 29 29 20 3b 3b 20 6e 6f 20 70 t #f)))) ;; no p
def0: 6f 69 6e 74 20 69 6e 20 72 75 6e 6e 69 6e 67 20 oint in running
df00: 74 68 69 73 20 6f 6e 65 20 61 67 61 69 6e 0a 09 this one again..
df10: 09 09 20 20 20 20 20 77 61 69 74 6f 6e 73 29 29 .. waitons))
df20: 29 29 0a 09 20 28 69 66 20 6b 65 65 70 2d 74 65 )).. (if keep-te
df30: 73 74 20 28 73 65 74 21 20 72 75 6e 6e 61 62 6c st (set! runnabl
df40: 65 73 20 28 63 6f 6e 73 20 74 65 73 74 6b 65 79 es (cons testkey
df50: 6e 61 6d 65 20 72 75 6e 6e 61 62 6c 65 73 29 29 name runnables))
df60: 29 29 29 0a 20 20 20 20 20 74 65 73 74 6b 65 79 ))). testkey
df70: 6e 61 6d 65 73 29 0a 20 20 20 20 72 75 6e 6e 61 names). runna
df80: 62 6c 65 73 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d bles))..;;======
df90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
dfa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
dfb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
dfc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
dfd0: 0a 3b 3b 20 74 65 73 74 20 73 74 65 70 73 0a 3b .;; test steps.;
dfe0: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
dff0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e000: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e020: 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 74 65 73 74 =======..;; test
e030: 73 74 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 step-set-status!
e040: 20 75 73 65 64 20 74 6f 20 62 65 20 68 65 72 65 used to be here
e050: 0a 0a 3b 3b 20 4e 4f 54 20 4e 45 45 44 45 44 0a ..;; NOT NEEDED.
e060: 23 3b 28 64 65 66 69 6e 65 20 28 74 65 73 74 2d #;(define (test-
e070: 67 65 74 2d 6b 69 6c 6c 2d 72 65 71 75 65 73 74 get-kill-request
e080: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 run-id test-id)
e090: 20 3b 3b 20 72 75 6e 2d 69 64 20 74 65 73 74 2d ;; run-id test-
e0a0: 6e 61 6d 65 20 69 74 65 6d 64 61 74 29 0a 20 20 name itemdat).
e0b0: 28 6c 65 74 2a 20 28 28 74 65 73 74 64 61 74 20 (let* ((testdat
e0c0: 20 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 2d (rmt:get-test-
e0d0: 73 74 61 74 65 2d 73 74 61 74 75 73 2d 62 79 2d state-status-by-
e0e0: 69 64 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 id run-id test-i
e0f0: 64 29 29 29 0a 20 20 20 20 28 61 6e 64 20 74 65 d))). (and te
e100: 73 74 64 61 74 0a 09 20 28 65 71 75 61 6c 3f 20 stdat.. (equal?
e110: 28 63 61 72 20 74 65 73 74 64 61 74 29 20 22 4b (car testdat) "K
e120: 49 4c 4c 52 45 51 22 29 29 29 29 0a 0a 28 64 65 ILLREQ"))))..(de
e130: 66 69 6e 65 20 28 74 65 73 74 3a 74 64 62 2d 67 fine (test:tdb-g
e140: 65 74 2d 72 75 6e 64 61 74 2d 63 6f 75 6e 74 20 et-rundat-count
e150: 74 64 62 29 0a 20 20 28 69 66 20 74 64 62 0a 20 tdb). (if tdb.
e160: 20 20 20 20 20 28 6c 65 74 20 28 28 72 65 73 20 (let ((res
e170: 30 29 29 0a 09 28 73 71 6c 69 74 65 33 3a 66 6f 0))..(sqlite3:fo
e180: 72 2d 65 61 63 68 2d 72 6f 77 0a 09 20 28 6c 61 r-each-row.. (la
e190: 6d 62 64 61 20 28 63 6f 75 6e 74 29 0a 09 20 20 mbda (count)..
e1a0: 20 28 73 65 74 21 20 72 65 73 20 63 6f 75 6e 74 (set! res count
e1b0: 29 29 0a 09 20 74 64 62 0a 09 20 22 53 45 4c 45 )).. tdb.. "SELE
e1c0: 43 54 20 63 6f 75 6e 74 28 69 64 29 20 46 52 4f CT count(id) FRO
e1d0: 4d 20 74 65 73 74 5f 72 75 6e 64 61 74 3b 22 29 M test_rundat;")
e1e0: 0a 09 72 65 73 29 29 0a 20 20 30 29 0a 0a 28 64 ..res)). 0)..(d
e1f0: 65 66 69 6e 65 20 28 74 65 73 74 73 3a 75 70 64 efine (tests:upd
e200: 61 74 65 2d 63 65 6e 74 72 61 6c 2d 6d 65 74 61 ate-central-meta
e210: 2d 69 6e 66 6f 20 72 75 6e 2d 69 64 20 74 65 73 -info run-id tes
e220: 74 2d 69 64 20 63 70 75 6c 6f 61 64 20 64 69 73 t-id cpuload dis
e230: 6b 66 72 65 65 20 6d 69 6e 75 74 65 73 20 75 6e kfree minutes un
e240: 61 6d 65 20 68 6f 73 74 6e 61 6d 65 29 0a 20 20 ame hostname).
e250: 28 72 6d 74 3a 67 65 6e 65 72 61 6c 2d 63 61 6c (rmt:general-cal
e260: 6c 20 27 75 70 64 61 74 65 2d 74 65 73 74 2d 72 l 'update-test-r
e270: 75 6e 64 61 74 20 72 75 6e 2d 69 64 20 74 65 73 undat run-id tes
e280: 74 2d 69 64 20 28 63 75 72 72 65 6e 74 2d 73 65 t-id (current-se
e290: 63 6f 6e 64 73 29 20 28 6f 72 20 63 70 75 6c 6f conds) (or cpulo
e2a0: 61 64 20 2d 31 29 28 6f 72 20 64 69 73 6b 66 72 ad -1)(or diskfr
e2b0: 65 65 20 2d 31 29 20 2d 31 20 28 6f 72 20 6d 69 ee -1) -1 (or mi
e2c0: 6e 75 74 65 73 20 2d 31 29 29 0a 20 20 28 69 66 nutes -1)). (if
e2d0: 20 28 61 6e 64 20 63 70 75 6c 6f 61 64 20 64 69 (and cpuload di
e2e0: 73 6b 66 72 65 65 29 0a 20 20 20 20 20 20 28 72 skfree). (r
e2f0: 6d 74 3a 67 65 6e 65 72 61 6c 2d 63 61 6c 6c 20 mt:general-call
e300: 27 75 70 64 61 74 65 2d 63 70 75 6c 6f 61 64 2d 'update-cpuload-
e310: 64 69 73 6b 66 72 65 65 20 72 75 6e 2d 69 64 20 diskfree run-id
e320: 63 70 75 6c 6f 61 64 20 64 69 73 6b 66 72 65 65 cpuload diskfree
e330: 20 74 65 73 74 2d 69 64 29 29 0a 20 20 28 69 66 test-id)). (if
e340: 20 6d 69 6e 75 74 65 73 20 0a 20 20 20 20 20 20 minutes .
e350: 28 72 6d 74 3a 67 65 6e 65 72 61 6c 2d 63 61 6c (rmt:general-cal
e360: 6c 20 27 75 70 64 61 74 65 2d 72 75 6e 2d 64 75 l 'update-run-du
e370: 72 61 74 69 6f 6e 20 72 75 6e 2d 69 64 20 6d 69 ration run-id mi
e380: 6e 75 74 65 73 20 74 65 73 74 2d 69 64 29 29 0a nutes test-id)).
e390: 20 20 28 69 66 20 28 61 6e 64 20 75 6e 61 6d 65 (if (and uname
e3a0: 20 68 6f 73 74 6e 61 6d 65 29 0a 20 20 20 20 20 hostname).
e3b0: 20 28 72 6d 74 3a 67 65 6e 65 72 61 6c 2d 63 61 (rmt:general-ca
e3c0: 6c 6c 20 27 75 70 64 61 74 65 2d 75 6e 61 6d 65 ll 'update-uname
e3d0: 2d 68 6f 73 74 20 72 75 6e 2d 69 64 20 75 6e 61 -host run-id una
e3e0: 6d 65 20 68 6f 73 74 6e 61 6d 65 20 74 65 73 74 me hostname test
e3f0: 2d 69 64 29 29 29 0a 20 20 0a 3b 3b 20 54 68 69 -id))). .;; Thi
e400: 73 20 6f 6e 65 20 69 73 20 66 6f 72 20 72 75 6e s one is for run
e410: 6e 69 6e 67 20 77 69 74 68 20 6e 6f 20 64 62 20 ning with no db
e420: 61 63 63 65 73 73 20 28 69 2e 65 2e 20 76 69 61 access (i.e. via
e430: 20 72 6d 74 3a 20 69 6e 74 65 72 6e 61 6c 6c 79 rmt: internally
e440: 29 0a 28 64 65 66 69 6e 65 20 28 74 65 73 74 73 ).(define (tests
e450: 3a 73 65 74 2d 66 75 6c 6c 2d 6d 65 74 61 2d 69 :set-full-meta-i
e460: 6e 66 6f 20 64 62 20 74 65 73 74 2d 69 64 20 72 nfo db test-id r
e470: 75 6e 2d 69 64 20 6d 69 6e 75 74 65 73 20 77 6f un-id minutes wo
e480: 72 6b 2d 61 72 65 61 20 72 65 6d 74 72 69 65 73 rk-area remtries
e490: 29 0a 3b 3b 20 28 64 65 66 69 6e 65 20 28 74 65 ).;; (define (te
e4a0: 73 74 73 3a 73 65 74 2d 66 75 6c 6c 2d 6d 65 74 sts:set-full-met
e4b0: 61 2d 69 6e 66 6f 20 74 65 73 74 2d 69 64 20 72 a-info test-id r
e4c0: 75 6e 2d 69 64 20 6d 69 6e 75 74 65 73 20 77 6f un-id minutes wo
e4d0: 72 6b 2d 61 72 65 61 29 0a 3b 3b 20 20 28 6c 65 rk-area).;; (le
e4e0: 74 20 28 28 72 65 6d 74 72 69 65 73 20 31 30 29 t ((remtries 10)
e4f0: 29 0a 20 20 28 6c 65 74 2a 20 28 28 63 70 75 6c ). (let* ((cpul
e500: 6f 61 64 20 20 28 63 6f 6d 6d 6f 6e 6d 6f 64 3a oad (commonmod:
e510: 67 65 74 2d 63 70 75 2d 6c 6f 61 64 29 29 0a 09 get-cpu-load))..
e520: 20 28 64 69 73 6b 66 72 65 65 20 28 67 65 74 2d (diskfree (get-
e530: 64 66 20 28 63 75 72 72 65 6e 74 2d 64 69 72 65 df (current-dire
e540: 63 74 6f 72 79 29 29 29 0a 09 20 28 75 6e 61 6d ctory))).. (unam
e550: 65 20 20 20 20 28 67 65 74 2d 75 6e 61 6d 65 20 e (get-uname
e560: 22 2d 73 72 76 70 69 6f 22 29 29 0a 09 20 28 68 "-srvpio")).. (h
e570: 6f 73 74 6e 61 6d 65 20 28 67 65 74 2d 68 6f 73 ostname (get-hos
e580: 74 2d 6e 61 6d 65 29 29 29 0a 20 20 20 20 28 74 t-name))). (t
e590: 65 73 74 73 3a 75 70 64 61 74 65 2d 63 65 6e 74 ests:update-cent
e5a0: 72 61 6c 2d 6d 65 74 61 2d 69 6e 66 6f 20 72 75 ral-meta-info ru
e5b0: 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 63 70 75 n-id test-id cpu
e5c0: 6c 6f 61 64 20 64 69 73 6b 66 72 65 65 20 6d 69 load diskfree mi
e5d0: 6e 75 74 65 73 20 75 6e 61 6d 65 20 68 6f 73 74 nutes uname host
e5e0: 6e 61 6d 65 29 29 29 0a 20 20 20 20 0a 3b 3b 20 name))). .;;
e5f0: 28 64 65 66 69 6e 65 20 28 74 65 73 74 73 3a 73 (define (tests:s
e600: 65 74 2d 70 61 72 74 69 61 6c 2d 6d 65 74 61 2d et-partial-meta-
e610: 69 6e 66 6f 20 74 65 73 74 2d 69 64 20 72 75 6e info test-id run
e620: 2d 69 64 20 6d 69 6e 75 74 65 73 20 77 6f 72 6b -id minutes work
e630: 2d 61 72 65 61 29 0a 23 3b 28 64 65 66 69 6e 65 -area).#;(define
e640: 20 28 74 65 73 74 73 3a 73 65 74 2d 70 61 72 74 (tests:set-part
e650: 69 61 6c 2d 6d 65 74 61 2d 69 6e 66 6f 20 74 65 ial-meta-info te
e660: 73 74 2d 69 64 20 72 75 6e 2d 69 64 20 6d 69 6e st-id run-id min
e670: 75 74 65 73 20 77 6f 72 6b 2d 61 72 65 61 20 72 utes work-area r
e680: 65 6d 74 72 69 65 73 29 0a 20 20 28 6c 65 74 2a emtries). (let*
e690: 20 28 28 63 70 75 6c 6f 61 64 20 20 28 67 65 74 ((cpuload (get
e6a0: 2d 63 70 75 2d 6c 6f 61 64 29 29 0a 09 20 28 64 -cpu-load)).. (d
e6b0: 69 73 6b 66 72 65 65 20 28 67 65 74 2d 64 66 20 iskfree (get-df
e6c0: 28 63 75 72 72 65 6e 74 2d 64 69 72 65 63 74 6f (current-directo
e6d0: 72 79 29 29 29 0a 09 20 28 72 65 6d 74 72 69 65 ry))).. (remtrie
e6e0: 73 20 31 30 29 29 0a 20 20 20 20 28 68 61 6e 64 s 10)). (hand
e6f0: 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 20 20 le-exceptions.
e700: 20 20 20 65 78 6e 0a 20 20 20 20 20 28 69 66 20 exn. (if
e710: 28 3e 20 72 65 6d 74 72 69 65 73 20 30 29 0a 09 (> remtries 0)..
e720: 20 28 62 65 67 69 6e 0a 09 20 20 20 28 70 72 69 (begin.. (pri
e730: 6e 74 2d 63 61 6c 6c 2d 63 68 61 69 6e 20 28 63 nt-call-chain (c
e740: 75 72 72 65 6e 74 2d 65 72 72 6f 72 2d 70 6f 72 urrent-error-por
e750: 74 29 29 0a 09 20 20 20 28 64 65 62 75 67 3a 70 t)).. (debug:p
e760: 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 rint-info 0 *def
e770: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
e780: 57 41 52 4e 49 4e 47 3a 20 66 61 69 6c 65 64 20 WARNING: failed
e790: 74 6f 20 73 65 74 20 6d 65 74 61 20 69 6e 66 6f to set meta info
e7a0: 2e 20 57 69 6c 6c 20 74 72 79 20 22 20 72 65 6d . Will try " rem
e7b0: 74 72 69 65 73 20 22 20 6d 6f 72 65 20 74 69 6d tries " more tim
e7c0: 65 73 22 29 0a 09 20 20 20 28 73 65 74 21 20 72 es").. (set! r
e7d0: 65 6d 74 72 69 65 73 20 28 2d 20 72 65 6d 74 72 emtries (- remtr
e7e0: 69 65 73 20 31 29 29 0a 09 20 20 20 28 74 68 72 ies 1)).. (thr
e7f0: 65 61 64 2d 73 6c 65 65 70 21 20 31 30 29 0a 09 ead-sleep! 10)..
e800: 20 20 20 28 74 65 73 74 73 3a 73 65 74 2d 66 75 (tests:set-fu
e810: 6c 6c 2d 6d 65 74 61 2d 69 6e 66 6f 20 64 62 20 ll-meta-info db
e820: 74 65 73 74 2d 69 64 20 72 75 6e 2d 69 64 20 6d test-id run-id m
e830: 69 6e 75 74 65 73 20 77 6f 72 6b 2d 61 72 65 61 inutes work-area
e840: 20 28 2d 20 72 65 6d 74 72 69 65 73 20 31 29 29 (- remtries 1))
e850: 29 0a 09 20 28 6c 65 74 20 28 28 65 72 72 2d 73 ).. (let ((err-s
e860: 74 61 74 75 73 20 28 28 63 6f 6e 64 69 74 69 6f tatus ((conditio
e870: 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 65 73 n-property-acces
e880: 73 6f 72 20 27 73 71 6c 69 74 65 33 20 27 73 74 sor 'sqlite3 'st
e890: 61 74 75 73 20 23 66 29 20 65 78 6e 29 29 29 0a atus #f) exn))).
e8a0: 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 . (debug:print
e8b0: 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c -error 0 *defaul
e8c0: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 74 72 69 t-log-port* "tri
e8d0: 65 64 20 66 6f 72 20 6f 76 65 72 20 61 20 6d 69 ed for over a mi
e8e0: 6e 75 74 65 20 74 6f 20 75 70 64 61 74 65 20 6d nute to update m
e8f0: 65 74 61 20 69 6e 66 6f 20 61 6e 64 20 66 61 69 eta info and fai
e900: 6c 65 64 2e 20 47 69 76 69 6e 67 20 75 70 22 29 led. Giving up")
e910: 0a 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e .. (debug:prin
e920: 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 0 *default-log
e930: 2d 70 6f 72 74 2a 20 22 45 58 43 45 50 54 49 4f -port* "EXCEPTIO
e940: 4e 3a 20 64 61 74 61 62 61 73 65 20 70 72 6f 62 N: database prob
e950: 61 62 6c 79 20 6f 76 65 72 6c 6f 61 64 65 64 20 ably overloaded
e960: 6f 72 20 75 6e 72 65 61 64 61 62 6c 65 2e 22 29 or unreadable.")
e970: 0a 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e .. (debug:prin
e980: 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 0 *default-log
e990: 2d 70 6f 72 74 2a 20 22 20 6d 65 73 73 61 67 65 -port* " message
e9a0: 3a 20 22 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d : " ((condition-
e9b0: 70 72 6f 70 65 72 74 79 2d 61 63 63 65 73 73 6f property-accesso
e9c0: 72 20 27 65 78 6e 20 27 6d 65 73 73 61 67 65 29 r 'exn 'message)
e9d0: 20 65 78 6e 29 29 0a 09 20 20 20 28 64 65 62 75 exn)).. (debu
e9e0: 67 3a 70 72 69 6e 74 20 35 20 2a 64 65 66 61 75 g:print 5 *defau
e9f0: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 65 78 lt-log-port* "ex
ea00: 6e 3d 22 20 28 63 6f 6e 64 69 74 69 6f 6e 2d 3e n=" (condition->
ea10: 6c 69 73 74 20 65 78 6e 29 29 0a 09 20 20 20 28 list exn)).. (
ea20: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
ea30: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
ea40: 20 22 20 73 74 61 74 75 73 3a 20 20 22 20 28 28 " status: " ((
ea50: 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 72 condition-proper
ea60: 74 79 2d 61 63 63 65 73 73 6f 72 20 27 73 71 6c ty-accessor 'sql
ea70: 69 74 65 33 20 27 73 74 61 74 75 73 29 20 65 78 ite3 'status) ex
ea80: 6e 29 29 0a 09 20 20 20 28 70 72 69 6e 74 2d 63 n)).. (print-c
ea90: 61 6c 6c 2d 63 68 61 69 6e 20 28 63 75 72 72 65 all-chain (curre
eaa0: 6e 74 2d 65 72 72 6f 72 2d 70 6f 72 74 29 29 29 nt-error-port)))
eab0: 29 0a 20 20 20 20 20 28 74 65 73 74 73 3a 75 70 ). (tests:up
eac0: 64 61 74 65 2d 74 65 73 74 64 61 74 2d 6d 65 74 date-testdat-met
ead0: 61 2d 69 6e 66 6f 20 64 62 20 74 65 73 74 2d 69 a-info db test-i
eae0: 64 20 77 6f 72 6b 2d 61 72 65 61 20 63 70 75 6c d work-area cpul
eaf0: 6f 61 64 20 64 69 73 6b 66 72 65 65 20 6d 69 6e oad diskfree min
eb00: 75 74 65 73 29 0a 20 20 29 29 29 0a 09 20 0a 3b utes). ))).. .;
eb10: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
eb20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eb30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eb40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eb50: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 41 20 52 20 43 =======.;; A R C
eb60: 20 48 20 49 20 56 20 49 20 4e 20 47 0a 3b 3b 3d H I V I N G.;;=
eb70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eb80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eb90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eba0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ebb0: 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 =====..(define (
ebc0: 74 65 73 74 3a 61 72 63 68 69 76 65 20 64 62 20 test:archive db
ebd0: 74 65 73 74 2d 69 64 29 0a 20 20 23 66 29 0a 0a test-id). #f)..
ebe0: 28 64 65 66 69 6e 65 20 28 74 65 73 74 3a 61 72 (define (test:ar
ebf0: 63 68 69 76 65 2d 74 65 73 74 73 20 64 62 20 6b chive-tests db k
ec00: 65 79 6e 61 6d 65 73 20 74 61 72 67 65 74 29 0a eynames target).
ec10: 20 20 23 66 29 0a 0a 0a 29 0a #f)...).