Artifact
e1bfe096ff4190a99362e800d5bf7fcc07fb96e1:
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 28 64 65 63 6c 61 72 65 20 28 ====..(declare (
0390: 75 6e 69 74 20 61 70 69 6d 6f 64 29 29 0a 28 64 unit apimod)).(d
03a0: 65 63 6c 61 72 65 20 28 75 73 65 73 20 63 6f 6d eclare (uses com
03b0: 6d 6f 6e 6d 6f 64 29 29 0a 28 64 65 63 6c 61 72 monmod)).(declar
03c0: 65 20 28 75 73 65 73 20 64 62 6d 6f 64 29 29 0a e (uses dbmod)).
03d0: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 64 (declare (uses d
03e0: 65 62 75 67 70 72 69 6e 74 29 29 0a 28 64 65 63 ebugprint)).(dec
03f0: 6c 61 72 65 20 28 75 73 65 73 20 74 61 73 6b 73 lare (uses tasks
0400: 6d 6f 64 29 29 0a 28 64 65 63 6c 61 72 65 20 28 mod)).(declare (
0410: 75 73 65 73 20 73 65 72 76 65 72 6d 6f 64 29 29 uses servermod))
0420: 0a 0a 28 6d 6f 64 75 6c 65 20 61 70 69 6d 6f 64 ..(module apimod
0430: 0a 20 20 28 0a 61 70 69 3a 72 75 6e 2d 73 65 72 . (.api:run-ser
0440: 76 65 72 2d 70 72 6f 63 65 73 73 0a 61 70 69 3a ver-process.api:
0450: 73 74 61 72 74 2d 73 65 72 76 65 72 0a 61 70 69 start-server.api
0460: 3a 64 69 73 70 61 74 63 68 2d 63 6d 64 0a 61 70 :dispatch-cmd.ap
0470: 69 3a 65 78 65 63 75 74 65 2d 72 65 71 75 65 73 i:execute-reques
0480: 74 73 0a 3b 3b 20 61 70 69 3a 70 72 6f 63 65 73 ts.;; api:proces
0490: 73 2d 72 65 71 75 65 73 74 0a 29 0a 09 0a 28 69 s-request.)...(i
04a0: 6d 70 6f 72 74 20 73 63 68 65 6d 65 0a 09 63 68 mport scheme..ch
04b0: 69 63 6b 65 6e 2e 62 61 73 65 0a 09 63 68 69 63 icken.base..chic
04c0: 6b 65 6e 2e 70 72 6f 63 65 73 73 2d 63 6f 6e 74 ken.process-cont
04d0: 65 78 74 2e 70 6f 73 69 78 0a 09 63 68 69 63 6b ext.posix..chick
04e0: 65 6e 2e 73 74 72 69 6e 67 0a 09 63 68 69 63 6b en.string..chick
04f0: 65 6e 2e 74 69 6d 65 0a 09 63 68 69 63 6b 65 6e en.time..chicken
0500: 2e 63 6f 6e 64 69 74 69 6f 6e 0a 09 63 68 69 63 .condition..chic
0510: 6b 65 6e 2e 70 72 6f 63 65 73 73 0a 09 63 68 69 ken.process..chi
0520: 63 6b 65 6e 2e 70 61 74 68 6e 61 6d 65 0a 09 63 cken.pathname..c
0530: 68 69 63 6b 65 6e 2e 72 61 6e 64 6f 6d 0a 09 63 hicken.random..c
0540: 68 69 63 6b 65 6e 2e 66 69 6c 65 0a 09 0a 09 3b hicken.file....;
0550: 3b 20 28 70 72 65 66 69 78 20 73 71 6c 69 74 65 ; (prefix sqlite
0560: 33 20 73 71 6c 69 74 65 33 3a 29 0a 09 74 79 70 3 sqlite3:)..typ
0570: 65 64 2d 72 65 63 6f 72 64 73 0a 09 73 72 66 69 ed-records..srfi
0580: 2d 31 38 0a 09 73 72 66 69 2d 36 39 0a 0a 09 63 -18..srfi-69...c
0590: 6f 6d 6d 6f 6e 6d 6f 64 0a 09 64 62 6d 6f 64 0a ommonmod..dbmod.
05a0: 09 64 65 62 75 67 70 72 69 6e 74 0a 09 74 61 73 .debugprint..tas
05b0: 6b 73 6d 6f 64 0a 09 73 65 72 76 65 72 6d 6f 64 ksmod..servermod
05c0: 0a 09 6d 61 74 63 68 61 62 6c 65 0a 09 0a 09 29 ..matchable....)
05d0: 0a 0a 3b 3b 20 61 6c 6c 6f 77 20 74 68 65 73 65 ..;; allow these
05e0: 20 71 75 65 72 69 65 73 20 74 68 72 6f 75 67 68 queries through
05f0: 20 77 69 74 68 6f 75 74 20 73 74 61 72 74 69 6e without startin
0600: 67 20 61 20 73 65 72 76 65 72 0a 3b 3b 0a 28 64 g a server.;;.(d
0610: 65 66 69 6e 65 20 61 70 69 3a 72 65 61 64 2d 6f efine api:read-o
0620: 6e 6c 79 2d 71 75 65 72 69 65 73 0a 20 20 27 28 nly-queries. '(
0630: 67 65 74 2d 6b 65 79 2d 76 61 6c 2d 70 61 69 72 get-key-val-pair
0640: 73 0a 20 20 20 20 67 65 74 2d 76 61 72 0a 20 20 s. get-var.
0650: 20 20 67 65 74 2d 6b 65 79 73 0a 20 20 20 20 67 get-keys. g
0660: 65 74 2d 6b 65 79 2d 76 61 6c 73 0a 20 20 20 20 et-key-vals.
0670: 74 65 73 74 2d 74 6f 70 6c 65 76 65 6c 2d 6e 75 test-toplevel-nu
0680: 6d 2d 69 74 65 6d 73 0a 20 20 20 20 67 65 74 2d m-items. get-
0690: 74 65 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 0a test-info-by-id.
06a0: 20 20 20 20 67 65 74 2d 73 74 65 70 73 2d 69 6e get-steps-in
06b0: 66 6f 2d 62 79 2d 69 64 0a 20 20 20 20 67 65 74 fo-by-id. get
06c0: 2d 64 61 74 61 2d 69 6e 66 6f 2d 62 79 2d 69 64 -data-info-by-id
06d0: 0a 20 20 20 20 74 65 73 74 2d 67 65 74 2d 72 75 . test-get-ru
06e0: 6e 64 69 72 2d 66 72 6f 6d 2d 74 65 73 74 2d 69 ndir-from-test-i
06f0: 64 0a 20 20 20 20 67 65 74 2d 63 6f 75 6e 74 2d d. get-count-
0700: 74 65 73 74 73 2d 72 75 6e 6e 69 6e 67 2d 66 6f tests-running-fo
0710: 72 2d 74 65 73 74 6e 61 6d 65 0a 20 20 20 20 67 r-testname. g
0720: 65 74 2d 63 6f 75 6e 74 2d 74 65 73 74 73 2d 72 et-count-tests-r
0730: 75 6e 6e 69 6e 67 0a 20 20 20 20 67 65 74 2d 63 unning. get-c
0740: 6f 75 6e 74 2d 74 65 73 74 73 2d 72 75 6e 6e 69 ount-tests-runni
0750: 6e 67 2d 69 6e 2d 6a 6f 62 67 72 6f 75 70 0a 20 ng-in-jobgroup.
0760: 20 20 20 67 65 74 2d 70 72 65 76 69 6f 75 73 2d get-previous-
0770: 74 65 73 74 2d 72 75 6e 2d 72 65 63 6f 72 64 0a test-run-record.
0780: 20 20 20 20 67 65 74 2d 6d 61 74 63 68 69 6e 67 get-matching
0790: 2d 70 72 65 76 69 6f 75 73 2d 74 65 73 74 2d 72 -previous-test-r
07a0: 75 6e 2d 72 65 63 6f 72 64 73 0a 20 20 20 20 74 un-records. t
07b0: 65 73 74 2d 67 65 74 2d 6c 6f 67 66 69 6c 65 2d est-get-logfile-
07c0: 69 6e 66 6f 0a 20 20 20 20 74 65 73 74 2d 67 65 info. test-ge
07d0: 74 2d 72 65 63 6f 72 64 73 2d 66 6f 72 2d 69 6e t-records-for-in
07e0: 64 65 78 2d 66 69 6c 65 0a 20 20 20 20 67 65 74 dex-file. get
07f0: 2d 74 65 73 74 69 6e 66 6f 2d 73 74 61 74 65 2d -testinfo-state-
0800: 73 74 61 74 75 73 0a 20 20 20 20 74 65 73 74 2d status. test-
0810: 67 65 74 2d 74 6f 70 2d 70 72 6f 63 65 73 73 2d get-top-process-
0820: 70 69 64 0a 20 20 20 20 74 65 73 74 2d 67 65 74 pid. test-get
0830: 2d 70 61 74 68 73 2d 6d 61 74 63 68 69 6e 67 2d -paths-matching-
0840: 6b 65 79 6e 61 6d 65 73 2d 74 61 72 67 65 74 2d keynames-target-
0850: 6e 65 77 0a 20 20 20 20 67 65 74 2d 70 72 65 72 new. get-prer
0860: 65 71 73 2d 6e 6f 74 2d 6d 65 74 0a 20 20 20 20 eqs-not-met.
0870: 67 65 74 2d 63 6f 75 6e 74 2d 74 65 73 74 73 2d get-count-tests-
0880: 72 75 6e 6e 69 6e 67 2d 66 6f 72 2d 72 75 6e 2d running-for-run-
0890: 69 64 0a 20 20 20 20 67 65 74 2d 72 75 6e 2d 69 id. get-run-i
08a0: 6e 66 6f 0a 20 20 20 20 67 65 74 2d 72 75 6e 2d nfo. get-run-
08b0: 73 74 61 74 75 73 0a 20 20 20 20 67 65 74 2d 72 status. get-r
08c0: 75 6e 2d 73 74 61 74 65 0a 20 20 20 20 67 65 74 un-state. get
08d0: 2d 72 75 6e 2d 73 74 61 74 73 0a 20 20 20 20 67 -run-stats. g
08e0: 65 74 2d 72 75 6e 2d 74 69 6d 65 73 0a 20 20 20 et-run-times.
08f0: 20 67 65 74 2d 74 61 72 67 65 74 73 0a 20 20 20 get-targets.
0900: 20 67 65 74 2d 74 61 72 67 65 74 0a 20 20 20 20 get-target.
0910: 67 65 74 2d 74 65 73 74 73 2d 74 61 67 73 0a 20 get-tests-tags.
0920: 20 20 20 67 65 74 2d 74 65 73 74 2d 74 69 6d 65 get-test-time
0930: 73 0a 20 20 20 20 67 65 74 2d 74 65 73 74 73 2d s. get-tests-
0940: 66 6f 72 2d 72 75 6e 0a 20 20 20 20 67 65 74 2d for-run. get-
0950: 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 2d 73 74 tests-for-run-st
0960: 61 74 65 2d 73 74 61 74 75 73 0a 20 20 20 20 67 ate-status. g
0970: 65 74 2d 74 65 73 74 2d 69 64 0a 20 20 20 20 67 et-test-id. g
0980: 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e et-tests-for-run
0990: 73 2d 6d 69 6e 64 61 74 61 0a 20 20 20 20 67 65 s-mindata. ge
09a0: 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 2d t-tests-for-run-
09b0: 6d 69 6e 64 61 74 61 0a 20 20 20 20 67 65 74 2d mindata. get-
09c0: 72 75 6e 2d 6e 61 6d 65 2d 66 72 6f 6d 2d 69 64 run-name-from-id
09d0: 0a 20 20 20 20 67 65 74 2d 72 75 6e 73 0a 20 20 . get-runs.
09e0: 20 20 73 69 6d 70 6c 65 2d 67 65 74 2d 72 75 6e simple-get-run
09f0: 73 0a 20 20 20 20 67 65 74 2d 6e 75 6d 2d 72 75 s. get-num-ru
0a00: 6e 73 0a 20 20 20 20 67 65 74 2d 72 75 6e 73 2d ns. get-runs-
0a10: 63 6e 74 2d 62 79 2d 70 61 74 74 0a 20 20 20 20 cnt-by-patt.
0a20: 67 65 74 2d 61 6c 6c 2d 72 75 6e 2d 69 64 73 0a get-all-run-ids.
0a30: 20 20 20 20 67 65 74 2d 70 72 65 76 2d 72 75 6e get-prev-run
0a40: 2d 69 64 73 0a 20 20 20 20 67 65 74 2d 72 75 6e -ids. get-run
0a50: 2d 69 64 73 2d 6d 61 74 63 68 69 6e 67 2d 74 61 -ids-matching-ta
0a60: 72 67 65 74 0a 20 20 20 20 67 65 74 2d 72 75 6e rget. get-run
0a70: 73 2d 62 79 2d 70 61 74 74 0a 20 20 20 20 67 65 s-by-patt. ge
0a80: 74 2d 73 74 65 70 73 2d 64 61 74 61 0a 20 20 20 t-steps-data.
0a90: 20 67 65 74 2d 73 74 65 70 73 2d 66 6f 72 2d 74 get-steps-for-t
0aa0: 65 73 74 0a 20 20 20 20 72 65 61 64 2d 74 65 73 est. read-tes
0ab0: 74 2d 64 61 74 61 0a 20 20 20 20 72 65 61 64 2d t-data. read-
0ac0: 74 65 73 74 2d 64 61 74 61 2d 76 61 72 70 61 74 test-data-varpat
0ad0: 74 0a 20 20 20 20 6c 6f 67 69 6e 0a 20 20 20 20 t. login.
0ae0: 74 61 73 6b 73 2d 67 65 74 2d 6c 61 73 74 0a 20 tasks-get-last.
0af0: 20 20 20 74 65 73 74 6d 65 74 61 2d 67 65 74 2d testmeta-get-
0b00: 72 65 63 6f 72 64 0a 20 20 20 20 68 61 76 65 2d record. have-
0b10: 69 6e 63 6f 6d 70 6c 65 74 65 73 3f 0a 20 20 20 incompletes?.
0b20: 20 3b 3b 20 73 79 6e 63 68 61 73 68 2d 67 65 74 ;; synchash-get
0b30: 0a 20 20 20 20 67 65 74 2d 63 68 61 6e 67 65 64 . get-changed
0b40: 2d 72 65 63 6f 72 64 2d 69 64 73 0a 20 20 20 20 -record-ids.
0b50: 67 65 74 2d 72 75 6e 2d 72 65 63 6f 72 64 2d 69 get-run-record-i
0b60: 64 73 20 0a 20 20 20 20 67 65 74 2d 6e 6f 74 2d ds . get-not-
0b70: 63 6f 6d 70 6c 65 74 65 64 2d 63 6e 74 29 29 0a completed-cnt)).
0b80: 0a 28 64 65 66 69 6e 65 20 61 70 69 3a 77 72 69 .(define api:wri
0b90: 74 65 2d 71 75 65 72 69 65 73 0a 20 20 27 28 0a te-queries. '(.
0ba0: 20 20 20 20 67 65 74 2d 6b 65 79 73 2d 77 72 69 get-keys-wri
0bb0: 74 65 20 3b 3b 20 64 75 6d 6d 79 20 22 77 72 69 te ;; dummy "wri
0bc0: 74 65 22 20 71 75 65 72 79 20 74 6f 20 66 6f 72 te" query to for
0bd0: 63 65 20 73 65 72 76 65 72 20 73 74 61 72 74 0a ce server start.
0be0: 0a 20 20 20 20 3b 3b 20 53 45 52 56 45 52 53 0a . ;; SERVERS.
0bf0: 20 20 20 20 73 74 61 72 74 2d 73 65 72 76 65 72 start-server
0c00: 0a 20 20 20 20 6b 69 6c 6c 2d 73 65 72 76 65 72 . kill-server
0c10: 0a 0a 20 20 20 20 3b 3b 20 54 45 53 54 53 0a 20 .. ;; TESTS.
0c20: 20 20 20 74 65 73 74 2d 73 65 74 2d 73 74 61 74 test-set-stat
0c30: 65 2d 73 74 61 74 75 73 2d 62 79 2d 69 64 0a 20 e-status-by-id.
0c40: 20 20 20 64 65 6c 65 74 65 2d 74 65 73 74 2d 72 delete-test-r
0c50: 65 63 6f 72 64 73 0a 20 20 20 20 64 65 6c 65 74 ecords. delet
0c60: 65 2d 6f 6c 64 2d 64 65 6c 65 74 65 64 2d 74 65 e-old-deleted-te
0c70: 73 74 2d 72 65 63 6f 72 64 73 0a 20 20 20 20 74 st-records. t
0c80: 65 73 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 est-set-state-st
0c90: 61 74 75 73 0a 20 20 20 20 74 65 73 74 2d 73 65 atus. test-se
0ca0: 74 2d 74 6f 70 2d 70 72 6f 63 65 73 73 2d 70 69 t-top-process-pi
0cb0: 64 0a 20 20 20 20 73 65 74 2d 73 74 61 74 65 2d d. set-state-
0cc0: 73 74 61 74 75 73 2d 61 6e 64 2d 72 6f 6c 6c 2d status-and-roll-
0cd0: 75 70 2d 69 74 65 6d 73 0a 20 20 20 20 0a 20 20 up-items. .
0ce0: 20 20 75 70 64 61 74 65 2d 70 61 73 73 2d 66 61 update-pass-fa
0cf0: 69 6c 2d 63 6f 75 6e 74 73 0a 20 20 20 20 74 6f il-counts. to
0d00: 70 2d 74 65 73 74 2d 73 65 74 2d 70 65 72 2d 70 p-test-set-per-p
0d10: 66 2d 63 6f 75 6e 74 73 20 3b 3b 20 28 64 62 3a f-counts ;; (db:
0d20: 74 6f 70 2d 74 65 73 74 2d 73 65 74 2d 70 65 72 top-test-set-per
0d30: 2d 70 66 2d 63 6f 75 6e 74 73 20 28 64 62 3a 67 -pf-counts (db:g
0d40: 65 74 2d 64 62 20 2a 64 62 2a 20 35 29 20 35 20 et-db *db* 5) 5
0d50: 22 72 75 6e 66 69 72 73 74 22 29 0a 0a 20 20 20 "runfirst")..
0d60: 20 3b 3b 20 52 55 4e 53 0a 20 20 20 20 72 65 67 ;; RUNS. reg
0d70: 69 73 74 65 72 2d 72 75 6e 0a 20 20 20 20 73 65 ister-run. se
0d80: 74 2d 74 65 73 74 73 2d 73 74 61 74 65 2d 73 74 t-tests-state-st
0d90: 61 74 75 73 0a 20 20 20 20 64 65 6c 65 74 65 2d atus. delete-
0da0: 72 75 6e 0a 20 20 20 20 6c 6f 63 6b 2f 75 6e 6c run. lock/unl
0db0: 6f 63 6b 2d 72 75 6e 0a 20 20 20 20 75 70 64 61 ock-run. upda
0dc0: 74 65 2d 72 75 6e 2d 65 76 65 6e 74 5f 74 69 6d te-run-event_tim
0dd0: 65 0a 20 20 20 20 6d 61 72 6b 2d 69 6e 63 6f 6d e. mark-incom
0de0: 70 6c 65 74 65 0a 20 20 20 20 73 65 74 2d 73 74 plete. set-st
0df0: 61 74 65 2d 73 74 61 74 75 73 2d 61 6e 64 2d 72 ate-status-and-r
0e00: 6f 6c 6c 2d 75 70 2d 72 75 6e 0a 20 20 20 20 3b oll-up-run. ;
0e10: 3b 20 53 54 45 50 53 0a 20 20 20 20 74 65 73 74 ; STEPS. test
0e20: 73 74 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 step-set-status!
0e30: 0a 20 20 20 20 64 65 6c 65 74 65 2d 73 74 65 70 . delete-step
0e40: 73 2d 66 6f 72 2d 74 65 73 74 0a 20 20 20 20 3b s-for-test. ;
0e50: 3b 20 54 45 53 54 20 44 41 54 41 0a 20 20 20 20 ; TEST DATA.
0e60: 74 65 73 74 2d 64 61 74 61 2d 72 6f 6c 6c 75 70 test-data-rollup
0e70: 0a 20 20 20 20 63 73 76 2d 3e 74 65 73 74 2d 64 . csv->test-d
0e80: 61 74 61 0a 0a 20 20 20 20 3b 3b 20 4d 49 53 43 ata.. ;; MISC
0e90: 0a 20 20 20 20 73 79 6e 63 2d 69 6e 6d 65 6d 2d . sync-inmem-
0ea0: 3e 64 62 0a 20 20 20 20 64 72 6f 70 2d 61 6c 6c >db. drop-all
0eb0: 2d 74 72 69 67 67 65 72 73 0a 20 20 20 20 63 72 -triggers. cr
0ec0: 65 61 74 65 2d 61 6c 6c 2d 74 72 69 67 67 65 72 eate-all-trigger
0ed0: 73 0a 20 20 20 20 75 70 64 61 74 65 2d 74 65 73 s. update-tes
0ee0: 64 61 74 61 2d 6f 6e 2d 72 65 70 69 6c 63 61 74 data-on-repilcat
0ef0: 65 2d 64 62 20 0a 0a 20 20 20 20 3b 3b 20 54 45 e-db .. ;; TE
0f00: 53 54 4d 45 54 41 0a 20 20 20 20 74 65 73 74 6d STMETA. testm
0f10: 65 74 61 2d 61 64 64 2d 72 65 63 6f 72 64 0a 20 eta-add-record.
0f20: 20 20 20 74 65 73 74 6d 65 74 61 2d 75 70 64 61 testmeta-upda
0f30: 74 65 2d 66 69 65 6c 64 0a 0a 20 20 20 20 3b 3b te-field.. ;;
0f40: 20 54 41 53 4b 53 0a 20 20 20 20 74 61 73 6b 73 TASKS. tasks
0f50: 2d 61 64 64 0a 20 20 20 20 74 61 73 6b 73 2d 73 -add. tasks-s
0f60: 65 74 2d 73 74 61 74 65 2d 67 69 76 65 6e 2d 70 et-state-given-p
0f70: 61 72 61 6d 2d 6b 65 79 0a 20 20 20 20 29 29 0a aram-key. )).
0f80: 0a 28 64 65 66 69 6e 65 20 28 61 70 69 3a 72 75 .(define (api:ru
0f90: 6e 2d 73 65 72 76 65 72 2d 70 72 6f 63 65 73 73 n-server-process
0fa0: 20 61 70 61 74 68 20 64 62 6e 61 6d 65 29 0a 20 apath dbname).
0fb0: 20 28 6c 65 74 2a 20 28 28 63 6c 65 61 6e 64 62 (let* ((cleandb
0fc0: 6e 61 6d 65 20 28 70 61 74 68 6e 61 6d 65 2d 73 name (pathname-s
0fd0: 74 72 69 70 2d 64 69 72 65 63 74 6f 72 79 20 64 trip-directory d
0fe0: 62 6e 61 6d 65 29 29 20 3b 3b 20 28 73 74 72 69 bname)) ;; (stri
0ff0: 6e 67 2d 74 72 61 6e 73 6c 61 74 65 20 64 62 6e ng-translate dbn
1000: 61 6d 65 20 22 2e 2f 22 20 22 2d 2d 22 29 29 0a ame "./" "--")).
1010: 09 20 28 6c 6f 67 64 20 20 20 20 20 20 20 20 28 . (logd (
1020: 63 6f 6e 63 20 61 70 61 74 68 20 22 2f 6c 6f 67 conc apath "/log
1030: 73 22 29 29 20 0a 09 20 28 6c 6f 67 66 20 20 20 s")) .. (logf
1040: 20 20 20 20 20 28 63 6f 6e 63 20 6c 6f 67 64 20 (conc logd
1050: 22 2f 73 65 72 76 65 72 2d 6c 61 75 6e 63 68 2d "/server-launch-
1060: 22 3b 3b 28 63 75 72 72 65 6e 74 2d 70 72 6f 63 ";;(current-proc
1070: 65 73 73 2d 69 64 29 0a 09 09 09 20 20 20 20 28 ess-id).... (
1080: 73 65 63 6f 6e 64 73 2d 3e 79 65 61 72 2d 77 6f seconds->year-wo
1090: 72 6b 2d 77 65 65 6b 2f 64 61 79 2d 74 69 6d 65 rk-week/day-time
10a0: 2d 66 6e 61 6d 65 20 28 63 75 72 72 65 6e 74 2d -fname (current-
10b0: 73 65 63 6f 6e 64 73 29 29 0a 09 09 09 20 20 20 seconds))....
10c0: 20 22 2d 22 63 6c 65 61 6e 64 62 6e 61 6d 65 22 "-"cleandbname"
10d0: 2e 6c 6f 67 22 29 29 0a 09 20 28 6c 6f 67 66 32 .log")).. (logf2
10e0: 20 20 20 20 20 20 20 28 63 6f 6e 63 20 6c 6f 67 (conc log
10f0: 64 20 22 2f 73 65 72 76 65 72 2d 22 0a 09 09 09 d "/server-"....
1100: 20 20 20 20 28 73 65 63 6f 6e 64 73 2d 3e 79 65 (seconds->ye
1110: 61 72 2d 77 6f 72 6b 2d 77 65 65 6b 2f 64 61 79 ar-work-week/day
1120: 2d 74 69 6d 65 2d 66 6e 61 6d 65 20 28 63 75 72 -time-fname (cur
1130: 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 0a 09 rent-seconds))..
1140: 09 09 20 20 20 20 22 2d 22 63 6c 65 61 6e 64 62 .. "-"cleandb
1150: 6e 61 6d 65 22 2d 22 29 29 0a 09 20 28 63 6d 64 name"-")).. (cmd
1160: 20 20 28 63 6f 6e 63 20 22 6e 62 66 61 6b 65 20 (conc "nbfake
1170: 6d 74 73 65 72 76 65 72 20 2d 73 65 72 76 65 72 mtserver -server
1180: 20 2d 20 2d 61 72 65 61 20 22 61 70 61 74 68 22 - -area "apath"
1190: 20 2d 64 62 20 22 64 62 6e 61 6d 65 29 0a 09 09 -db "dbname)...
11a0: 20 20 20 20 20 3b 3b 20 22 20 2d 61 75 74 6f 6c ;; " -autol
11b0: 6f 67 20 22 6c 6f 67 66 32 20 3b 3b 20 74 68 65 og "logf2 ;; the
11c0: 20 73 69 64 65 20 6c 6f 67 20 64 69 64 20 6e 6f side log did no
11d0: 74 20 68 65 6c 70 2e 20 45 6e 64 65 64 20 75 70 t help. Ended up
11e0: 20 77 69 74 68 20 74 77 6f 20 6c 6f 67 73 20 61 with two logs a
11f0: 6e 64 20 74 68 65 20 70 69 64 20 69 6e 20 74 68 nd the pid in th
1200: 65 20 6e 61 6d 65 20 77 61 73 20 6e 6f 74 20 74 e name was not t
1210: 68 61 74 20 75 73 65 66 75 6c 2e 0a 09 09 20 20 hat useful....
1220: 20 20 20 29 29 0a 20 20 20 20 28 69 66 20 28 6e )). (if (n
1230: 6f 74 20 28 64 69 72 65 63 74 6f 72 79 2d 65 78 ot (directory-ex
1240: 69 73 74 73 3f 20 6c 6f 67 64 29 29 0a 09 28 63 ists? logd))..(c
1250: 72 65 61 74 65 2d 64 69 72 65 63 74 6f 72 79 20 reate-directory
1260: 6c 6f 67 64 20 23 74 29 29 0a 20 20 20 20 28 73 logd #t)). (s
1270: 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 4e 42 46 ystem (conc "NBF
1280: 41 4b 45 5f 4c 4f 47 3d 22 6c 6f 67 66 22 20 22 AKE_LOG="logf" "
1290: 63 6d 64 29 29 29 29 0a 0a 3b 3b 20 73 70 65 63 cmd))))..;; spec
12a0: 69 61 6c 20 66 75 6e 63 74 69 6f 6e 20 74 6f 20 ial function to
12b0: 67 65 74 20 73 65 72 76 65 72 0a 3b 3b 20 6c 6f get server.;; lo
12c0: 6f 6b 20 75 70 20 69 6e 20 64 62 0a 3b 3b 20 69 ok up in db.;; i
12d0: 66 20 66 6f 75 6e 64 20 2d 3e 20 72 65 74 75 72 f found -> retur
12e0: 6e 20 69 74 0a 3b 3b 20 69 66 20 6e 6f 74 20 66 n it.;; if not f
12f0: 6f 75 6e 64 20 2d 3e 20 73 74 61 72 74 20 73 65 ound -> start se
1300: 72 76 65 72 2c 20 72 65 74 75 72 6e 20 73 74 61 rver, return sta
1310: 72 74 69 6e 67 0a 3b 3b 0a 28 64 65 66 69 6e 65 rting.;;.(define
1320: 20 28 61 70 69 3a 73 74 61 72 74 2d 73 65 72 76 (api:start-serv
1330: 65 72 20 64 62 73 74 72 75 63 74 20 70 61 72 61 er dbstruct para
1340: 6d 73 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 65 ms). (let* ((re
1350: 73 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d s (apply db:get-
1360: 73 65 72 76 65 72 2d 69 6e 66 6f 20 64 62 73 74 server-info dbst
1370: 72 75 63 74 20 70 61 72 61 6d 73 29 29 29 0a 20 ruct params))).
1380: 20 20 20 28 69 66 20 72 65 73 0a 09 72 65 73 0a (if res..res.
1390: 09 28 6d 61 74 63 68 20 70 61 72 61 6d 73 0a 09 .(match params..
13a0: 20 20 28 28 61 70 61 74 68 20 64 62 6e 61 6d 65 ((apath dbname
13b0: 29 0a 09 20 20 20 28 61 70 69 3a 72 75 6e 2d 73 ).. (api:run-s
13c0: 65 72 76 65 72 2d 70 72 6f 63 65 73 73 20 61 70 erver-process ap
13d0: 61 74 68 20 64 62 6e 61 6d 65 29 0a 09 20 20 20 ath dbname)..
13e0: 27 73 65 72 76 65 72 2d 73 74 61 72 74 65 64 29 'server-started)
13f0: 0a 09 20 20 28 65 6c 73 65 0a 09 20 20 20 28 64 .. (else.. (d
1400: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
1410: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
1420: 6f 72 74 2a 20 22 61 70 69 3a 73 74 61 72 74 2d ort* "api:start-
1430: 73 65 72 76 65 72 20 63 61 6c 6c 65 64 20 77 69 server called wi
1440: 74 68 20 77 72 6f 6e 67 20 70 61 72 61 6d 73 3a th wrong params:
1450: 20 22 70 61 72 61 6d 73 29 0a 09 20 20 20 27 62 "params).. 'b
1460: 61 64 2d 70 61 72 61 6d 73 29 29 29 29 29 0a 09 ad-params)))))..
1470: 0a 28 64 65 66 69 6e 65 20 28 61 70 69 3a 64 69 .(define (api:di
1480: 73 70 61 74 63 68 2d 63 6d 64 20 64 62 73 74 72 spatch-cmd dbstr
1490: 75 63 74 20 63 6d 64 20 70 61 72 61 6d 73 29 0a uct cmd params).
14a0: 20 20 28 63 61 73 65 20 63 6d 64 0a 20 20 20 20 (case cmd.
14b0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
14c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14e0: 3d 0a 20 20 20 20 3b 3b 20 52 45 41 44 2f 57 52 =. ;; READ/WR
14f0: 49 54 45 20 51 55 45 52 49 45 53 0a 20 20 20 20 ITE QUERIES.
1500: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
1510: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1520: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1530: 3d 0a 0a 20 20 20 20 28 28 67 65 74 2d 6b 65 79 =.. ((get-key
1540: 73 2d 77 72 69 74 65 29 20 20 20 20 20 20 20 20 s-write)
1550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1560: 28 64 62 3a 67 65 74 2d 6b 65 79 73 20 64 62 73 (db:get-keys dbs
1570: 74 72 75 63 74 29 29 20 3b 3b 20 66 6f 72 63 65 truct)) ;; force
1580: 20 61 20 64 75 6d 6d 79 20 22 77 72 69 74 65 22 a dummy "write"
1590: 20 71 75 65 72 79 20 74 6f 20 66 6f 72 63 65 20 query to force
15a0: 73 65 72 76 65 72 3b 20 66 6f 72 20 64 65 62 75 server; for debu
15b0: 67 20 69 6e 20 2d 72 65 70 6c 0a 20 20 20 20 0a g in -repl. .
15c0: 20 20 20 20 3b 3b 20 53 45 52 56 45 52 53 0a 20 ;; SERVERS.
15d0: 20 20 20 3b 3b 20 28 28 73 74 61 72 74 2d 73 65 ;; ((start-se
15e0: 72 76 65 72 29 20 20 20 20 20 20 20 20 20 20 20 rver)
15f0: 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 (apply
1600: 73 65 72 76 65 72 3a 6b 69 6e 64 2d 72 75 6e 20 server:kind-run
1610: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 28 28 6b params)). ((k
1620: 69 6c 6c 2d 73 65 72 76 65 72 29 20 20 20 20 20 ill-server)
1630: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1640: 20 20 28 73 65 74 21 20 2a 73 65 72 76 65 72 2d (set! *server-
1650: 72 75 6e 2a 20 23 66 29 29 0a 20 20 20 20 28 28 run* #f)). ((
1660: 73 74 61 72 74 2d 73 65 72 76 65 72 20 67 65 74 start-server get
1670: 2d 73 65 72 76 65 72 29 20 20 20 20 20 20 20 20 -server)
1680: 20 20 20 28 61 70 69 3a 73 74 61 72 74 2d 73 65 (api:start-se
1690: 72 76 65 72 20 64 62 73 74 72 75 63 74 20 70 61 rver dbstruct pa
16a0: 72 61 6d 73 29 29 0a 20 20 20 20 28 28 67 65 74 rams)). ((get
16b0: 2d 73 65 72 76 65 72 2d 69 6e 66 6f 29 20 20 20 -server-info)
16c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16d0: 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 73 65 (apply db:get-se
16e0: 72 76 65 72 2d 69 6e 66 6f 20 64 62 73 74 72 75 rver-info dbstru
16f0: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 ct params)).
1700: 28 28 72 65 67 69 73 74 65 72 2d 73 65 72 76 65 ((register-serve
1710: 72 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 r)
1720: 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 72 (apply db:r
1730: 65 67 69 73 74 65 72 2d 73 65 72 76 65 72 20 64 egister-server d
1740: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 20 bstruct params)
1750: 29 3b 3b 20 64 62 73 74 72 75 63 74 20 68 6f 73 );; dbstruct hos
1760: 74 20 70 6f 72 74 20 73 65 72 76 6b 65 79 20 70 t port servkey p
1770: 69 64 20 69 70 61 64 64 72 20 64 62 70 61 74 68 id ipaddr dbpath
1780: 29 0a 20 20 20 20 28 28 64 65 72 65 67 69 73 74 ). ((deregist
1790: 65 72 2d 73 65 72 76 65 72 29 20 20 20 20 20 20 er-server)
17a0: 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c (appl
17b0: 79 20 64 62 3a 64 65 72 65 67 69 73 74 65 72 2d y db:deregister-
17c0: 73 65 72 76 65 72 20 64 62 73 74 72 75 63 74 20 server dbstruct
17d0: 70 61 72 61 6d 73 29 20 29 3b 3b 20 64 62 73 74 params) );; dbst
17e0: 72 75 63 74 20 68 6f 73 74 20 70 6f 72 74 20 73 ruct host port s
17f0: 65 72 76 6b 65 79 20 70 69 64 20 69 70 61 64 64 ervkey pid ipadd
1800: 72 20 64 62 70 61 74 68 29 0a 20 20 20 20 28 28 r dbpath). ((
1810: 67 65 74 2d 63 6f 75 6e 74 2d 73 65 72 76 65 72 get-count-server
1820: 73 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 s)
1830: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 (apply db:get
1840: 2d 63 6f 75 6e 74 2d 73 65 72 76 65 72 73 20 64 -count-servers d
1850: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
1860: 0a 20 20 20 20 28 28 67 65 74 2d 73 65 72 76 65 . ((get-serve
1870: 72 73 2d 69 6e 66 6f 29 20 20 20 20 20 20 20 20 rs-info)
1880: 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 (apply
1890: 20 64 62 3a 67 65 74 2d 73 65 72 76 65 72 73 2d db:get-servers-
18a0: 69 6e 66 6f 20 64 62 73 74 72 75 63 74 20 70 61 info dbstruct pa
18b0: 72 61 6d 73 29 29 0a 20 20 20 20 3b 3b 20 54 45 rams)). ;; TE
18c0: 53 54 53 0a 0a 20 20 20 20 3b 3b 28 28 74 65 73 STS.. ;;((tes
18d0: 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 t-set-state-stat
18e0: 75 73 2d 62 79 2d 69 64 29 20 20 20 20 20 28 61 us-by-id) (a
18f0: 70 70 6c 79 20 6d 74 3a 74 65 73 74 2d 73 65 74 pply mt:test-set
1900: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d 62 79 -state-status-by
1910: 2d 69 64 20 64 62 73 74 72 75 63 74 20 70 61 72 -id dbstruct par
1920: 61 6d 73 29 29 0a 20 20 20 20 3b 3b 42 42 20 2d ams)). ;;BB -
1930: 20 63 6f 6d 6d 65 6e 74 65 64 20 6f 75 74 20 61 commented out a
1940: 62 6f 76 65 20 62 65 63 61 75 73 65 20 69 74 20 bove because it
1950: 77 61 73 20 63 61 6c 6c 69 6e 67 20 62 65 6c 6f was calling belo
1960: 77 2c 20 65 76 65 6e 74 75 61 6c 6c 79 2c 20 69 w, eventually, i
1970: 6e 63 6f 72 72 65 63 74 6c 79 20 28 64 62 73 74 ncorrectly (dbst
1980: 72 75 63 74 20 70 61 73 73 65 64 20 74 6f 20 6d ruct passed to m
1990: 74 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 65 t:test-set-state
19a0: 2d 73 74 61 74 75 73 2d 62 79 2d 69 64 2c 20 77 -status-by-id, w
19b0: 68 69 63 68 20 70 72 65 76 69 6f 73 6c 79 20 64 hich previosly d
19c0: 69 64 20 6d 6f 72 65 2c 20 62 75 74 20 6e 6f 77 id more, but now
19d0: 20 6f 6e 6c 79 20 70 61 73 73 65 73 20 74 68 72 only passes thr
19e0: 75 20 74 6f 20 64 62 3a 73 65 74 2d 73 74 61 74 u to db:set-stat
19f0: 65 2d 73 74 61 74 75 73 2d 61 6e 64 2d 72 6f 6c e-status-and-rol
1a00: 6c 2d 75 70 2d 69 74 65 6d 73 2e 0a 20 20 20 20 l-up-items..
1a10: 28 28 74 65 73 74 2d 73 65 74 2d 73 74 61 74 65 ((test-set-state
1a20: 2d 73 74 61 74 75 73 2d 62 79 2d 69 64 29 0a 0a -status-by-id)..
1a30: 20 20 20 20 20 3b 3b 20 28 64 65 66 69 6e 65 20 ;; (define
1a40: 28 64 62 3a 73 65 74 2d 73 74 61 74 65 2d 73 74 (db:set-state-st
1a50: 61 74 75 73 2d 61 6e 64 2d 72 6f 6c 6c 2d 75 70 atus-and-roll-up
1a60: 2d 69 74 65 6d 73 20 64 62 73 74 72 75 63 74 20 -items dbstruct
1a70: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
1a80: 20 69 74 65 6d 2d 70 61 74 68 20 73 74 61 74 65 item-path state
1a90: 20 73 74 61 74 75 73 20 63 6f 6d 6d 65 6e 74 29 status comment)
1aa0: 0a 20 20 20 20 20 28 64 62 3a 73 65 74 2d 73 74 . (db:set-st
1ab0: 61 74 65 2d 73 74 61 74 75 73 2d 61 6e 64 2d 72 ate-status-and-r
1ac0: 6f 6c 6c 2d 75 70 2d 69 74 65 6d 73 0a 20 20 20 oll-up-items.
1ad0: 20 20 20 64 62 73 74 72 75 63 74 0a 20 20 20 20 dbstruct.
1ae0: 20 20 28 6c 69 73 74 2d 72 65 66 20 70 61 72 61 (list-ref para
1af0: 6d 73 20 30 29 20 3b 20 72 75 6e 2d 69 64 0a 20 ms 0) ; run-id.
1b00: 20 20 20 20 20 28 6c 69 73 74 2d 72 65 66 20 70 (list-ref p
1b10: 61 72 61 6d 73 20 31 29 20 3b 20 74 65 73 74 2d arams 1) ; test-
1b20: 6e 61 6d 65 0a 20 20 20 20 20 20 23 66 20 20 20 name. #f
1b30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
1b40: 20 69 74 65 6d 2d 70 61 74 68 0a 20 20 20 20 20 item-path.
1b50: 20 28 6c 69 73 74 2d 72 65 66 20 70 61 72 61 6d (list-ref param
1b60: 73 20 32 29 20 3b 20 73 74 61 74 65 0a 20 20 20 s 2) ; state.
1b70: 20 20 20 28 6c 69 73 74 2d 72 65 66 20 70 61 72 (list-ref par
1b80: 61 6d 73 20 33 29 20 3b 20 73 74 61 74 75 73 0a ams 3) ; status.
1b90: 20 20 20 20 20 20 28 6c 69 73 74 2d 72 65 66 20 (list-ref
1ba0: 70 61 72 61 6d 73 20 34 29 20 3b 20 63 6f 6d 6d params 4) ; comm
1bb0: 65 6e 74 0a 20 20 20 20 20 20 29 29 0a 20 20 20 ent. )).
1bc0: 20 0a 20 20 20 20 28 28 64 65 6c 65 74 65 2d 74 . ((delete-t
1bd0: 65 73 74 2d 72 65 63 6f 72 64 73 29 20 20 20 20 est-records)
1be0: 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 (apply
1bf0: 64 62 3a 64 65 6c 65 74 65 2d 74 65 73 74 2d 72 db:delete-test-r
1c00: 65 63 6f 72 64 73 20 64 62 73 74 72 75 63 74 20 ecords dbstruct
1c10: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 28 28 64 params)). ((d
1c20: 65 6c 65 74 65 2d 6f 6c 64 2d 64 65 6c 65 74 65 elete-old-delete
1c30: 64 2d 74 65 73 74 2d 72 65 63 6f 72 64 73 29 20 d-test-records)
1c40: 28 61 70 70 6c 79 20 64 62 3a 64 65 6c 65 74 65 (apply db:delete
1c50: 2d 6f 6c 64 2d 64 65 6c 65 74 65 64 2d 74 65 73 -old-deleted-tes
1c60: 74 2d 72 65 63 6f 72 64 73 20 64 62 73 74 72 75 t-records dbstru
1c70: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 ct params)).
1c80: 28 28 74 65 73 74 2d 73 65 74 2d 73 74 61 74 65 ((test-set-state
1c90: 2d 73 74 61 74 75 73 29 20 20 20 20 20 20 20 20 -status)
1ca0: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 74 65 73 (apply db:tes
1cb0: 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 t-set-state-stat
1cc0: 75 73 20 64 62 73 74 72 75 63 74 20 70 61 72 61 us dbstruct para
1cd0: 6d 73 29 29 0a 20 20 20 20 28 28 74 65 73 74 2d ms)). ((test-
1ce0: 73 65 74 2d 74 6f 70 2d 70 72 6f 63 65 73 73 2d set-top-process-
1cf0: 70 69 64 29 20 20 20 20 20 20 20 20 28 61 70 70 pid) (app
1d00: 6c 79 20 64 62 3a 74 65 73 74 2d 73 65 74 2d 74 ly db:test-set-t
1d10: 6f 70 2d 70 72 6f 63 65 73 73 2d 70 69 64 20 64 op-process-pid d
1d20: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
1d30: 0a 20 20 20 20 28 28 73 65 74 2d 73 74 61 74 65 . ((set-state
1d40: 2d 73 74 61 74 75 73 2d 61 6e 64 2d 72 6f 6c 6c -status-and-roll
1d50: 2d 75 70 2d 69 74 65 6d 73 29 20 28 61 70 70 6c -up-items) (appl
1d60: 79 20 64 62 3a 73 65 74 2d 73 74 61 74 65 2d 73 y db:set-state-s
1d70: 74 61 74 75 73 2d 61 6e 64 2d 72 6f 6c 6c 2d 75 tatus-and-roll-u
1d80: 70 2d 69 74 65 6d 73 20 64 62 73 74 72 75 63 74 p-items dbstruct
1d90: 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 28 28 params)). ((
1da0: 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 set-state-status
1db0: 2d 61 6e 64 2d 72 6f 6c 6c 2d 75 70 2d 72 75 6e -and-roll-up-run
1dc0: 29 20 28 61 70 70 6c 79 20 64 62 3a 73 65 74 2d ) (apply db:set-
1dd0: 73 74 61 74 65 2d 73 74 61 74 75 73 2d 61 6e 64 state-status-and
1de0: 2d 72 6f 6c 6c 2d 75 70 2d 72 75 6e 20 64 62 73 -roll-up-run dbs
1df0: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 20 0a truct params)) .
1e00: 20 20 20 20 28 28 74 6f 70 2d 74 65 73 74 2d 73 ((top-test-s
1e10: 65 74 2d 70 65 72 2d 70 66 2d 63 6f 75 6e 74 73 et-per-pf-counts
1e20: 29 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 ) (apply db
1e30: 3a 74 6f 70 2d 74 65 73 74 2d 73 65 74 2d 70 65 :top-test-set-pe
1e40: 72 2d 70 66 2d 63 6f 75 6e 74 73 20 64 62 73 74 r-pf-counts dbst
1e50: 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 ruct params)).
1e60: 20 20 28 28 74 65 73 74 2d 73 65 74 2d 61 72 63 ((test-set-arc
1e70: 68 69 76 65 2d 62 6c 6f 63 6b 2d 69 64 29 20 20 hive-block-id)
1e80: 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 74 (apply db:t
1e90: 65 73 74 2d 73 65 74 2d 61 72 63 68 69 76 65 2d est-set-archive-
1ea0: 62 6c 6f 63 6b 2d 69 64 20 64 62 73 74 72 75 63 block-id dbstruc
1eb0: 74 20 70 61 72 61 6d 73 29 29 0a 0a 20 20 20 20 t params))..
1ec0: 3b 3b 20 52 55 4e 53 0a 20 20 20 20 28 28 72 65 ;; RUNS. ((re
1ed0: 67 69 73 74 65 72 2d 72 75 6e 29 20 20 20 20 20 gister-run)
1ee0: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 (app
1ef0: 6c 79 20 64 62 3a 72 65 67 69 73 74 65 72 2d 72 ly db:register-r
1f00: 75 6e 20 64 62 73 74 72 75 63 74 20 70 61 72 61 un dbstruct para
1f10: 6d 73 29 29 0a 20 20 20 20 28 28 69 6e 73 65 72 ms)). ((inser
1f20: 74 2d 72 75 6e 29 20 20 20 20 20 20 20 20 20 20 t-run)
1f30: 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 (apply
1f40: 64 62 3a 69 6e 73 65 72 74 2d 72 75 6e 20 64 62 db:insert-run db
1f50: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a struct params)).
1f60: 20 20 20 20 28 28 73 65 74 2d 74 65 73 74 73 2d ((set-tests-
1f70: 73 74 61 74 65 2d 73 74 61 74 75 73 29 20 20 20 state-status)
1f80: 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 73 65 (apply db:se
1f90: 74 2d 74 65 73 74 73 2d 73 74 61 74 65 2d 73 74 t-tests-state-st
1fa0: 61 74 75 73 20 64 62 73 74 72 75 63 74 20 70 61 atus dbstruct pa
1fb0: 72 61 6d 73 29 29 0a 20 20 20 20 28 28 64 65 6c rams)). ((del
1fc0: 65 74 65 2d 72 75 6e 29 20 20 20 20 20 20 20 20 ete-run)
1fd0: 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c (appl
1fe0: 79 20 64 62 3a 64 65 6c 65 74 65 2d 72 75 6e 20 y db:delete-run
1ff0: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 dbstruct params)
2000: 29 0a 20 20 20 20 28 28 6c 6f 63 6b 2f 75 6e 6c ). ((lock/unl
2010: 6f 63 6b 2d 72 75 6e 29 20 20 20 20 20 20 20 20 ock-run)
2020: 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a (apply db:
2030: 6c 6f 63 6b 2f 75 6e 6c 6f 63 6b 2d 72 75 6e 20 lock/unlock-run
2040: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 dbstruct params)
2050: 29 0a 20 20 20 20 28 28 75 70 64 61 74 65 2d 72 ). ((update-r
2060: 75 6e 2d 65 76 65 6e 74 5f 74 69 6d 65 29 20 20 un-event_time)
2070: 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a (apply db:
2080: 75 70 64 61 74 65 2d 72 75 6e 2d 65 76 65 6e 74 update-run-event
2090: 5f 74 69 6d 65 20 64 62 73 74 72 75 63 74 20 70 _time dbstruct p
20a0: 61 72 61 6d 73 29 29 0a 20 20 20 20 28 28 75 70 arams)). ((up
20b0: 64 61 74 65 2d 72 75 6e 2d 73 74 61 74 73 29 20 date-run-stats)
20c0: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 (app
20d0: 6c 79 20 64 62 3a 75 70 64 61 74 65 2d 72 75 6e ly db:update-run
20e0: 2d 73 74 61 74 73 20 64 62 73 74 72 75 63 74 20 -stats dbstruct
20f0: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 28 28 73 params)). ((s
2100: 65 74 2d 76 61 72 29 20 20 20 20 20 20 20 20 20 et-var)
2110: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 (ap
2120: 70 6c 79 20 64 62 3a 73 65 74 2d 76 61 72 20 64 ply db:set-var d
2130: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
2140: 0a 20 20 20 20 28 28 69 6e 63 2d 76 61 72 29 20 . ((inc-var)
2150: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2160: 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 69 (apply db:i
2170: 6e 63 2d 76 61 72 20 64 62 73 74 72 75 63 74 20 nc-var dbstruct
2180: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 28 28 64 params)). ((d
2190: 65 63 2d 76 61 72 29 20 20 20 20 20 20 20 20 20 ec-var)
21a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 (ap
21b0: 70 6c 79 20 64 62 3a 64 65 63 2d 76 61 72 20 64 ply db:dec-var d
21c0: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
21d0: 0a 20 20 20 20 28 28 64 65 6c 2d 76 61 72 29 20 . ((del-var)
21e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21f0: 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 64 (apply db:d
2200: 65 6c 2d 76 61 72 20 64 62 73 74 72 75 63 74 20 el-var dbstruct
2210: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 28 28 61 params)). ((a
2220: 64 64 2d 76 61 72 29 20 20 20 20 20 20 20 20 20 dd-var)
2230: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 (ap
2240: 70 6c 79 20 64 62 3a 61 64 64 2d 76 61 72 20 64 ply db:add-var d
2250: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
2260: 0a 0a 20 20 20 20 3b 3b 20 53 54 45 50 53 0a 20 .. ;; STEPS.
2270: 20 20 20 28 28 74 65 73 74 73 74 65 70 2d 73 65 ((teststep-se
2280: 74 2d 73 74 61 74 75 73 21 29 20 20 20 20 20 20 t-status!)
2290: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 74 65 73 (apply db:tes
22a0: 74 73 74 65 70 2d 73 65 74 2d 73 74 61 74 75 73 tstep-set-status
22b0: 21 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d ! dbstruct param
22c0: 73 29 29 0a 20 20 20 20 28 28 64 65 6c 65 74 65 s)). ((delete
22d0: 2d 73 74 65 70 73 2d 66 6f 72 2d 74 65 73 74 21 -steps-for-test!
22e0: 29 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 ) (apply
22f0: 64 62 3a 64 65 6c 65 74 65 2d 73 74 65 70 73 2d db:delete-steps-
2300: 66 6f 72 2d 74 65 73 74 21 20 64 62 73 74 72 75 for-test! dbstru
2310: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 ct params)).
2320: 0a 20 20 20 20 3b 3b 20 54 45 53 54 20 44 41 54 . ;; TEST DAT
2330: 41 0a 20 20 20 20 28 28 74 65 73 74 2d 64 61 74 A. ((test-dat
2340: 61 2d 72 6f 6c 6c 75 70 29 20 20 20 20 20 20 20 a-rollup)
2350: 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a (apply db:
2360: 74 65 73 74 2d 64 61 74 61 2d 72 6f 6c 6c 75 70 test-data-rollup
2370: 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 dbstruct params
2380: 29 29 0a 20 20 20 20 28 28 63 73 76 2d 3e 74 65 )). ((csv->te
2390: 73 74 2d 64 61 74 61 29 20 20 20 20 20 20 20 20 st-data)
23a0: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 (apply db
23b0: 3a 63 73 76 2d 3e 74 65 73 74 2d 64 61 74 61 20 :csv->test-data
23c0: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 dbstruct params)
23d0: 29 0a 0a 20 20 20 20 3b 3b 20 4d 49 53 43 0a 20 ).. ;; MISC.
23e0: 20 20 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20 ;;
23f0: 20 20 20 20 20 20 20 20 20 28 28 73 79 6e 63 2d ((sync-
2400: 69 6e 6d 65 6d 2d 3e 64 62 29 20 20 20 20 20 20 inmem->db)
2410: 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 (let ((
2420: 72 75 6e 2d 69 64 20 28 63 61 72 20 70 61 72 61 run-id (car para
2430: 6d 73 29 29 29 0a 20 20 20 20 3b 3b 20 20 20 20 ms))). ;;
2440: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2450: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2470: 20 20 28 64 62 3a 73 79 6e 63 2d 74 6f 75 63 68 (db:sync-touch
2480: 65 64 20 64 62 73 74 72 75 63 74 20 72 75 6e 2d ed dbstruct run-
2490: 69 64 20 66 6f 72 63 65 2d 73 79 6e 63 3a 20 23 id force-sync: #
24a0: 74 29 29 29 0a 20 20 20 20 28 28 6d 61 72 6b 2d t))). ((mark-
24b0: 69 6e 63 6f 6d 70 6c 65 74 65 29 20 20 20 20 20 incomplete)
24c0: 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 (apply
24d0: 64 62 3a 66 69 6e 64 2d 61 6e 64 2d 6d 61 72 6b db:find-and-mark
24e0: 2d 69 6e 63 6f 6d 70 6c 65 74 65 20 64 62 73 74 -incomplete dbst
24f0: 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 ruct params)).
2500: 20 20 28 28 63 72 65 61 74 65 2d 61 6c 6c 2d 74 ((create-all-t
2510: 72 69 67 67 65 72 73 29 20 20 20 20 20 20 20 20 riggers)
2520: 20 20 28 64 62 3a 63 72 65 61 74 65 2d 61 6c 6c (db:create-all
2530: 2d 74 72 69 67 67 65 72 73 20 64 62 73 74 72 75 -triggers dbstru
2540: 63 74 29 29 0a 20 20 20 20 28 28 64 72 6f 70 2d ct)). ((drop-
2550: 61 6c 6c 2d 74 72 69 67 67 65 72 73 29 20 20 20 all-triggers)
2560: 20 20 20 20 20 20 20 20 20 28 64 62 3a 64 72 6f (db:dro
2570: 70 2d 61 6c 6c 2d 74 72 69 67 67 65 72 73 20 64 p-all-triggers d
2580: 62 73 74 72 75 63 74 29 29 20 0a 0a 20 20 20 20 bstruct)) ..
2590: 3b 3b 20 54 45 53 54 4d 45 54 41 0a 20 20 20 20 ;; TESTMETA.
25a0: 28 28 74 65 73 74 6d 65 74 61 2d 61 64 64 2d 72 ((testmeta-add-r
25b0: 65 63 6f 72 64 29 20 20 20 20 20 20 20 28 61 70 ecord) (ap
25c0: 70 6c 79 20 64 62 3a 74 65 73 74 6d 65 74 61 2d ply db:testmeta-
25d0: 61 64 64 2d 72 65 63 6f 72 64 20 64 62 73 74 72 add-record dbstr
25e0: 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 uct params)).
25f0: 20 28 28 74 65 73 74 6d 65 74 61 2d 75 70 64 61 ((testmeta-upda
2600: 74 65 2d 66 69 65 6c 64 29 20 20 20 20 20 28 61 te-field) (a
2610: 70 70 6c 79 20 64 62 3a 74 65 73 74 6d 65 74 61 pply db:testmeta
2620: 2d 75 70 64 61 74 65 2d 66 69 65 6c 64 20 64 62 -update-field db
2630: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a struct params)).
2640: 20 20 20 20 28 28 67 65 74 2d 74 65 73 74 73 2d ((get-tests-
2650: 74 61 67 73 29 20 20 20 20 20 20 20 20 20 20 20 tags)
2660: 20 28 64 62 3a 67 65 74 2d 74 65 73 74 73 2d 74 (db:get-tests-t
2670: 61 67 73 20 64 62 73 74 72 75 63 74 29 29 0a 0a ags dbstruct))..
2680: 20 20 20 20 3b 3b 20 54 41 53 4b 53 0a 20 20 20 ;; TASKS.
2690: 20 28 28 74 61 73 6b 73 2d 61 64 64 29 20 20 20 ((tasks-add)
26a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 (a
26b0: 70 70 6c 79 20 74 61 73 6b 73 3a 61 64 64 20 64 pply tasks:add d
26c0: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
26d0: 20 20 20 0a 20 20 20 20 28 28 74 61 73 6b 73 2d . ((tasks-
26e0: 73 65 74 2d 73 74 61 74 65 2d 67 69 76 65 6e 2d set-state-given-
26f0: 70 61 72 61 6d 2d 6b 65 79 29 20 28 61 70 70 6c param-key) (appl
2700: 79 20 74 61 73 6b 73 3a 73 65 74 2d 73 74 61 74 y tasks:set-stat
2710: 65 2d 67 69 76 65 6e 2d 70 61 72 61 6d 2d 6b 65 e-given-param-ke
2720: 79 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d y dbstruct param
2730: 73 29 29 0a 20 20 20 20 28 28 74 61 73 6b 73 2d s)). ((tasks-
2740: 67 65 74 2d 6c 61 73 74 29 20 20 20 20 20 20 20 get-last)
2750: 20 20 20 20 20 28 61 70 70 6c 79 20 74 61 73 6b (apply task
2760: 73 3a 67 65 74 2d 6c 61 73 74 20 64 62 73 74 72 s:get-last dbstr
2770: 75 63 74 20 70 61 72 61 6d 73 29 29 0a 0a 20 20 uct params))..
2780: 20 20 3b 3b 20 4e 4f 20 53 59 4e 43 20 44 42 0a ;; NO SYNC DB.
2790: 20 20 20 20 28 28 6e 6f 2d 73 79 6e 63 2d 73 65 ((no-sync-se
27a0: 74 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 t)
27b0: 20 28 61 70 70 6c 79 20 64 62 3a 6e 6f 2d 73 79 (apply db:no-sy
27c0: 6e 63 2d 73 65 74 20 20 20 20 20 20 20 20 20 2a nc-set *
27d0: 6e 6f 2d 73 79 6e 63 2d 64 62 2a 20 70 61 72 61 no-sync-db* para
27e0: 6d 73 29 29 0a 20 20 20 20 28 28 6e 6f 2d 73 79 ms)). ((no-sy
27f0: 6e 63 2d 67 65 74 2f 64 65 66 61 75 6c 74 29 20 nc-get/default)
2800: 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a (apply db:
2810: 6e 6f 2d 73 79 6e 63 2d 67 65 74 2f 64 65 66 61 no-sync-get/defa
2820: 75 6c 74 20 2a 6e 6f 2d 73 79 6e 63 2d 64 62 2a ult *no-sync-db*
2830: 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 28 28 params)). ((
2840: 6e 6f 2d 73 79 6e 63 2d 64 65 6c 21 29 20 20 20 no-sync-del!)
2850: 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c (appl
2860: 79 20 64 62 3a 6e 6f 2d 73 79 6e 63 2d 64 65 6c y db:no-sync-del
2870: 21 20 20 20 20 20 20 20 20 2a 6e 6f 2d 73 79 6e ! *no-syn
2880: 63 2d 64 62 2a 20 70 61 72 61 6d 73 29 29 0a 20 c-db* params)).
2890: 20 20 20 28 28 6e 6f 2d 73 79 6e 63 2d 67 65 74 ((no-sync-get
28a0: 2d 6c 6f 63 6b 29 20 20 20 20 20 20 20 20 20 20 -lock)
28b0: 28 61 70 70 6c 79 20 64 62 3a 6e 6f 2d 73 79 6e (apply db:no-syn
28c0: 63 2d 67 65 74 2d 6c 6f 63 6b 20 20 20 20 2a 6e c-get-lock *n
28d0: 6f 2d 73 79 6e 63 2d 64 62 2a 20 70 61 72 61 6d o-sync-db* param
28e0: 73 29 29 0a 20 20 20 20 0a 20 20 20 20 3b 3b 20 s)). . ;;
28f0: 41 52 43 48 49 56 45 53 0a 20 20 20 20 3b 3b 20 ARCHIVES. ;;
2900: 28 28 61 72 63 68 69 76 65 2d 67 65 74 2d 61 6c ((archive-get-al
2910: 6c 6f 63 61 74 69 6f 6e 73 29 20 20 20 0a 20 20 locations) .
2920: 20 20 28 28 61 72 63 68 69 76 65 2d 72 65 67 69 ((archive-regi
2930: 73 74 65 72 2d 64 69 73 6b 29 20 20 20 20 20 28 ster-disk) (
2940: 61 70 70 6c 79 20 64 62 3a 61 72 63 68 69 76 65 apply db:archive
2950: 2d 72 65 67 69 73 74 65 72 2d 64 69 73 6b 20 64 -register-disk d
2960: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
2970: 0a 20 20 20 20 28 28 61 72 63 68 69 76 65 2d 72 . ((archive-r
2980: 65 67 69 73 74 65 72 2d 62 6c 6f 63 6b 2d 6e 61 egister-block-na
2990: 6d 65 29 28 61 70 70 6c 79 20 64 62 3a 61 72 63 me)(apply db:arc
29a0: 68 69 76 65 2d 72 65 67 69 73 74 65 72 2d 62 6c hive-register-bl
29b0: 6f 63 6b 2d 6e 61 6d 65 20 64 62 73 74 72 75 63 ock-name dbstruc
29c0: 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 3b t params)). ;
29d0: 3b 20 28 28 61 72 63 68 69 76 65 2d 61 6c 6c 6f ; ((archive-allo
29e0: 63 61 74 65 2d 74 65 73 74 73 75 69 74 65 2f 61 cate-testsuite/a
29f0: 72 65 61 2d 74 6f 2d 62 6c 6f 63 6b 29 28 61 70 rea-to-block)(ap
2a00: 70 6c 79 20 64 62 3a 61 72 63 68 69 76 65 2d 61 ply db:archive-a
2a10: 6c 6c 6f 63 61 74 65 2d 74 65 73 74 73 75 69 74 llocate-testsuit
2a20: 65 2f 61 72 65 61 2d 74 6f 2d 62 6c 6f 63 6b 20 e/area-to-block
2a30: 64 62 73 74 72 75 63 74 20 62 6c 6f 63 6b 2d 69 dbstruct block-i
2a40: 64 20 74 65 73 74 73 75 69 74 65 2d 6e 61 6d 65 d testsuite-name
2a50: 20 61 72 65 61 6b 65 79 29 29 0a 0a 20 20 20 20 areakey))..
2a60: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
2a70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2a80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2a90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2aa0: 3d 3d 3d 3d 3d 3d 3d 3d 0a 20 20 20 20 3b 3b 20 ========. ;;
2ab0: 52 45 41 44 20 4f 4e 4c 59 20 51 55 45 52 49 45 READ ONLY QUERIE
2ac0: 53 0a 20 20 20 20 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d S. ;;========
2ad0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2ae0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2af0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2b00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
2b10: 20 20 20 20 3b 3b 20 4b 45 59 53 0a 20 20 20 20 ;; KEYS.
2b20: 28 28 67 65 74 2d 6b 65 79 2d 76 61 6c 2d 70 61 ((get-key-val-pa
2b30: 69 72 73 29 20 20 20 20 20 20 20 20 20 20 20 20 irs)
2b40: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 (apply db:get
2b50: 2d 6b 65 79 2d 76 61 6c 2d 70 61 69 72 73 20 64 -key-val-pairs d
2b60: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
2b70: 0a 20 20 20 20 28 28 67 65 74 2d 6b 65 79 73 29 . ((get-keys)
2b80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2b90: 20 20 20 20 20 20 20 20 28 64 62 3a 67 65 74 2d (db:get-
2ba0: 6b 65 79 73 20 64 62 73 74 72 75 63 74 29 29 0a keys dbstruct)).
2bb0: 20 20 20 20 28 28 67 65 74 2d 6b 65 79 2d 76 61 ((get-key-va
2bc0: 6c 73 29 20 20 20 20 20 20 20 20 20 20 20 20 20 ls)
2bd0: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 (apply db
2be0: 3a 67 65 74 2d 6b 65 79 2d 76 61 6c 73 20 64 62 :get-key-vals db
2bf0: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a struct params)).
2c00: 20 20 20 20 28 28 67 65 74 2d 74 61 72 67 65 74 ((get-target
2c10: 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 )
2c20: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 (apply db
2c30: 3a 67 65 74 2d 74 61 72 67 65 74 20 64 62 73 74 :get-target dbst
2c40: 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 ruct params)).
2c50: 20 20 28 28 67 65 74 2d 74 61 72 67 65 74 73 29 ((get-targets)
2c60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2c70: 20 20 20 20 20 28 64 62 3a 67 65 74 2d 74 61 72 (db:get-tar
2c80: 67 65 74 73 20 64 62 73 74 72 75 63 74 29 29 0a gets dbstruct)).
2c90: 0a 20 20 20 20 3b 3b 20 41 52 43 48 49 56 45 53 . ;; ARCHIVES
2ca0: 0a 20 20 20 20 28 28 74 65 73 74 2d 67 65 74 2d . ((test-get-
2cb0: 61 72 63 68 69 76 65 2d 62 6c 6f 63 6b 2d 69 6e archive-block-in
2cc0: 66 6f 29 20 20 20 20 20 28 61 70 70 6c 79 20 64 fo) (apply d
2cd0: 62 3a 74 65 73 74 2d 67 65 74 2d 61 72 63 68 69 b:test-get-archi
2ce0: 76 65 2d 62 6c 6f 63 6b 2d 69 6e 66 6f 20 64 62 ve-block-info db
2cf0: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a struct params)).
2d00: 20 20 20 20 0a 20 20 20 20 3b 3b 20 54 45 53 54 . ;; TEST
2d10: 53 0a 20 20 20 20 28 28 74 65 73 74 2d 74 6f 70 S. ((test-top
2d20: 6c 65 76 65 6c 2d 6e 75 6d 2d 69 74 65 6d 73 29 level-num-items)
2d30: 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 (apply
2d40: 64 62 3a 74 65 73 74 2d 74 6f 70 6c 65 76 65 6c db:test-toplevel
2d50: 2d 6e 75 6d 2d 69 74 65 6d 73 20 64 62 73 74 72 -num-items dbstr
2d60: 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 uct params)).
2d70: 20 28 28 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f ((get-test-info
2d80: 2d 62 79 2d 69 64 29 09 20 20 20 20 20 20 20 28 -by-id). (
2d90: 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 74 65 73 apply db:get-tes
2da0: 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 64 62 73 t-info-by-id dbs
2db0: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 truct params)).
2dc0: 20 20 20 28 28 74 65 73 74 2d 67 65 74 2d 72 75 ((test-get-ru
2dd0: 6e 64 69 72 2d 66 72 6f 6d 2d 74 65 73 74 2d 69 ndir-from-test-i
2de0: 64 29 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a d) (apply db:
2df0: 74 65 73 74 2d 67 65 74 2d 72 75 6e 64 69 72 2d test-get-rundir-
2e00: 66 72 6f 6d 2d 74 65 73 74 2d 69 64 20 64 62 73 from-test-id dbs
2e10: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 truct params)).
2e20: 20 20 20 28 28 67 65 74 2d 63 6f 75 6e 74 2d 74 ((get-count-t
2e30: 65 73 74 73 2d 72 75 6e 6e 69 6e 67 2d 66 6f 72 ests-running-for
2e40: 2d 74 65 73 74 6e 61 6d 65 29 20 28 61 70 70 6c -testname) (appl
2e50: 79 20 64 62 3a 67 65 74 2d 63 6f 75 6e 74 2d 74 y db:get-count-t
2e60: 65 73 74 73 2d 72 75 6e 6e 69 6e 67 2d 66 6f 72 ests-running-for
2e70: 2d 74 65 73 74 6e 61 6d 65 20 64 62 73 74 72 75 -testname dbstru
2e80: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 ct params)).
2e90: 28 28 67 65 74 2d 63 6f 75 6e 74 2d 74 65 73 74 ((get-count-test
2ea0: 73 2d 72 75 6e 6e 69 6e 67 29 20 20 20 20 20 20 s-running)
2eb0: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 (apply db:get
2ec0: 2d 63 6f 75 6e 74 2d 74 65 73 74 73 2d 72 75 6e -count-tests-run
2ed0: 6e 69 6e 67 20 64 62 73 74 72 75 63 74 20 70 61 ning dbstruct pa
2ee0: 72 61 6d 73 29 29 0a 20 20 20 20 28 28 67 65 74 rams)). ((get
2ef0: 2d 63 6f 75 6e 74 2d 74 65 73 74 73 2d 72 75 6e -count-tests-run
2f00: 6e 69 6e 67 2d 69 6e 2d 6a 6f 62 67 72 6f 75 70 ning-in-jobgroup
2f10: 29 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d ) (apply db:get-
2f20: 63 6f 75 6e 74 2d 74 65 73 74 73 2d 72 75 6e 6e count-tests-runn
2f30: 69 6e 67 2d 69 6e 2d 6a 6f 62 67 72 6f 75 70 20 ing-in-jobgroup
2f40: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 dbstruct params)
2f50: 29 0a 20 20 20 20 3b 3b 20 28 28 64 65 6c 65 74 ). ;; ((delet
2f60: 65 2d 74 65 73 74 2d 73 74 65 70 2d 72 65 63 6f e-test-step-reco
2f70: 72 64 73 29 20 20 20 20 20 20 20 20 28 61 70 70 rds) (app
2f80: 6c 79 20 64 62 3a 64 65 6c 65 74 65 2d 74 65 73 ly db:delete-tes
2f90: 74 2d 73 74 65 70 2d 72 65 63 6f 72 64 73 20 64 t-step-records d
2fa0: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
2fb0: 0a 20 20 20 20 3b 3b 20 28 28 67 65 74 2d 70 72 . ;; ((get-pr
2fc0: 65 76 69 6f 75 73 2d 74 65 73 74 2d 72 75 6e 2d evious-test-run-
2fd0: 72 65 63 6f 72 64 29 20 20 20 20 28 61 70 70 6c record) (appl
2fe0: 79 20 64 62 3a 67 65 74 2d 70 72 65 76 69 6f 75 y db:get-previou
2ff0: 73 2d 74 65 73 74 2d 72 75 6e 2d 72 65 63 6f 72 s-test-run-recor
3000: 64 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d d dbstruct param
3010: 73 29 29 0a 20 20 20 20 28 28 67 65 74 2d 6d 61 s)). ((get-ma
3020: 74 63 68 69 6e 67 2d 70 72 65 76 69 6f 75 73 2d tching-previous-
3030: 74 65 73 74 2d 72 75 6e 2d 72 65 63 6f 72 64 73 test-run-records
3040: 29 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 6d )(apply db:get-m
3050: 61 74 63 68 69 6e 67 2d 70 72 65 76 69 6f 75 73 atching-previous
3060: 2d 74 65 73 74 2d 72 75 6e 2d 72 65 63 6f 72 64 -test-run-record
3070: 73 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d s dbstruct param
3080: 73 29 29 0a 20 20 20 20 28 28 74 65 73 74 2d 67 s)). ((test-g
3090: 65 74 2d 6c 6f 67 66 69 6c 65 2d 69 6e 66 6f 29 et-logfile-info)
30a0: 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c (appl
30b0: 79 20 64 62 3a 74 65 73 74 2d 67 65 74 2d 6c 6f y db:test-get-lo
30c0: 67 66 69 6c 65 2d 69 6e 66 6f 20 64 62 73 74 72 gfile-info dbstr
30d0: 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 uct params)).
30e0: 20 28 28 74 65 73 74 2d 67 65 74 2d 72 65 63 6f ((test-get-reco
30f0: 72 64 73 2d 66 6f 72 2d 69 6e 64 65 78 2d 66 69 rds-for-index-fi
3100: 6c 65 29 20 20 28 61 70 70 6c 79 20 64 62 3a 74 le) (apply db:t
3110: 65 73 74 2d 67 65 74 2d 72 65 63 6f 72 64 73 2d est-get-records-
3120: 66 6f 72 2d 69 6e 64 65 78 2d 66 69 6c 65 20 64 for-index-file d
3130: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
3140: 0a 20 20 20 20 28 28 67 65 74 2d 74 65 73 74 69 . ((get-testi
3150: 6e 66 6f 2d 73 74 61 74 65 2d 73 74 61 74 75 73 nfo-state-status
3160: 29 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 ) (apply d
3170: 62 3a 67 65 74 2d 74 65 73 74 69 6e 66 6f 2d 73 b:get-testinfo-s
3180: 74 61 74 65 2d 73 74 61 74 75 73 20 64 62 73 74 tate-status dbst
3190: 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 ruct params)).
31a0: 20 20 28 28 74 65 73 74 2d 67 65 74 2d 74 6f 70 ((test-get-top
31b0: 2d 70 72 6f 63 65 73 73 2d 70 69 64 29 20 20 20 -process-pid)
31c0: 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 74 (apply db:t
31d0: 65 73 74 2d 67 65 74 2d 74 6f 70 2d 70 72 6f 63 est-get-top-proc
31e0: 65 73 73 2d 70 69 64 20 64 62 73 74 72 75 63 74 ess-pid dbstruct
31f0: 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 28 28 params)). ((
3200: 74 65 73 74 2d 67 65 74 2d 70 61 74 68 73 2d 6d test-get-paths-m
3210: 61 74 63 68 69 6e 67 2d 6b 65 79 6e 61 6d 65 73 atching-keynames
3220: 2d 74 61 72 67 65 74 2d 6e 65 77 29 20 28 61 70 -target-new) (ap
3230: 70 6c 79 20 64 62 3a 74 65 73 74 2d 67 65 74 2d ply db:test-get-
3240: 70 61 74 68 73 2d 6d 61 74 63 68 69 6e 67 2d 6b paths-matching-k
3250: 65 79 6e 61 6d 65 73 2d 74 61 72 67 65 74 2d 6e eynames-target-n
3260: 65 77 20 64 62 73 74 72 75 63 74 20 70 61 72 61 ew dbstruct para
3270: 6d 73 29 29 0a 20 20 20 20 28 28 67 65 74 2d 70 ms)). ((get-p
3280: 72 65 72 65 71 73 2d 6e 6f 74 2d 6d 65 74 29 20 rereqs-not-met)
3290: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 (app
32a0: 6c 79 20 64 62 3a 67 65 74 2d 70 72 65 72 65 71 ly db:get-prereq
32b0: 73 2d 6e 6f 74 2d 6d 65 74 20 64 62 73 74 72 75 s-not-met dbstru
32c0: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 ct params)).
32d0: 28 28 67 65 74 2d 63 6f 75 6e 74 2d 74 65 73 74 ((get-count-test
32e0: 73 2d 72 75 6e 6e 69 6e 67 2d 66 6f 72 2d 72 75 s-running-for-ru
32f0: 6e 2d 69 64 29 20 28 61 70 70 6c 79 20 64 62 3a n-id) (apply db:
3300: 67 65 74 2d 63 6f 75 6e 74 2d 74 65 73 74 73 2d get-count-tests-
3310: 72 75 6e 6e 69 6e 67 2d 66 6f 72 2d 72 75 6e 2d running-for-run-
3320: 69 64 20 64 62 73 74 72 75 63 74 20 70 61 72 61 id dbstruct para
3330: 6d 73 29 29 0a 20 20 20 20 28 28 67 65 74 2d 6e ms)). ((get-n
3340: 6f 74 2d 63 6f 6d 70 6c 65 74 65 64 2d 63 6e 74 ot-completed-cnt
3350: 29 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 ) (app
3360: 6c 79 20 64 62 3a 67 65 74 2d 6e 6f 74 2d 63 6f ly db:get-not-co
3370: 6d 70 6c 65 74 65 64 2d 63 6e 74 20 20 64 62 73 mpleted-cnt dbs
3380: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 20 0a truct params)) .
3390: 20 20 20 20 3b 3b 20 28 28 73 79 6e 63 68 61 73 ;; ((synchas
33a0: 68 2d 67 65 74 29 20 20 20 20 20 20 20 20 20 20 h-get)
33b0: 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 (apply
33c0: 20 73 79 6e 63 68 61 73 68 3a 73 65 72 76 65 72 synchash:server
33d0: 2d 67 65 74 20 64 62 73 74 72 75 63 74 20 70 61 -get dbstruct pa
33e0: 72 61 6d 73 29 29 0a 20 20 20 20 28 28 67 65 74 rams)). ((get
33f0: 2d 72 61 77 2d 72 75 6e 2d 73 74 61 74 73 29 20 -raw-run-stats)
3400: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 (a
3410: 70 70 6c 79 20 64 62 3a 67 65 74 2d 72 61 77 2d pply db:get-raw-
3420: 72 75 6e 2d 73 74 61 74 73 20 64 62 73 74 72 75 run-stats dbstru
3430: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 ct params)).
3440: 28 28 67 65 74 2d 74 65 73 74 2d 74 69 6d 65 73 ((get-test-times
3450: 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 )
3460: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 (apply db:get
3470: 2d 74 65 73 74 2d 74 69 6d 65 73 20 64 62 73 74 -test-times dbst
3480: 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 0a 20 ruct params))..
3490: 20 20 20 3b 3b 20 52 55 4e 53 0a 20 20 20 20 28 ;; RUNS. (
34a0: 28 67 65 74 2d 72 75 6e 2d 69 6e 66 6f 29 20 20 (get-run-info)
34b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
34c0: 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 72 75 6e apply db:get-run
34d0: 2d 69 6e 66 6f 20 64 62 73 74 72 75 63 74 20 70 -info dbstruct p
34e0: 61 72 61 6d 73 29 29 0a 20 20 20 20 28 28 67 65 arams)). ((ge
34f0: 74 2d 72 75 6e 2d 73 74 61 74 75 73 29 20 20 20 t-run-status)
3500: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 (app
3510: 6c 79 20 64 62 3a 67 65 74 2d 72 75 6e 2d 73 74 ly db:get-run-st
3520: 61 74 75 73 20 64 62 73 74 72 75 63 74 20 70 61 atus dbstruct pa
3530: 72 61 6d 73 29 29 0a 20 20 20 20 28 28 67 65 74 rams)). ((get
3540: 2d 72 75 6e 2d 73 74 61 74 65 29 20 20 20 20 20 -run-state)
3550: 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c (appl
3560: 79 20 64 62 3a 67 65 74 2d 72 75 6e 2d 73 74 61 y db:get-run-sta
3570: 74 65 20 64 62 73 74 72 75 63 74 20 70 61 72 61 te dbstruct para
3580: 6d 73 29 29 0a 20 20 20 20 28 28 73 65 74 2d 72 ms)). ((set-r
3590: 75 6e 2d 73 74 61 74 75 73 29 20 20 20 20 20 20 un-status)
35a0: 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 (apply
35b0: 64 62 3a 73 65 74 2d 72 75 6e 2d 73 74 61 74 75 db:set-run-statu
35c0: 73 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d s dbstruct param
35d0: 73 29 29 0a 20 20 20 20 28 28 73 65 74 2d 72 75 s)). ((set-ru
35e0: 6e 2d 73 74 61 74 65 2d 73 74 61 74 75 73 29 20 n-state-status)
35f0: 20 09 09 09 20 28 61 70 70 6c 79 20 64 62 3a 73 ... (apply db:s
3600: 65 74 2d 72 75 6e 2d 73 74 61 74 65 2d 73 74 61 et-run-state-sta
3610: 74 75 73 20 64 62 73 74 72 75 63 74 20 70 61 72 tus dbstruct par
3620: 61 6d 73 29 29 0a 20 20 20 20 28 28 75 70 64 61 ams)). ((upda
3630: 74 65 2d 74 65 73 64 61 74 61 2d 6f 6e 2d 72 65 te-tesdata-on-re
3640: 70 69 6c 63 61 74 65 2d 64 62 29 20 28 61 70 70 pilcate-db) (app
3650: 6c 79 20 64 62 3a 75 70 64 61 74 65 2d 74 65 73 ly db:update-tes
3660: 64 61 74 61 2d 6f 6e 2d 72 65 70 69 6c 63 61 74 data-on-repilcat
3670: 65 2d 64 62 20 20 64 62 73 74 72 75 63 74 20 70 e-db dbstruct p
3680: 61 72 61 6d 73 29 29 20 0a 20 20 20 20 28 28 67 arams)) . ((g
3690: 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e et-tests-for-run
36a0: 29 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 ) (ap
36b0: 70 6c 79 20 64 62 3a 67 65 74 2d 74 65 73 74 73 ply db:get-tests
36c0: 2d 66 6f 72 2d 72 75 6e 20 64 62 73 74 72 75 63 -for-run dbstruc
36d0: 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 28 t params)). (
36e0: 28 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 (get-tests-for-r
36f0: 75 6e 2d 73 74 61 74 65 2d 73 74 61 74 75 73 29 un-state-status)
3700: 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 74 (apply db:get-t
3710: 65 73 74 73 2d 66 6f 72 2d 72 75 6e 2d 73 74 61 ests-for-run-sta
3720: 74 65 2d 73 74 61 74 75 73 20 64 62 73 74 72 75 te-status dbstru
3730: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 ct params)).
3740: 28 28 67 65 74 2d 74 65 73 74 2d 69 64 29 20 20 ((get-test-id)
3750: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3760: 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 74 65 (apply db:get-te
3770: 73 74 2d 69 64 20 64 62 73 74 72 75 63 74 20 70 st-id dbstruct p
3780: 61 72 61 6d 73 29 29 0a 20 20 20 20 28 28 67 65 arams)). ((ge
3790: 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 2d t-tests-for-run-
37a0: 6d 69 6e 64 61 74 61 29 20 20 20 20 28 61 70 70 mindata) (app
37b0: 6c 79 20 64 62 3a 67 65 74 2d 74 65 73 74 73 2d ly db:get-tests-
37c0: 66 6f 72 2d 72 75 6e 2d 6d 69 6e 64 61 74 61 20 for-run-mindata
37d0: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 dbstruct params)
37e0: 29 0a 20 20 20 20 3b 3b 20 28 28 67 65 74 2d 74 ). ;; ((get-t
37f0: 65 73 74 73 2d 66 6f 72 2d 72 75 6e 73 2d 6d 69 ests-for-runs-mi
3800: 6e 64 61 74 61 29 20 20 20 28 61 70 70 6c 79 20 ndata) (apply
3810: 64 62 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 db:get-tests-for
3820: 2d 72 75 6e 73 2d 6d 69 6e 64 61 74 61 20 64 62 -runs-mindata db
3830: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a struct params)).
3840: 20 20 20 20 28 28 67 65 74 2d 72 75 6e 73 29 20 ((get-runs)
3850: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3860: 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 (apply db:ge
3870: 74 2d 72 75 6e 73 20 64 62 73 74 72 75 63 74 20 t-runs dbstruct
3880: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 28 28 73 params)). ((s
3890: 69 6d 70 6c 65 2d 67 65 74 2d 72 75 6e 73 29 20 imple-get-runs)
38a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 (ap
38b0: 70 6c 79 20 64 62 3a 73 69 6d 70 6c 65 2d 67 65 ply db:simple-ge
38c0: 74 2d 72 75 6e 73 20 64 62 73 74 72 75 63 74 20 t-runs dbstruct
38d0: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 28 28 67 params)). ((g
38e0: 65 74 2d 6e 75 6d 2d 72 75 6e 73 29 20 20 20 20 et-num-runs)
38f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 (ap
3900: 70 6c 79 20 64 62 3a 67 65 74 2d 6e 75 6d 2d 72 ply db:get-num-r
3910: 75 6e 73 20 64 62 73 74 72 75 63 74 20 70 61 72 uns dbstruct par
3920: 61 6d 73 29 29 0a 20 20 20 20 28 28 67 65 74 2d ams)). ((get-
3930: 72 75 6e 73 2d 63 6e 74 2d 62 79 2d 70 61 74 74 runs-cnt-by-patt
3940: 29 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 ) (apply
3950: 20 64 62 3a 67 65 74 2d 72 75 6e 73 2d 63 6e 74 db:get-runs-cnt
3960: 2d 62 79 2d 70 61 74 74 20 64 62 73 74 72 75 63 -by-patt dbstruc
3970: 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 28 t params)). (
3980: 28 67 65 74 2d 61 6c 6c 2d 72 75 6e 2d 69 64 73 (get-all-run-ids
3990: 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ) (
39a0: 64 62 3a 67 65 74 2d 61 6c 6c 2d 72 75 6e 2d 69 db:get-all-run-i
39b0: 64 73 20 64 62 73 74 72 75 63 74 29 29 0a 20 20 ds dbstruct)).
39c0: 20 20 28 28 67 65 74 2d 70 72 65 76 2d 72 75 6e ((get-prev-run
39d0: 2d 69 64 73 29 20 20 20 20 20 20 20 20 20 20 20 -ids)
39e0: 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d (apply db:get-
39f0: 70 72 65 76 2d 72 75 6e 2d 69 64 73 20 64 62 73 prev-run-ids dbs
3a00: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 truct params)).
3a10: 20 20 20 28 28 67 65 74 2d 72 75 6e 2d 69 64 73 ((get-run-ids
3a20: 2d 6d 61 74 63 68 69 6e 67 2d 74 61 72 67 65 74 -matching-target
3a30: 29 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 ) (apply db:get
3a40: 2d 72 75 6e 2d 69 64 73 2d 6d 61 74 63 68 69 6e -run-ids-matchin
3a50: 67 2d 74 61 72 67 65 74 20 64 62 73 74 72 75 63 g-target dbstruc
3a60: 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 28 t params)). (
3a70: 28 67 65 74 2d 72 75 6e 73 2d 62 79 2d 70 61 74 (get-runs-by-pat
3a80: 74 29 20 20 20 20 20 20 20 20 20 20 20 20 20 28 t) (
3a90: 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 72 75 6e apply db:get-run
3aa0: 73 2d 62 79 2d 70 61 74 74 20 64 62 73 74 72 75 s-by-patt dbstru
3ab0: 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 ct params)).
3ac0: 28 28 67 65 74 2d 72 75 6e 2d 6e 61 6d 65 2d 66 ((get-run-name-f
3ad0: 72 6f 6d 2d 69 64 29 20 20 20 20 20 20 20 20 20 rom-id)
3ae0: 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 72 75 (apply db:get-ru
3af0: 6e 2d 6e 61 6d 65 2d 66 72 6f 6d 2d 69 64 20 64 n-name-from-id d
3b00: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
3b10: 0a 20 20 20 20 28 28 67 65 74 2d 6d 61 69 6e 2d . ((get-main-
3b20: 72 75 6e 2d 73 74 61 74 73 29 20 20 20 20 20 20 run-stats)
3b30: 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 (apply db:g
3b40: 65 74 2d 6d 61 69 6e 2d 72 75 6e 2d 73 74 61 74 et-main-run-stat
3b50: 73 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d s dbstruct param
3b60: 73 29 29 0a 20 20 20 20 28 28 6c 6f 67 2d 74 6f s)). ((log-to
3b70: 2d 6d 61 69 6e 29 20 20 20 20 20 20 20 20 20 20 -main)
3b80: 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 (apply d
3b90: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 ebug:print 0 *de
3ba0: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
3bb0: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 28 28 67 params)). ((g
3bc0: 65 74 2d 76 61 72 29 20 20 20 20 20 20 20 20 20 et-var)
3bd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 (ap
3be0: 70 6c 79 20 64 62 3a 67 65 74 2d 76 61 72 20 64 ply db:get-var d
3bf0: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
3c00: 0a 20 20 20 20 28 28 67 65 74 2d 72 75 6e 2d 73 . ((get-run-s
3c10: 74 61 74 73 29 20 20 20 20 20 20 20 20 20 20 20 tats)
3c20: 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 (apply db:g
3c30: 65 74 2d 72 75 6e 2d 73 74 61 74 73 20 64 62 73 et-run-stats dbs
3c40: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 truct params)).
3c50: 20 20 20 28 28 67 65 74 2d 72 75 6e 2d 74 69 6d ((get-run-tim
3c60: 65 73 29 20 20 20 20 20 20 20 20 20 20 20 20 20 es)
3c70: 20 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 (apply db:get
3c80: 2d 72 75 6e 2d 74 69 6d 65 73 20 64 62 73 74 72 -run-times dbstr
3c90: 75 63 74 20 70 61 72 61 6d 73 29 29 20 0a 0a 20 uct params)) ..
3ca0: 20 20 20 3b 3b 20 53 54 45 50 53 0a 20 20 20 20 ;; STEPS.
3cb0: 28 28 67 65 74 2d 73 74 65 70 73 2d 64 61 74 61 ((get-steps-data
3cc0: 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 )
3cd0: 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 73 74 (apply db:get-st
3ce0: 65 70 73 2d 64 61 74 61 20 64 62 73 74 72 75 63 eps-data dbstruc
3cf0: 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 28 t params)). (
3d00: 28 67 65 74 2d 73 74 65 70 73 2d 66 6f 72 2d 74 (get-steps-for-t
3d10: 65 73 74 29 20 20 20 20 20 20 20 20 20 20 20 28 est) (
3d20: 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 73 74 65 apply db:get-ste
3d30: 70 73 2d 66 6f 72 2d 74 65 73 74 20 64 62 73 74 ps-for-test dbst
3d40: 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a 20 20 ruct params)).
3d50: 20 20 28 28 67 65 74 2d 73 74 65 70 73 2d 69 6e ((get-steps-in
3d60: 66 6f 2d 62 79 2d 69 64 29 20 20 20 20 20 20 20 fo-by-id)
3d70: 20 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d (apply db:get-
3d80: 73 74 65 70 73 2d 69 6e 66 6f 2d 62 79 2d 69 64 steps-info-by-id
3d90: 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 dbstruct params
3da0: 29 29 0a 0a 20 20 20 20 3b 3b 20 54 45 53 54 20 )).. ;; TEST
3db0: 44 41 54 41 0a 20 20 20 20 28 28 72 65 61 64 2d DATA. ((read-
3dc0: 74 65 73 74 2d 64 61 74 61 29 20 20 20 20 20 20 test-data)
3dd0: 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 (apply
3de0: 64 62 3a 72 65 61 64 2d 74 65 73 74 2d 64 61 74 db:read-test-dat
3df0: 61 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d a dbstruct param
3e00: 73 29 29 0a 20 20 20 20 28 28 72 65 61 64 2d 74 s)). ((read-t
3e10: 65 73 74 2d 64 61 74 61 2d 76 61 72 70 61 74 74 est-data-varpatt
3e20: 29 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 ) (apply d
3e30: 62 3a 72 65 61 64 2d 74 65 73 74 2d 64 61 74 61 b:read-test-data
3e40: 2d 76 61 72 70 61 74 74 20 64 62 73 74 72 75 63 -varpatt dbstruc
3e50: 74 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 28 t params)). (
3e60: 28 67 65 74 2d 64 61 74 61 2d 69 6e 66 6f 2d 62 (get-data-info-b
3e70: 79 2d 69 64 29 20 20 20 20 20 20 20 20 20 20 28 y-id) (
3e80: 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 64 61 74 apply db:get-dat
3e90: 61 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 64 62 73 a-info-by-id dbs
3ea0: 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 20 0a truct params)) .
3eb0: 0a 20 20 20 20 3b 3b 20 4d 49 53 43 0a 20 20 20 . ;; MISC.
3ec0: 20 28 28 67 65 74 2d 6c 61 74 65 73 74 2d 68 6f ((get-latest-ho
3ed0: 73 74 2d 6c 6f 61 64 29 20 20 20 20 20 20 20 20 st-load)
3ee0: 20 28 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 6c (apply db:get-l
3ef0: 61 74 65 73 74 2d 68 6f 73 74 2d 6c 6f 61 64 20 atest-host-load
3f00: 64 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 dbstruct params)
3f10: 29 0a 20 20 20 20 28 28 68 61 76 65 2d 69 6e 63 ). ((have-inc
3f20: 6f 6d 70 6c 65 74 65 73 3f 29 20 20 20 20 20 20 ompletes?)
3f30: 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 62 3a (apply db:
3f40: 68 61 76 65 2d 69 6e 63 6f 6d 70 6c 65 74 65 73 have-incompletes
3f50: 3f 20 64 62 73 74 72 75 63 74 20 70 61 72 61 6d ? dbstruct param
3f60: 73 29 29 0a 20 20 20 20 28 28 6c 6f 67 69 6e 29 s)). ((login)
3f70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3f80: 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 64 (apply d
3f90: 62 3a 6c 6f 67 69 6e 20 64 62 73 74 72 75 63 74 b:login dbstruct
3fa0: 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 28 28 params)). ((
3fb0: 67 65 6e 65 72 61 6c 2d 63 61 6c 6c 29 20 20 20 general-call)
3fc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
3fd0: 65 74 20 28 28 73 74 6d 74 6e 61 6d 65 20 20 20 et ((stmtname
3fe0: 28 63 61 72 20 70 61 72 61 6d 73 29 29 0a 09 09 (car params))...
3ff0: 09 09 09 20 20 28 72 75 6e 2d 69 64 20 20 20 20 ... (run-id
4000: 20 28 63 61 64 72 20 70 61 72 61 6d 73 29 29 0a (cadr params)).
4010: 09 09 09 09 09 20 20 28 72 65 61 6c 70 61 72 61 ..... (realpara
4020: 6d 73 20 28 63 64 64 72 20 70 61 72 61 6d 73 29 ms (cddr params)
4030: 29 29 0a 09 09 09 09 20 20 20 20 20 20 28 64 62 ))..... (db
4040: 3a 67 65 6e 65 72 61 6c 2d 63 61 6c 6c 20 64 62 :general-call db
4050: 73 74 72 75 63 74 20 73 74 6d 74 6e 61 6d 65 20 struct stmtname
4060: 72 75 6e 2d 69 64 20 72 65 61 6c 70 61 72 61 6d run-id realparam
4070: 73 29 29 29 0a 20 20 20 20 28 28 73 64 62 2d 71 s))). ((sdb-q
4080: 72 79 29 20 20 20 20 20 20 20 20 20 20 20 20 20 ry)
4090: 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 (apply
40a0: 73 64 62 3a 71 72 79 20 70 61 72 61 6d 73 29 29 sdb:qry params))
40b0: 0a 20 20 20 20 28 28 70 69 6e 67 29 20 20 20 20 . ((ping)
40c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
40d0: 20 20 20 20 20 60 28 23 74 20 2c 28 63 75 72 72 `(#t ,(curr
40e0: 65 6e 74 2d 70 72 6f 63 65 73 73 2d 69 64 29 20 ent-process-id)
40f0: 2c 28 63 61 64 72 20 70 61 72 61 6d 73 29 29 29 ,(cadr params)))
4100: 20 3b 3b 20 28 63 75 72 72 65 6e 74 2d 70 72 6f ;; (current-pro
4110: 63 65 73 73 2d 69 64 29 29 0a 20 20 20 20 28 28 cess-id)). ((
4120: 67 65 74 2d 63 68 61 6e 67 65 64 2d 72 65 63 6f get-changed-reco
4130: 72 64 2d 69 64 73 29 20 20 20 20 20 20 20 28 61 rd-ids) (a
4140: 70 70 6c 79 20 64 62 3a 67 65 74 2d 63 68 61 6e pply db:get-chan
4150: 67 65 64 2d 72 65 63 6f 72 64 2d 69 64 73 20 64 ged-record-ids d
4160: 62 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 bstruct params))
4170: 0a 20 20 20 20 28 28 67 65 74 2d 72 75 6e 2d 72 . ((get-run-r
4180: 65 63 6f 72 64 2d 69 64 73 29 20 09 20 20 20 28 ecord-ids) . (
4190: 61 70 70 6c 79 20 64 62 3a 67 65 74 2d 72 75 6e apply db:get-run
41a0: 2d 72 65 63 6f 72 64 2d 69 64 73 20 64 62 73 74 -record-ids dbst
41b0: 72 75 63 74 20 70 61 72 61 6d 73 29 29 09 0a 20 ruct params))..
41c0: 20 20 20 3b 3b 20 54 45 53 54 4d 45 54 41 0a 20 ;; TESTMETA.
41d0: 20 20 20 28 28 74 65 73 74 6d 65 74 61 2d 67 65 ((testmeta-ge
41e0: 74 2d 72 65 63 6f 72 64 29 20 20 20 20 20 20 20 t-record)
41f0: 28 61 70 70 6c 79 20 64 62 3a 74 65 73 74 6d 65 (apply db:testme
4200: 74 61 2d 67 65 74 2d 72 65 63 6f 72 64 20 64 62 ta-get-record db
4210: 73 74 72 75 63 74 20 70 61 72 61 6d 73 29 29 0a struct params)).
4220: 0a 20 20 20 20 3b 3b 20 54 41 53 4b 53 20 0a 20 . ;; TASKS .
4230: 20 20 20 28 28 66 69 6e 64 2d 74 61 73 6b 2d 71 ((find-task-q
4240: 75 65 75 65 2d 72 65 63 6f 72 64 73 29 20 20 20 ueue-records)
4250: 28 61 70 70 6c 79 20 74 61 73 6b 73 3a 66 69 6e (apply tasks:fin
4260: 64 2d 74 61 73 6b 2d 71 75 65 75 65 2d 72 65 63 d-task-queue-rec
4270: 6f 72 64 73 20 64 62 73 74 72 75 63 74 20 70 61 ords dbstruct pa
4280: 72 61 6d 73 29 29 0a 20 20 20 20 28 65 6c 73 65 rams)). (else
4290: 0a 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 . (debug:pri
42a0: 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
42b0: 67 2d 70 6f 72 74 2a 20 22 45 52 52 4f 52 3a 20 g-port* "ERROR:
42c0: 62 61 64 20 61 70 69 20 63 61 6c 6c 20 22 20 63 bad api call " c
42d0: 6d 64 29 0a 20 20 20 20 20 28 63 6f 6e 63 20 22 md). (conc "
42e0: 45 52 52 4f 52 3a 20 42 41 44 20 61 70 69 20 63 ERROR: BAD api c
42f0: 61 6c 6c 20 22 20 63 6d 64 29 29 29 29 0a 0a 3b all " cmd))))..;
4300: 3b 20 54 68 65 73 65 20 61 72 65 20 63 61 6c 6c ; These are call
4310: 65 64 20 62 79 20 74 68 65 20 73 65 72 76 65 72 ed by the server
4320: 20 6f 6e 20 72 65 63 69 70 74 20 6f 66 20 2f 61 on recipt of /a
4330: 70 69 20 63 61 6c 6c 73 0a 3b 3b 20 20 20 20 2d pi calls.;; -
4340: 20 6b 65 65 70 20 69 74 20 73 69 6d 70 6c 65 2c keep it simple,
4350: 20 6f 6e 6c 79 20 72 65 74 75 72 6e 20 74 68 65 only return the
4360: 20 61 63 74 75 61 6c 20 72 65 73 75 6c 74 20 6f actual result o
4370: 66 20 74 68 65 20 63 61 6c 6c 2c 20 69 2e 65 2e f the call, i.e.
4380: 20 6e 6f 20 6d 65 74 61 20 69 6e 66 6f 20 68 65 no meta info he
4390: 72 65 0a 3b 3b 0a 3b 3b 20 20 20 20 2d 20 72 65 re.;;.;; - re
43a0: 74 75 72 6e 73 20 23 28 20 66 6c 61 67 20 72 65 turns #( flag re
43b0: 73 75 6c 74 20 29 0a 3b 3b 0a 28 64 65 66 69 6e sult ).;;.(defin
43c0: 65 20 28 61 70 69 3a 65 78 65 63 75 74 65 2d 72 e (api:execute-r
43d0: 65 71 75 65 73 74 73 20 64 62 73 74 72 75 63 74 equests dbstruct
43e0: 20 63 6d 64 20 70 61 72 61 6d 73 29 0a 20 20 28 cmd params). (
43f0: 6c 65 74 2a 20 28 28 73 74 61 72 74 2d 74 20 20 let* ((start-t
4400: 20 20 20 20 20 20 20 20 20 28 63 75 72 72 65 6e (curren
4410: 74 2d 6d 69 6c 6c 69 73 65 63 6f 6e 64 73 29 29 t-milliseconds))
4420: 0a 09 20 3b 3b 20 28 72 65 61 64 6f 6e 6c 79 2d .. ;; (readonly-
4430: 6d 6f 64 65 20 20 20 20 20 28 64 62 72 3a 64 62 mode (dbr:db
4440: 73 74 72 75 63 74 2d 72 65 61 64 2d 6f 6e 6c 79 struct-read-only
4450: 20 64 62 73 74 72 75 63 74 29 29 0a 09 20 3b 3b dbstruct)).. ;;
4460: 20 28 72 65 61 64 6f 6e 6c 79 2d 63 6f 6d 6d 61 (readonly-comma
4470: 6e 64 20 20 28 6d 65 6d 62 65 72 20 63 6d 64 20 nd (member cmd
4480: 61 70 69 3a 72 65 61 64 2d 6f 6e 6c 79 2d 71 75 api:read-only-qu
4490: 65 72 69 65 73 29 29 0a 20 20 20 20 20 20 20 20 eries)).
44a0: 20 20 20 20 3b 3b 20 28 77 72 69 74 65 63 6d 64 ;; (writecmd
44b0: 2d 69 6e 2d 72 65 61 64 6f 6e 6c 79 2d 6d 6f 64 -in-readonly-mod
44c0: 65 20 28 61 6e 64 20 72 65 61 64 6f 6e 6c 79 2d e (and readonly-
44d0: 6d 6f 64 65 20 28 6e 6f 74 20 72 65 61 64 6f 6e mode (not readon
44e0: 6c 79 2d 63 6f 6d 6d 61 6e 64 29 29 29 0a 09 20 ly-command)))..
44f0: 28 72 65 73 20 20 20 20 20 20 20 20 28 61 70 69 (res (api
4500: 3a 64 69 73 70 61 74 63 68 2d 63 6d 64 20 64 62 :dispatch-cmd db
4510: 73 74 72 75 63 74 20 63 6d 64 20 70 61 72 61 6d struct cmd param
4520: 73 29 29 29 0a 20 20 20 20 0a 20 20 20 20 3b 3b s))). . ;;
4530: 20 28 69 66 20 77 72 69 74 65 63 6d 64 2d 69 6e (if writecmd-in
4540: 2d 72 65 61 64 6f 6e 6c 79 2d 6d 6f 64 65 0a 20 -readonly-mode.
4550: 20 20 20 3b 3b 20 28 63 6f 6e 63 20 22 61 74 74 ;; (conc "att
4560: 65 6d 70 74 20 74 6f 20 72 75 6e 20 77 72 69 74 empt to run writ
4570: 65 20 63 6f 6d 6d 61 6e 64 20 22 63 6d 64 22 20 e command "cmd"
4580: 6f 6e 20 61 20 72 65 61 64 2d 6f 6e 6c 79 20 64 on a read-only d
4590: 61 74 61 62 61 73 65 22 29 0a 0a 20 20 20 20 3b atabase").. ;
45a0: 3b 20 73 61 76 65 20 61 6c 6c 20 73 74 61 74 73 ; save all stats
45b0: 0a 20 20 20 20 28 6c 65 74 20 28 28 64 65 6c 74 . (let ((delt
45c0: 61 2d 74 20 28 2d 20 28 63 75 72 72 65 6e 74 2d a-t (- (current-
45d0: 6d 69 6c 6c 69 73 65 63 6f 6e 64 73 29 0a 09 09 milliseconds)...
45e0: 20 20 20 20 20 20 73 74 61 72 74 2d 74 29 29 29 start-t)))
45f0: 0a 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 . (hash-tab
4600: 6c 65 2d 73 65 74 21 20 2a 64 62 2d 61 70 69 2d le-set! *db-api-
4610: 63 61 6c 6c 2d 74 69 6d 65 2a 20 63 6d 64 0a 09 call-time* cmd..
4620: 09 20 20 20 20 20 20 20 28 63 6f 6e 73 20 64 65 . (cons de
4630: 6c 74 61 2d 74 20 28 68 61 73 68 2d 74 61 62 6c lta-t (hash-tabl
4640: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 64 e-ref/default *d
4650: 62 2d 61 70 69 2d 63 61 6c 6c 2d 74 69 6d 65 2a b-api-call-time*
4660: 20 63 6d 64 20 27 28 29 29 29 29 29 0a 20 20 20 cmd '())))).
4670: 20 72 65 73 29 29 0a 0a 3b 3b 20 20 20 20 20 28 res))..;; (
4680: 69 66 20 23 66 20 3b 3b 20 77 72 69 74 65 63 6d if #f ;; writecm
4690: 64 2d 69 6e 2d 72 65 61 64 6f 6e 6c 79 2d 6d 6f d-in-readonly-mo
46a0: 64 65 0a 3b 3b 20 09 28 62 65 67 69 6e 0a 3b 3b de.;; .(begin.;;
46b0: 20 09 20 20 28 76 65 63 74 6f 72 20 23 66 20 72 . (vector #f r
46c0: 65 73 29 29 0a 3b 3b 20 09 28 62 65 67 69 6e 0a es)).;; .(begin.
46d0: 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;;
46e0: 28 76 65 63 74 6f 72 20 23 74 20 72 65 73 29 29 (vector #t res))
46f0: 29 29 29 29 29 29 0a 0a 3b 3b 20 68 74 74 70 2d ))))))..;; http-
4700: 73 65 72 76 65 72 20 20 73 65 6e 64 2d 72 65 73 server send-res
4710: 70 6f 6e 73 65 0a 3b 3b 20 20 20 20 20 20 20 20 ponse.;;
4720: 20 20 20 20 20 20 20 20 20 61 70 69 3a 70 72 6f api:pro
4730: 63 65 73 73 2d 72 65 71 75 65 73 74 0a 3b 3b 20 cess-request.;;
4740: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4750: 20 20 20 64 62 3a 2a 0a 3b 3b 0a 3b 3b 20 4e 42 db:*.;;.;; NB
4760: 2f 2f 20 52 75 6e 73 20 6f 6e 20 74 68 65 20 73 // Runs on the s
4770: 65 72 76 65 72 20 61 73 20 70 61 72 74 20 6f 66 erver as part of
4780: 20 74 68 65 20 73 65 72 76 65 72 20 6c 6f 6f 70 the server loop
4790: 0a 3b 3b 0a 23 3b 28 64 65 66 69 6e 65 20 28 61 .;;.#;(define (a
47a0: 70 69 3a 70 72 6f 63 65 73 73 2d 72 65 71 75 65 pi:process-reque
47b0: 73 74 20 64 62 73 74 72 75 63 74 20 69 6e 64 61 st dbstruct inda
47c0: 74 29 20 3b 3b 20 74 68 65 20 24 20 69 73 20 74 t) ;; the $ is t
47d0: 68 65 20 72 65 71 75 65 73 74 20 76 61 72 73 20 he request vars
47e0: 70 72 6f 63 0a 20 20 28 6c 65 74 2a 20 28 28 63 proc. (let* ((c
47f0: 6d 64 2d 69 6e 20 20 28 61 6c 69 73 74 2d 72 65 md-in (alist-re
4800: 66 20 27 63 6d 64 20 69 6e 64 61 74 29 29 20 3b f 'cmd indat)) ;
4810: 3b 20 28 24 20 27 63 6d 64 29 29 0a 09 20 28 63 ; ($ 'cmd)).. (c
4820: 6d 64 20 20 20 20 20 28 69 66 20 28 73 74 72 69 md (if (stri
4830: 6e 67 3f 20 63 6d 64 2d 69 6e 29 28 73 74 72 69 ng? cmd-in)(stri
4840: 6e 67 2d 3e 73 79 6d 62 6f 6c 20 63 6d 64 2d 69 ng->symbol cmd-i
4850: 6e 29 20 63 6d 64 2d 69 6e 29 29 0a 09 20 28 70 n) cmd-in)).. (p
4860: 61 72 61 6d 73 20 20 28 61 6c 69 73 74 2d 72 65 arams (alist-re
4870: 66 20 27 70 61 72 61 6d 73 20 69 6e 64 61 74 29 f 'params indat)
4880: 29 0a 20 20 20 20 20 20 20 20 20 28 6b 65 79 20 ). (key
4890: 20 20 20 20 28 61 6c 69 73 74 2d 72 65 66 20 27 (alist-ref '
48a0: 6b 65 79 20 69 6e 64 61 74 29 29 20 20 20 20 3b key indat)) ;
48b0: 3b 20 54 4f 44 4f 20 2d 20 61 64 64 20 74 68 69 ; TODO - add thi
48c0: 73 20 62 61 63 6b 0a 09 20 3b 3b 20 28 64 6f 70 s back.. ;; (dop
48d0: 72 69 6e 74 20 28 61 70 70 6c 79 20 63 6f 6d 6d rint (apply comm
48e0: 6f 6e 3a 6c 6f 77 2d 6e 6f 69 73 65 2d 70 72 69 on:low-noise-pri
48f0: 6e 74 20 31 30 20 70 61 72 61 6d 73 29 29 0a 09 nt 10 params))..
4900: 20 29 0a 20 20 20 20 3b 3b 20 28 69 66 20 64 6f ). ;; (if do
4910: 70 72 69 6e 74 20 28 64 65 62 75 67 3a 70 72 69 print (debug:pri
4920: 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
4930: 67 2d 70 6f 72 74 2a 20 22 63 6d 64 3a 20 22 20 g-port* "cmd: "
4940: 63 6d 64 20 22 20 77 69 74 68 20 70 61 72 61 6d cmd " with param
4950: 73 3a 20 22 20 70 61 72 61 6d 73 20 22 2c 20 6b s: " params ", k
4960: 65 79 3a 20 22 20 6b 65 79 29 29 0a 20 20 20 20 ey: " key)).
4970: 28 63 61 73 65 20 63 6d 64 2d 69 6e 0a 20 20 20 (case cmd-in.
4980: 20 20 20 28 28 70 69 6e 67 29 20 23 74 29 0a 20 ((ping) #t).
4990: 20 20 20 20 20 3b 3b 20 28 28 71 75 69 74 29 20 ;; ((quit)
49a0: 28 65 78 69 74 29 29 0a 20 20 20 20 20 20 28 65 (exit)). (e
49b0: 6c 73 65 0a 20 20 20 20 20 20 20 28 69 66 20 28 lse. (if (
49c0: 65 71 75 61 6c 3f 20 6b 65 79 20 2a 6d 79 2d 73 equal? key *my-s
49d0: 69 67 6e 61 74 75 72 65 2a 29 20 3b 3b 20 54 4f ignature*) ;; TO
49e0: 44 4f 20 2d 20 67 65 74 20 72 65 61 6c 20 6b 65 DO - get real ke
49f0: 79 20 69 6e 76 6f 6c 76 65 64 0a 09 20 20 20 28 y involved.. (
4a00: 62 65 67 69 6e 0a 09 20 20 20 20 20 28 73 65 74 begin.. (set
4a10: 21 20 2a 61 70 69 2d 70 72 6f 63 65 73 73 2d 72 ! *api-process-r
4a20: 65 71 75 65 73 74 2d 63 6f 75 6e 74 2a 20 28 2b equest-count* (+
4a30: 20 2a 61 70 69 2d 70 72 6f 63 65 73 73 2d 72 65 *api-process-re
4a40: 71 75 65 73 74 2d 63 6f 75 6e 74 2a 20 31 29 29 quest-count* 1))
4a50: 0a 09 20 20 20 20 20 28 6c 65 74 2a 20 28 28 72 .. (let* ((r
4a60: 65 73 20 28 61 70 69 3a 65 78 65 63 75 74 65 2d es (api:execute-
4a70: 72 65 71 75 65 73 74 73 20 64 62 73 74 72 75 63 requests dbstruc
4a80: 74 20 63 6d 64 20 70 61 72 61 6d 73 29 29 29 20 t cmd params)))
4a90: 0a 09 20 20 20 20 20 20 20 3b 3b 20 28 69 66 20 .. ;; (if
4aa0: 64 6f 70 72 69 6e 74 20 28 64 65 62 75 67 3a 70 doprint (debug:p
4ab0: 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
4ac0: 6c 6f 67 2d 70 6f 72 74 2a 20 22 72 65 73 3a 22 log-port* "res:"
4ad0: 20 72 65 73 29 29 0a 09 20 20 20 20 20 20 20 23 res)).. #
4ae0: 3b 28 69 66 20 28 6e 6f 74 20 73 75 63 63 65 73 ;(if (not succes
4af0: 73 29 0a 09 20 20 20 20 20 20 20 28 64 65 62 75 s).. (debu
4b00: 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 g:print 0 *defau
4b10: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 45 52 lt-log-port* "ER
4b20: 52 4f 52 3a 20 73 75 63 63 65 73 73 20 66 6c 61 ROR: success fla
4b30: 67 20 69 73 20 23 66 20 66 6f 72 20 22 20 63 6d g is #f for " cm
4b40: 64 20 22 20 77 69 74 68 20 70 61 72 61 6d 73 20 d " with params
4b50: 22 20 70 61 72 61 6d 73 29 29 0a 09 20 20 20 20 " params))..
4b60: 20 20 20 28 69 66 20 28 3e 20 2a 61 70 69 2d 70 (if (> *api-p
4b70: 72 6f 63 65 73 73 2d 72 65 71 75 65 73 74 2d 63 rocess-request-c
4b80: 6f 75 6e 74 2a 20 2a 6d 61 78 2d 61 70 69 2d 70 ount* *max-api-p
4b90: 72 6f 63 65 73 73 2d 72 65 71 75 65 73 74 73 2a rocess-requests*
4ba0: 29 0a 09 09 20 20 20 28 73 65 74 21 20 2a 6d 61 )... (set! *ma
4bb0: 78 2d 61 70 69 2d 70 72 6f 63 65 73 73 2d 72 65 x-api-process-re
4bc0: 71 75 65 73 74 73 2a 20 2a 61 70 69 2d 70 72 6f quests* *api-pro
4bd0: 63 65 73 73 2d 72 65 71 75 65 73 74 2d 63 6f 75 cess-request-cou
4be0: 6e 74 2a 29 29 0a 09 20 20 20 20 20 20 20 28 73 nt*)).. (s
4bf0: 65 74 21 20 2a 61 70 69 2d 70 72 6f 63 65 73 73 et! *api-process
4c00: 2d 72 65 71 75 65 73 74 2d 63 6f 75 6e 74 2a 20 -request-count*
4c10: 28 2d 20 2a 61 70 69 2d 70 72 6f 63 65 73 73 2d (- *api-process-
4c20: 72 65 71 75 65 73 74 2d 63 6f 75 6e 74 2a 20 31 request-count* 1
4c30: 29 29 0a 09 20 20 20 20 20 20 20 23 3b 28 73 65 )).. #;(se
4c40: 78 70 72 2d 3e 73 74 72 69 6e 67 20 72 65 73 29 xpr->string res)
4c50: 0a 09 20 20 20 20 20 20 20 72 65 73 29 29 0a 09 .. res))..
4c60: 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 (begin..
4c70: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a (debug:print 0 *
4c80: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
4c90: 2a 20 20 20 22 53 65 72 76 65 72 20 72 65 66 75 * "Server refu
4ca0: 73 65 64 20 74 6f 20 70 72 6f 63 65 73 73 20 72 sed to process r
4cb0: 65 71 75 65 73 74 2e 20 53 65 76 65 72 20 69 64 equest. Sever id
4cc0: 20 6d 69 73 6d 61 74 63 68 2e 20 72 65 63 69 76 mismatch. reciv
4cd0: 65 64 20 22 20 6b 65 79 20 22 20 65 78 70 65 63 ed " key " expec
4ce0: 74 65 64 3a 20 20 22 20 2a 6d 79 2d 73 69 67 6e ted: " *my-sign
4cf0: 61 74 75 72 65 2a 20 22 2e 5c 6e 4f 74 68 65 72 ature* ".\nOther
4d00: 20 61 72 67 75 6d 65 6e 74 73 20 72 65 63 69 76 arguments reciv
4d10: 65 64 3a 20 63 6d 64 3d 22 20 63 6d 64 20 22 20 ed: cmd=" cmd "
4d20: 70 61 72 61 6d 73 20 3d 20 22 20 70 61 72 61 6d params = " param
4d30: 73 29 20 0a 09 20 20 20 20 20 28 63 6f 6e 63 20 s) .. (conc
4d40: 22 53 65 72 76 65 72 20 72 65 66 75 73 65 64 20 "Server refused
4d50: 74 6f 20 70 72 6f 63 65 73 73 20 72 65 71 75 65 to process reque
4d60: 73 74 20 73 65 72 76 65 72 20 73 69 67 6e 61 74 st server signat
4d70: 75 72 65 20 6d 69 73 6d 61 74 63 68 3a 20 22 20 ure mismatch: "
4d80: 6b 65 79 20 22 2c 20 22 20 2a 6d 79 2d 73 69 67 key ", " *my-sig
4d90: 6e 61 74 75 72 65 2a 29 29 29 29 29 29 29 0a 0a nature*)))))))..
4da0: 29 0a ).