Artifact
90b98f3b9a1eacd8cd42657aa7b71f37f6a86166:
0000: 28 75 73 65 20 70 6f 73 69 78 29 0a 0a 28 69 6e (use posix)..(in
0010: 63 6c 75 64 65 20 22 64 62 2e 73 63 6d 22 29 0a clude "db.scm").
0020: 0a 3b 3b 20 64 65 66 69 6e 65 20 66 6f 6c 6c 6f .;; define follo
0030: 77 69 6e 67 20 69 6e 20 73 65 74 75 70 2e 73 63 wing in setup.sc
0040: 6d 0a 3b 3b 20 20 20 20 2a 72 65 6d 6f 74 65 68 m.;; *remoteh
0050: 6f 73 74 2a 20 20 3d 3e 20 68 6f 73 74 20 66 6f ost* => host fo
0060: 72 20 22 74 65 73 74 73 22 0a 3b 3b 20 20 20 20 r "tests".;;
0070: 2a 68 6f 6d 65 68 6f 73 74 2a 20 20 20 20 3d 3e *homehost* =>
0080: 20 68 6f 73 74 20 66 6f 72 20 73 65 72 76 65 72 host for server
0090: 73 0a 3b 3b 20 20 20 20 2a 68 6f 6d 65 70 61 74 s.;; *homepat
00a0: 68 2a 20 20 20 20 3d 3e 20 64 69 72 65 63 74 6f h* => directo
00b0: 72 79 20 66 72 6f 6d 20 77 68 69 63 68 20 74 6f ry from which to
00c0: 20 72 75 6e 0a 3b 3b 20 20 20 20 2a 6e 75 6d 74 run.;; *numt
00d0: 65 73 74 73 2a 20 20 20 20 3d 3e 20 68 6f 77 20 ests* => how
00e0: 6d 61 6e 79 20 74 65 73 74 73 20 74 6f 20 73 69 many tests to si
00f0: 6d 75 6c 61 74 65 20 66 6f 72 20 65 61 63 68 20 mulate for each
0100: 72 75 6e 0a 3b 3b 20 20 20 20 2a 6e 75 6d 72 75 run.;; *numru
0110: 6e 73 2a 20 20 20 20 20 3d 3e 20 68 6f 77 20 6d ns* => how m
0120: 61 6e 79 20 72 75 6e 73 20 74 6f 20 73 69 6d 75 any runs to simu
0130: 6c 61 74 65 0a 3b 3b 20 20 20 20 0a 28 69 6e 63 late.;; .(inc
0140: 6c 75 64 65 20 22 73 65 74 75 70 2e 73 63 6d 22 lude "setup.scm"
0150: 29 0a 0a 28 69 6e 63 6c 75 64 65 20 22 64 69 72 )..(include "dir
0160: 65 63 74 2e 73 63 6d 22 29 20 3b 3b 20 64 69 72 ect.scm") ;; dir
0170: 65 63 74 20 64 62 20 63 61 6c 6c 73 0a 0a 3b 3b ect db calls..;;
0180: 20 52 55 4e 20 41 20 54 45 53 54 0a 28 64 65 66 RUN A TEST.(def
0190: 69 6e 65 20 28 72 75 6e 2d 74 65 73 74 20 64 62 ine (run-test db
01a0: 63 6f 6e 6e 20 72 75 6e 2d 69 64 20 74 65 73 74 conn run-id test
01b0: 2d 6e 61 6d 65 29 0a 20 20 28 72 6d 74 3a 63 72 -name). (rmt:cr
01c0: 65 61 74 65 2d 74 65 73 74 20 64 62 63 6f 6e 6e eate-test dbconn
01d0: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
01e0: 65 29 0a 20 20 28 6c 65 74 20 28 28 74 65 73 74 e). (let ((test
01f0: 2d 69 64 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 -id (rmt:get-tes
0200: 74 2d 69 64 20 64 62 63 6f 6e 6e 20 72 75 6e 2d t-id dbconn run-
0210: 69 64 20 74 65 73 74 2d 6e 61 6d 65 29 29 29 0a id test-name))).
0220: 20 20 20 20 28 72 6d 74 3a 74 65 73 74 2d 73 65 (rmt:test-se
0230: 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 20 64 t-state-status d
0240: 62 63 6f 6e 6e 20 74 65 73 74 2d 69 64 20 22 4c bconn test-id "L
0250: 41 55 4e 43 48 45 44 22 20 22 6e 61 22 29 0a 20 AUNCHED" "na").
0260: 20 20 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 (thread-sleep
0270: 21 20 2a 6c 61 75 6e 63 68 64 65 6c 61 79 2a 29 ! *launchdelay*)
0280: 0a 20 20 20 20 28 72 6d 74 3a 74 65 73 74 2d 73 . (rmt:test-s
0290: 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 20 et-state-status
02a0: 64 62 63 6f 6e 6e 20 74 65 73 74 2d 69 64 20 22 dbconn test-id "
02b0: 52 55 4e 4e 49 4e 47 22 20 22 6e 61 22 29 0a 20 RUNNING" "na").
02c0: 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 73 (let loop ((s
02d0: 74 65 70 2d 6e 75 6d 20 30 29 29 0a 20 20 20 20 tep-num 0)).
02e0: 20 20 28 6c 65 74 20 28 28 73 74 65 70 2d 6e 61 (let ((step-na
02f0: 6d 65 20 28 63 6f 6e 63 20 22 73 74 65 70 22 20 me (conc "step"
0300: 73 74 65 70 2d 6e 75 6d 29 29 29 0a 20 20 20 20 step-num))).
0310: 20 20 20 28 72 6d 74 3a 63 72 65 61 74 65 2d 73 (rmt:create-s
0320: 74 65 70 20 64 62 63 6f 6e 6e 20 74 65 73 74 2d tep dbconn test-
0330: 69 64 20 73 74 65 70 2d 6e 61 6d 65 29 0a 20 20 id step-name).
0340: 20 20 20 20 20 28 6c 65 74 20 28 28 73 74 65 70 (let ((step
0350: 2d 69 64 20 28 67 65 74 2d 73 74 65 70 2d 69 64 -id (get-step-id
0360: 20 64 62 63 6f 6e 6e 20 74 65 73 74 2d 69 64 20 dbconn test-id
0370: 73 74 65 70 2d 6e 61 6d 65 29 29 29 0a 09 20 28 step-name))).. (
0380: 72 6d 74 3a 73 74 65 70 2d 73 65 74 2d 73 74 61 rmt:step-set-sta
0390: 74 65 2d 73 74 61 74 75 73 20 64 62 63 6f 6e 6e te-status dbconn
03a0: 20 73 74 65 70 2d 69 64 20 22 53 54 41 52 54 22 step-id "START"
03b0: 20 2d 31 29 0a 09 20 28 74 68 72 65 61 64 2d 73 -1).. (thread-s
03c0: 6c 65 65 70 21 20 2a 73 74 65 70 64 65 6c 61 79 leep! *stepdelay
03d0: 2a 29 0a 09 20 28 72 6d 74 3a 73 74 65 70 2d 73 *).. (rmt:step-s
03e0: 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 20 et-state-status
03f0: 64 62 63 6f 6e 6e 20 73 74 65 70 2d 69 64 20 22 dbconn step-id "
0400: 45 4e 44 22 20 30 29 0a 09 20 28 70 72 69 6e 74 END" 0).. (print
0410: 22 20 20 20 53 54 45 50 3a 20 22 20 73 74 65 70 " STEP: " step
0420: 2d 6e 61 6d 65 20 22 20 64 6f 6e 65 2e 22 29 29 -name " done."))
0430: 29 0a 20 20 20 20 20 20 28 69 66 20 28 3c 20 73 ). (if (< s
0440: 74 65 70 2d 6e 75 6d 20 2a 6e 75 6d 73 74 65 70 tep-num *numstep
0450: 73 2a 29 0a 09 20 20 28 6c 6f 6f 70 20 28 2b 20 s*).. (loop (+
0460: 73 74 65 70 2d 6e 75 6d 20 31 29 29 29 29 0a 20 step-num 1)))).
0470: 20 20 20 28 72 6d 74 3a 74 65 73 74 2d 73 65 74 (rmt:test-set
0480: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 20 64 62 -state-status db
0490: 63 6f 6e 6e 20 74 65 73 74 2d 69 64 20 22 43 4f conn test-id "CO
04a0: 4d 50 4c 45 54 45 44 22 20 28 69 66 20 28 3e 20 MPLETED" (if (>
04b0: 28 72 61 6e 64 6f 6d 20 31 30 29 20 32 29 20 22 (random 10) 2) "
04c0: 50 41 53 53 22 20 22 46 41 49 4c 22 29 29 0a 20 PASS" "FAIL")).
04d0: 20 20 20 28 70 72 69 6e 74 20 22 54 45 53 54 3a (print "TEST:
04e0: 20 22 20 74 65 73 74 2d 6e 61 6d 65 20 22 20 64 " test-name " d
04f0: 6f 6e 65 2e 22 29 0a 20 20 20 20 74 65 73 74 2d one."). test-
0500: 69 64 29 29 0a 0a 3b 3b 20 52 55 4e 20 41 20 52 id))..;; RUN A R
0510: 55 4e 0a 28 64 65 66 69 6e 65 20 28 72 75 6e 2d UN.(define (run-
0520: 72 75 6e 20 64 62 63 6f 6e 6e 20 74 61 72 67 65 run dbconn targe
0530: 74 20 72 75 6e 2d 6e 61 6d 65 20 6e 75 6d 2d 74 t run-name num-t
0540: 65 73 74 73 29 0a 20 20 28 72 6d 74 3a 63 72 65 ests). (rmt:cre
0550: 61 74 65 2d 72 75 6e 20 64 62 63 6f 6e 6e 20 74 ate-run dbconn t
0560: 61 72 67 65 74 20 72 75 6e 2d 6e 61 6d 65 29 0a arget run-name).
0570: 20 20 28 6c 65 74 20 28 28 72 75 6e 2d 69 64 20 (let ((run-id
0580: 28 72 6d 74 3a 67 65 74 2d 72 75 6e 2d 69 64 20 (rmt:get-run-id
0590: 64 62 63 6f 6e 6e 20 74 61 72 67 65 74 20 72 75 dbconn target ru
05a0: 6e 2d 6e 61 6d 65 29 29 29 0a 20 20 20 20 28 6c n-name))). (l
05b0: 65 74 20 6c 6f 6f 70 20 28 28 74 65 73 74 2d 6e et loop ((test-n
05c0: 75 6d 20 30 29 29 0a 20 20 20 20 20 20 28 73 79 um 0)). (sy
05d0: 73 74 65 6d 20 28 63 6f 6e 63 20 22 4e 42 46 41 stem (conc "NBFA
05e0: 4b 45 5f 4c 4f 47 3d 74 65 73 74 2d 22 20 74 65 KE_LOG=test-" te
05f0: 73 74 2d 6e 75 6d 20 22 2d 72 75 6e 2d 69 64 2d st-num "-run-id-
0600: 22 20 72 75 6e 2d 69 64 20 22 2e 6c 6f 67 20 4e " run-id ".log N
0610: 42 46 41 4b 45 5f 48 4f 53 54 3d 22 20 2a 72 65 BFAKE_HOST=" *re
0620: 6d 6f 74 65 68 6f 73 74 2a 20 22 20 6e 62 66 61 motehost* " nbfa
0630: 6b 65 20 6d 69 6e 69 6d 74 20 72 75 6e 74 65 73 ke minimt runtes
0640: 74 20 22 20 72 75 6e 2d 69 64 20 22 20 74 65 73 t " run-id " tes
0650: 74 2d 22 20 74 65 73 74 2d 6e 75 6d 29 29 0a 20 t-" test-num)).
0660: 20 20 20 20 20 28 69 66 20 28 3c 20 74 65 73 74 (if (< test
0670: 2d 6e 75 6d 20 6e 75 6d 2d 74 65 73 74 73 29 0a -num num-tests).
0680: 09 20 20 28 6c 6f 6f 70 20 28 2b 20 74 65 73 74 . (loop (+ test
0690: 2d 6e 75 6d 20 31 29 29 29 29 29 29 0a 0a 3b 3b -num 1))))))..;;
06a0: 20 44 6f 20 77 68 61 74 20 69 73 20 61 73 6b 65 Do what is aske
06b0: 64 0a 28 6c 65 74 20 28 28 61 72 67 73 20 28 63 d.(let ((args (c
06c0: 64 72 20 28 61 72 67 76 29 29 29 29 0a 20 20 28 dr (argv)))). (
06d0: 69 66 20 28 3c 20 28 6c 65 6e 67 74 68 20 61 72 if (< (length ar
06e0: 67 73 29 20 31 29 0a 20 20 20 20 20 20 28 70 72 gs) 1). (pr
06f0: 69 6e 74 0a 20 20 20 20 20 20 20 22 55 73 61 67 int. "Usag
0700: 65 3a 20 6d 69 6e 69 6d 74 20 5b 6f 70 74 69 6f e: minimt [optio
0710: 6e 73 5d 22 20 22 0a 20 20 72 75 6e 74 65 73 74 ns]" ". runtest
0720: 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 run-id testname
0730: 0a 20 20 72 75 6e 72 75 6e 20 20 74 61 72 67 65 . runrun targe
0740: 74 20 72 75 6e 6e 61 6d 65 22 29 0a 20 20 20 20 t runname").
0750: 20 20 28 6c 65 74 20 28 28 63 6d 64 20 20 20 20 (let ((cmd
0760: 28 63 61 72 20 61 72 67 73 29 29 0a 09 20 20 20 (car args))..
0770: 20 28 64 62 63 6f 6e 6e 20 28 72 6d 74 3a 6f 70 (dbconn (rmt:op
0780: 65 6e 2d 63 72 65 61 74 65 2d 64 62 20 2a 68 6f en-create-db *ho
0790: 6d 65 70 61 74 68 2a 20 22 6d 74 2e 64 62 22 20 mepath* "mt.db"
07a0: 69 6e 69 74 2d 64 62 29 29 29 0a 09 28 63 68 61 init-db)))..(cha
07b0: 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 2a 68 nge-directory *h
07c0: 6f 6d 65 70 61 74 68 2a 29 0a 09 28 63 61 73 65 omepath*)..(case
07d0: 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c (string->symbol
07e0: 20 63 6d 64 29 0a 09 20 20 28 28 72 75 6e 74 65 cmd).. ((runte
07f0: 73 74 29 0a 09 20 20 20 28 6c 65 74 20 28 28 72 st).. (let ((r
0800: 75 6e 2d 69 64 20 20 20 20 28 73 74 72 69 6e 67 un-id (string
0810: 2d 3e 6e 75 6d 62 65 72 20 28 63 61 64 72 20 61 ->number (cadr a
0820: 72 67 73 29 29 29 0a 09 09 20 28 74 65 73 74 2d rgs)))... (test-
0830: 6e 61 6d 65 20 28 63 61 64 64 72 20 61 72 67 73 name (caddr args
0840: 29 29 29 0a 09 20 20 20 20 20 28 70 72 69 6e 74 ))).. (print
0850: 20 22 4c 61 75 6e 63 68 69 6e 67 20 74 65 73 74 "Launching test
0860: 20 22 20 74 65 73 74 2d 6e 61 6d 65 20 22 20 66 " test-name " f
0870: 6f 72 20 72 75 6e 2d 69 64 20 22 20 72 75 6e 2d or run-id " run-
0880: 69 64 29 0a 09 20 20 20 20 20 28 72 75 6e 2d 74 id).. (run-t
0890: 65 73 74 20 64 62 63 6f 6e 6e 20 72 75 6e 2d 69 est dbconn run-i
08a0: 64 20 74 65 73 74 2d 6e 61 6d 65 29 29 29 0a 09 d test-name)))..
08b0: 20 20 28 28 72 75 6e 72 75 6e 29 0a 09 20 20 20 ((runrun)..
08c0: 28 6c 65 74 20 28 28 74 61 72 67 65 74 20 20 20 (let ((target
08d0: 28 63 61 64 72 20 61 72 67 73 29 29 0a 09 09 20 (cadr args))...
08e0: 28 72 75 6e 2d 6e 61 6d 65 20 28 63 61 64 64 72 (run-name (caddr
08f0: 20 61 72 67 73 29 29 29 0a 09 20 20 20 20 20 28 args))).. (
0900: 72 75 6e 2d 72 75 6e 20 64 62 63 6f 6e 6e 20 74 run-run dbconn t
0910: 61 72 67 65 74 20 72 75 6e 2d 6e 61 6d 65 20 2a arget run-name *
0920: 6e 75 6d 74 65 73 74 73 2a 29 0a 09 20 20 20 20 numtests*)..
0930: 20 28 70 72 69 6e 74 20 22 55 73 65 3a 20 73 71 (print "Use: sq
0940: 6c 69 74 65 33 20 72 75 6e 74 65 73 74 2f 6d 74 lite3 runtest/mt
0950: 2e 64 62 20 27 73 65 6c 65 63 74 20 6d 61 78 28 .db 'select max(
0960: 65 6e 64 5f 74 69 6d 65 29 2d 6d 69 6e 28 73 74 end_time)-min(st
0970: 61 72 74 5f 74 69 6d 65 29 20 66 72 6f 6d 20 74 art_time) from t
0980: 65 73 74 73 3b 27 20 74 6f 20 73 65 65 20 74 68 ests;' to see th
0990: 65 20 74 6f 74 61 6c 20 72 75 6e 20 74 69 6d 65 e total run time
09a0: 22 29 0a 09 20 20 20 20 20 29 29 0a 09 20 20 28 ").. )).. (
09b0: 28 72 75 6e 61 6c 6c 29 0a 09 20 20 20 28 66 6f (runall).. (fo
09c0: 72 2d 65 61 63 68 0a 09 20 20 20 20 28 6c 61 6d r-each.. (lam
09d0: 62 64 61 20 28 74 61 72 67 65 74 29 0a 09 20 20 bda (target)..
09e0: 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 (let loop ((
09f0: 72 75 6e 2d 6e 75 6d 20 30 29 29 0a 09 09 28 74 run-num 0))...(t
0a00: 68 72 65 61 64 2d 73 6c 65 65 70 21 20 2a 72 75 hread-sleep! *ru
0a10: 6e 64 65 6c 61 79 2a 29 0a 09 09 28 73 79 73 74 ndelay*)...(syst
0a20: 65 6d 20 28 63 6f 6e 63 20 22 4e 42 46 41 4b 45 em (conc "NBFAKE
0a30: 5f 4c 4f 47 3d 72 75 6e 2d 22 20 74 61 72 67 65 _LOG=run-" targe
0a40: 74 20 22 2d 22 20 72 75 6e 2d 6e 75 6d 20 22 2e t "-" run-num ".
0a50: 6c 6f 67 20 6e 62 66 61 6b 65 20 6d 69 6e 69 6d log nbfake minim
0a60: 74 20 72 75 6e 72 75 6e 20 22 20 74 61 72 67 65 t runrun " targe
0a70: 74 20 22 20 72 75 6e 2d 22 20 72 75 6e 2d 6e 75 t " run-" run-nu
0a80: 6d 29 29 0a 09 09 28 69 66 20 28 3c 20 72 75 6e m))...(if (< run
0a90: 2d 6e 75 6d 20 2a 6e 75 6d 72 75 6e 73 2a 29 0a -num *numruns*).
0aa0: 09 09 20 20 20 20 28 6c 6f 6f 70 20 28 2b 20 72 .. (loop (+ r
0ab0: 75 6e 2d 6e 75 6d 20 31 29 29 29 29 29 0a 09 20 un-num 1)))))..
0ac0: 20 20 20 2a 74 61 72 67 65 74 73 2a 29 29 0a 09 *targets*))..
0ad0: 20 20 28 65 6c 73 65 0a 09 20 20 20 28 70 72 69 (else.. (pri
0ae0: 6e 74 20 22 43 6f 6d 6d 61 6e 64 3a 20 22 20 63 nt "Command: " c
0af0: 6d 64 20 22 20 6e 6f 74 20 72 65 63 6f 67 6e 69 md " not recogni
0b00: 73 65 64 2e 20 52 75 6e 20 77 69 74 68 6f 75 74 sed. Run without
0b10: 20 70 61 72 61 6d 73 20 74 6f 20 73 65 65 20 68 params to see h
0b20: 65 6c 70 2e 22 29 29 29 0a 09 28 63 6c 6f 73 65 elp.")))..(close
0b30: 2d 64 61 74 61 62 61 73 65 20 28 64 62 63 6f 6e -database (dbcon
0b40: 6e 2d 64 61 74 2d 64 62 68 20 64 62 63 6f 6e 6e n-dat-dbh dbconn
0b50: 29 29 29 29 29 0a ))))).